asakul
/
robocom-zero
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity
Browse Source

Revert "Real driver refactoring" 

This reverts commit b40c2966b7.
master
Denis Tereshkin 4 years ago
parent
bd5ddfc8b6
commit
3d2c40e158
1 changed files with 51 additions and 152 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Unified View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 203
      src/ATrade/Driver/Real.hs

203
src/ATrade/Driver/Real.hs
Unescape View File

@ -1,11 +1,8 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
module ATrade.Driver.Real ( module ATrade.Driver.Real (
StrategyInstanceParams(..), StrategyInstanceParams(..),
@ -14,103 +11,45 @@ module ATrade.Driver.Real (
barStrategyDriver barStrategyDriver
) where ) where
import ATrade.BarAggregator import Options.Applicative
import ATrade.Driver.Real.BrokerClientThread import System.IO
import ATrade.Driver.Real.QuoteSourceThread import System.Signal
import ATrade.Driver.Types (InitializationCallback, StrategyInstanceParams (..)) import System.Exit
import ATrade.Exceptions import System.Random
import ATrade.Quotes (MonadHistory (..), MonadInstrumentParametersSource (..)) import System.Log.Logger
import ATrade.Quotes.QHP as QQ import System.Log.Handler.Simple
import ATrade.Quotes.QTIS (TickerInfo (..), import System.Log.Handler (setFormatter)
qtisGetTickersInfo) import System.Log.Formatter
import ATrade.RoboCom.Monad (Event (..), import Control.Monad
EventCallback, import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield)
MonadRobot (..), import Control.Concurrent.BoundedChan as BC
StrategyEnvironment (..), import Control.Exception
seBars, seLastTimestamp) import qualified Data.ByteString as BS
import ATrade.RoboCom.Types (BarSeries (..), InstrumentParameters (..), import qualified Data.ByteString.Lazy as BL
Ticker (..), import qualified Data.List as L
Timeframe (..)) import qualified Data.Map as M
import ATrade.RoboCom.Utils (fromHMS) import qualified Data.Text as T
import ATrade.Types import Data.Text.Encoding
import Control.Concurrent hiding (readChan, import Data.Aeson
writeChan, import Data.IORef
writeList2Chan, yield) import Data.Time.Calendar
import Control.Concurrent.BoundedChan as BC import Data.Time.Clock
import Control.Exception.Safe import Data.Time.Clock.POSIX
import Control.Lens hiding (Context, (.=)) import Data.Maybe
import Control.Monad import Data.Monoid
import Control.Monad.Reader import Database.Redis hiding (info, decode)
import Data.Aeson import ATrade.Types
import qualified Data.ByteString as BS import ATrade.RoboCom.Monad (StrategyMonad, StrategyAction(..), EventCallback, Event(..), runStrategyElement, StrategyEnvironment(..), Event(..))
import qualified Data.ByteString.Lazy as BL import ATrade.BarAggregator
import Data.IORef import ATrade.Driver.Real.BrokerClientThread
import qualified Data.Map as M import ATrade.Driver.Real.QuoteSourceThread
import Data.Maybe import ATrade.Driver.Real.Types (Strategy(..), StrategyInstanceParams(..), InitializationCallback)
import qualified Data.Text as T import ATrade.RoboCom.Types (BarSeries(..), Ticker(..), Timeframe(..))
import Data.Text.Encoding import ATrade.Exceptions
import qualified Data.Text.Lazy as TL import ATrade.Quotes.Finam as QF
import Data.Time.Calendar import ATrade.Quotes.QHP as QQ
import Data.Time.Clock import ATrade.Quotes.HAP as QH
import Data.Time.Clock.POSIX import System.ZMQ4 hiding (Event(..))
import Database.Redis hiding (decode, info)
import GHC.Generics
import Options.Applicative
import System.Exit
import System.IO
import System.Log.Formatter
import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple
import System.Log.Logger
import System.Signal
import System.ZMQ4 hiding (Event (..))
import Ether.Reader
data RDriverEnv
data DriverEnv c s = DriverEnv {
orderChan :: BC.BoundedChan BrokerCommand,
strategyConfig' :: c,
stateRef :: IORef s,
timersRef :: IORef [UTCTime],
environmentRef :: IORef StrategyEnvironment
}
type RealDriver c s = ReaderT RDriverEnv (DriverEnv c s) IO
runRealDriver env f = runReaderT @RDriverEnv f env
instance (MonadRobot (RealDriver c s) c s) where
submitOrder order = do
chan <- asks @RDriverEnv orderChan
liftIO $ BC.writeChan chan $ BrokerSubmitOrder order
cancelOrder oid = do
chan <- asks @RDriverEnv orderChan
liftIO $ BC.writeChan chan $ BrokerCancelOrder oid
appendToLog txt = liftIO $ infoM "Driver" (T.unpack txt)
setupTimer t = do
timers <- asks @RDriverEnv timersRef
liftIO $ atomicModifyIORef' timers (\ts -> (t : ts, ()))
enqueueIOAction = undefined
getConfig = asks @RDriverEnv strategyConfig'
getState = asks @RDriverEnv stateRef >>= liftIO . readIORef
setState newstate = do
s <- asks @RDriverEnv stateRef
liftIO $ atomicWriteIORef s newstate
modifyState f = do
st <- asks @RDriverEnv stateRef
liftIO $ atomicModifyIORef' st (\s -> (f s, ()))
getEnvironment = asks @RDriverEnv environmentRef >>= liftIO . readIORef
data Params = Params { data Params = Params {
instanceId :: String, instanceId :: String,
@ -445,46 +384,6 @@ barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
writeChan brokerChan BrokerRequestNotifications writeChan brokerChan BrokerRequestNotifications
lift $ debugM "Strategy" "Wakeup thread forked" lift $ debugM "Strategy" "Wakeup thread forked"
<<<<<<< HEAD
wakeupTid <- forkIO $ forever $ do
maybeShutdown <- tryTakeMVar shutdownVar
if isJust maybeShutdown
then writeChan eventChan Shutdown
else do
threadDelay 1000000
writeChan ordersChan BrokerRequestNotifications
debugM "Strategy" "Wakeup thread forked"
let env = StrategyEnvironment {
seInstanceId = strategyInstanceId . strategyInstanceParams $ strategy,
seAccount = strategyAccount . strategyInstanceParams $ strategy,
seVolume = strategyVolume . strategyInstanceParams $ strategy,
seBars = M.empty,
seLastTimestamp = UTCTime (fromGregorian 1970 1 1) 0
}
envRef <- newIORef env
readAndHandleEvents agg ordersChan eventChan strategy envRef
debugM "Strategy" "Stopping strategy driver"
killThread wakeupTid)))
debugM "Strategy" "Strategy done"
where
qsEp = strategyQuotesourceEp . strategyInstanceParams $ strategy
brEp = strategyBrokerEp . strategyInstanceParams $ strategy
readAndHandleEvents agg ordersChan eventChan strategy' envRef = do
event <- readChan eventChan
if event /= Shutdown
then do
currentBars <- bars <$> readIORef agg
let params = strategyParams strategy'
let instId = strategyInstanceId . strategyInstanceParams $ strategy'
let acc = strategyAccount . strategyInstanceParams $ strategy'
let vol = strategyVolume . strategyInstanceParams $ strategy'
env <- readIORef envRef
let oldTimestamp = seLastTimestamp env
=======
readAndHandleEvents agg instanceParams readAndHandleEvents agg instanceParams
lift $ debugM "Strategy" "Stopping strategy driver" lift $ debugM "Strategy" "Stopping strategy driver"
lift $ killThread wakeupTid lift $ killThread wakeupTid
@ -502,7 +401,6 @@ barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
if event /= Shutdown if event /= Shutdown
then do then do
env <- getEnvironment env <- getEnvironment
>>>>>>> stable
let newTimestamp = case event of let newTimestamp = case event of
NewTick tick -> timestamp tick NewTick tick -> timestamp tick
NewBar bar -> barTimestamp bar NewBar bar -> barTimestamp bar
@ -510,16 +408,18 @@ barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
nowRef <- asks envLastTimestamp nowRef <- asks envLastTimestamp
lift $ writeIORef nowRef newTimestamp lift $ writeIORef nowRef newTimestamp
<<<<<<< HEAD
newTimers <- catMaybes <$> (readIORef timersRef >>= mapM (checkTimer eventChan newTimestamp)) newTimers <- catMaybes <$> (readIORef timersRef >>= mapM (checkTimer eventChan newTimestamp))
atomicWriteIORef timersRef newTimers atomicWriteIORef timersRef newTimers
atomicModifyIORef' envRef (\e -> (e { seBars = currentBars, seLastTimestamp = newTimestamp }, ())) let !newenv = env { seBars = currentBars, seLastTimestamp = newTimestamp }
runRealDriver (DriverEnv ordersChan params stateRef timersRef envRef) $ (eventCallback strategy) event let (!newState, !actions, _) = runStrategyElement params curState newenv $ (eventCallback strategy) event
writeIORef stateRef newState
writeIORef timersRef newTimers
readAndHandleEvents agg ordersChan eventChan strategy' envRef newTimers' <- catMaybes <$> mapM handleTimerActions actions
mapM_ (handleActions ordersChan) actions
readAndHandleEvents agg ordersChan eventChan (strategy' { currentState = newState, strategyTimers = newTimers ++ newTimers' }) newenv
else debugM "Strategy" "Shutdown requested" else debugM "Strategy" "Shutdown requested"
=======
timersRef <- asks envTimers timersRef <- asks envTimers
oldTimers <- lift $ readIORef timersRef oldTimers <- lift $ readIORef timersRef
newTimers <- catMaybes <$> mapM (checkTimer eventChan newTimestamp) oldTimers newTimers <- catMaybes <$> mapM (checkTimer eventChan newTimestamp) oldTimers
@ -529,7 +429,6 @@ barStrategyDriver downloadDelta instanceParams callback shutdownVar = do
readAndHandleEvents agg instanceParams' readAndHandleEvents agg instanceParams'
else else
lift $ debugM "Strategy" "Shutdown requested" lift $ debugM "Strategy" "Shutdown requested"
>>>>>>> stable
where where
checkTimer eventChan' newTimestamp timerTime = checkTimer eventChan' newTimestamp timerTime =

Write Preview
Loading…
Cancel
Save