Browse Source

Cleanup

stable
Denis Tereshkin 5 years ago
parent
commit
880580f90c
  1. 1
      robocom-zero.cabal
  2. 1
      src/ATrade/Driver/Backtest.hs
  3. 22
      src/ATrade/Driver/Real.hs
  4. 117
      src/ATrade/Quotes/HAP.hs

1
robocom-zero.cabal

@ -23,7 +23,6 @@ library @@ -23,7 +23,6 @@ library
, ATrade.RoboCom.Utils
, ATrade.Quotes
, ATrade.Quotes.Finam
, ATrade.Quotes.HAP
, ATrade.Quotes.QHP
, ATrade.Quotes.QTIS
, ATrade.Driver.Real

1
src/ATrade/Driver/Backtest.hs

@ -39,7 +39,6 @@ import Data.HashMap.Strict (lookup) @@ -39,7 +39,6 @@ import Data.HashMap.Strict (lookup)
import Data.List (partition)
import Data.List.Split (splitOn)
import qualified Data.Map.Strict as M
import Data.Semigroup ((<>))
import Data.Sequence (Seq (..), (<|), (|>))
import qualified Data.Sequence as Seq
import Data.STRef (newSTRef, readSTRef, writeSTRef)

22
src/ATrade/Driver/Real.hs

@ -33,7 +33,6 @@ import Control.Exception.Safe @@ -33,7 +33,6 @@ import Control.Exception.Safe
import Control.Lens hiding (Context, (.=))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as BL
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Text as T
import Data.Text.Encoding
@ -53,9 +52,7 @@ import ATrade.Driver.Real.QuoteSourceThread @@ -53,9 +52,7 @@ import ATrade.Driver.Real.QuoteSourceThread
import ATrade.Driver.Types (Strategy(..), StrategyInstanceParams(..), InitializationCallback)
import ATrade.RoboCom.Types (BarSeries(..), Ticker(..), Timeframe(..))
import ATrade.Exceptions
import ATrade.Quotes.Finam as QF
import ATrade.Quotes.QHP as QQ
import ATrade.Quotes.HAP as QH
import System.ZMQ4 hiding (Event(..))
import GHC.Generics
@ -264,19 +261,6 @@ robotMain dataDownloadDelta defaultState initCallback callback = do @@ -264,19 +261,6 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
debugM "main" "Starting strategy driver"
withContext (\ctx -> do
infoM "main" "Loading history"
-- Load tickers data and create BarAggregator from them
{-
historyBars <-
if
| (strategyHistoryProviderType . strategyInstanceParams) strategy == "finam" ->
M.fromList <$> mapM (loadTickerFromFinam (downloadDelta strategy)) (tickers . strategyInstanceParams $ strategy)
| (strategyHistoryProviderType . strategyInstanceParams) strategy == "hap" ->
M.fromList <$> mapM (loadTickerFromHAP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy) (downloadDelta strategy)) (tickers . strategyInstanceParams $ strategy)
| otherwise ->
M.fromList <$> mapM (loadTickerFromQHP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy) (downloadDelta strategy)) (tickers . strategyInstanceParams $ strategy)
-}
agg <- newIORef $ mkAggregatorFromBars M.empty [(hmsToDiffTime 3 50 0, hmsToDiffTime 21 10 0)]
now <- getCurrentTime >>= newIORef
@ -297,9 +281,9 @@ robotMain dataDownloadDelta defaultState initCallback callback = do @@ -297,9 +281,9 @@ robotMain dataDownloadDelta defaultState initCallback callback = do
tickFilter :: Tick -> Bool
tickFilter tick =
let classCode = T.takeWhile (/= '#') (security tick) in
if
| classCode == "SPBFUT" || classCode == "SPBOPT" -> any (inInterval . utctDayTime . timestamp $ tick) fortsIntervals
| otherwise -> any (inInterval . utctDayTime . timestamp $ tick) secIntervals
if classCode == "SPBFUT" || classCode == "SPBOPT"
then any (inInterval . utctDayTime . timestamp $ tick) fortsIntervals
else any (inInterval . utctDayTime . timestamp $ tick) secIntervals
fortsIntervals = [(fromHMS 4 0 0, fromHMS 11 0 0), (fromHMS 11 5 0, fromHMS 15 45 0), (fromHMS 16 0 0, fromHMS 20 50 0)]
secIntervals = [(fromHMS 6 50 0, fromHMS 15 51 0)]

117
src/ATrade/Quotes/HAP.hs

@ -1,117 +0,0 @@ @@ -1,117 +0,0 @@
{-# LANGUAGE OverloadedStrings #-}
module ATrade.Quotes.HAP (
getQuotes,
Period(..),
RequestParams(..)
) where
import ATrade.Types
import Data.Aeson
import Data.Binary.Get
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Data.Time.Clock
import Data.Time.Clock.POSIX
import System.Log.Logger
import System.ZMQ4
data Period =
Period1Min |
Period5Min |
Period15Min |
Period30Min |
PeriodHour |
PeriodDay |
PeriodWeek |
PeriodMonth
deriving (Eq)
instance Show Period where
show Period1Min = "M1"
show Period5Min = "M5"
show Period15Min = "M15"
show Period30Min = "M30"
show PeriodHour = "H1"
show PeriodDay = "D"
show PeriodWeek = "W"
show PeriodMonth = "MN"
data RequestParams =
RequestParams
{
endpoint :: T.Text,
ticker :: T.Text,
startDate :: UTCTime,
endDate :: UTCTime,
period :: Period
} deriving (Show, Eq)
instance ToJSON RequestParams where
toJSON p = object [ "ticker" .= ticker p,
"from" .= startDate p,
"to" .= endDate p,
"timeframe" .= show (period p) ]
getQuotes :: Context -> RequestParams -> IO [Bar]
getQuotes ctx params =
withSocket ctx Req $ \sock -> do
debugM "HAP" $ "Connecting to ep: " ++ show (endpoint params)
connect sock $ (T.unpack . endpoint) params
send sock [] (BL.toStrict $ encode params { period = Period1Min})
response <- receiveMulti sock
case response of
[header, rest] -> if header == "OK"
then return $ reverse $ resampleBars (period params) $ parseBars (ticker params) $ BL.fromStrict rest
else return []
_ -> return []
where
resampleBars p (firstBar:rest) = resampleBars' (periodToSec p) rest firstBar []
resampleBars _ [] = []
resampleBars' p (bar:bars) currentBar resampled = if barNumber p currentBar == barNumber p bar
then resampleBars' p bars (aggregate currentBar bar) resampled
else resampleBars' p bars bar (currentBar : resampled)
resampleBars' _ [] _ _ = []
periodToSec Period1Min = 60
periodToSec Period5Min = 60 * 5
periodToSec Period15Min = 60 * 15
periodToSec Period30Min = 60 * 30
periodToSec PeriodHour = 60 * 60
periodToSec PeriodDay = 60 * 60 * 24
periodToSec PeriodWeek = 86400 * 7
periodToSec PeriodMonth = 86400 * 7 * 4 -- TODO: incorrect, but what can I do?
barNumber sec bar = truncate (utcTimeToPOSIXSeconds (barTimestamp bar)) `div` sec
aggregate currentBar newBar = currentBar {
barHigh = max (barHigh currentBar) (barHigh newBar),
barLow = min (barLow currentBar) (barLow newBar),
barClose = barClose newBar,
barTimestamp = barTimestamp newBar
}
parseBars :: TickerId -> BL.ByteString -> [Bar]
parseBars tickerId input =
case runGetOrFail parseBar input of
Left _ -> []
Right (rest, _, bar) -> bar : parseBars tickerId rest
where
parseBar = do
rawTimestamp <- realToFrac <$> getWord64le
baropen <- getDoublele
barhigh <- getDoublele
barlow <- getDoublele
barclose <- getDoublele
barvolume <- getWord64le
return Bar
{
barSecurity = tickerId,
barTimestamp = posixSecondsToUTCTime rawTimestamp,
barOpen = fromDouble baropen,
barHigh = fromDouble barhigh,
barLow = fromDouble barlow,
barClose = fromDouble barclose,
barVolume = toInteger barvolume
}
Loading…
Cancel
Save