Browse Source

Cleanup: old Monad definitions

Finally, both Real and Backtest drivers use MonadRobot instances
stable
Denis Tereshkin 6 years ago
parent
commit
17eb32ecc1
  1. 28
      src/ATrade/Driver/Backtest.hs
  2. 2
      src/ATrade/Driver/Real.hs
  3. 51
      src/ATrade/RoboCom/Monad.hs

28
src/ATrade/Driver/Backtest.hs

@ -19,10 +19,10 @@ import ATrade.Driver.Types (InitializationCallback, @@ -19,10 +19,10 @@ import ATrade.Driver.Types (InitializationCallback,
import ATrade.Exceptions
import ATrade.Quotes.Finam as QF
import ATrade.RoboCom.Monad (Event (..), EventCallback,
MonadRobot (..), StrategyAction (..),
MonadRobot (..),
StrategyEnvironment (..),
appendToLog, runStrategyElement,
seBars, seLastTimestamp, st)
appendToLog, seBars, seLastTimestamp,
st)
import ATrade.RoboCom.Positions
import ATrade.RoboCom.Types (BarSeries (..), Ticker (..),
Timeframe (..))
@ -197,28 +197,6 @@ backtestMain dataDownloadDelta defaultState initCallback callback = do @@ -197,28 +197,6 @@ backtestMain dataDownloadDelta defaultState initCallback callback = do
handleEvents
_ -> return ()
{-
executeActions actions = concat <$> mapM executeAction actions
executeAction (ActionOrder order) = do
oid <- nextOrderId
let submittedOrder = order { orderState = Submitted, orderId = oid }
modify' (\s -> s { pendingOrders = submittedOrder : pendingOrders s })
return [OrderSubmitted submittedOrder]
executeAction (ActionCancelOrder oid) = do
mbOrder <- find (\o -> orderId o == oid && orderState o == Submitted) <$> gets pendingOrders
case mbOrder of
Just _ -> do
modify' (\s -> s { pendingOrders = filter (\o -> orderId o == oid) (pendingOrders s)})
return [OrderUpdate oid Cancelled]
_ -> return []
executeAction (ActionLog t) = modify' (\s -> s { logs = t : logs s }) >> return []
executeAction (ActionSetupTimer t) = modify' (\s -> s { pendingTimers = t : pendingTimers s }) >> return []
executeAction (ActionIO _ _) = return []
-}
executePendingOrders bar = do
executeMarketOrders bar
executeLimitOrders bar

2
src/ATrade/Driver/Real.hs

@ -47,7 +47,7 @@ import Data.Maybe @@ -47,7 +47,7 @@ import Data.Maybe
import Data.Monoid
import Database.Redis hiding (info, decode)
import ATrade.Types
import ATrade.RoboCom.Monad (StrategyMonad, StrategyAction(..), EventCallback, Event(..), runStrategyElement, StrategyEnvironment(..), seBars, seLastTimestamp, Event(..), MonadRobot(..))
import ATrade.RoboCom.Monad (EventCallback, Event(..), StrategyEnvironment(..), seBars, seLastTimestamp, Event(..), MonadRobot(..))
import ATrade.BarAggregator
import ATrade.Driver.Real.BrokerClientThread
import ATrade.Driver.Real.QuoteSourceThread

51
src/ATrade/RoboCom/Monad.hs

@ -9,23 +9,14 @@ @@ -9,23 +9,14 @@
{-# LANGUAGE TypeSynonymInstances #-}
module ATrade.RoboCom.Monad (
RState,
RConfig,
RActions,
REnv,
StrategyEnvironment(..),
seInstanceId,
seAccount,
seVolume,
seBars,
seLastTimestamp,
StrategyElement,
runStrategyElement,
EventCallback,
Event(..),
StrategyMonad,
StrategyAction(..),
tellAction,
MonadRobot(..),
also,
st
@ -34,8 +25,6 @@ module ATrade.RoboCom.Monad ( @@ -34,8 +25,6 @@ module ATrade.RoboCom.Monad (
import ATrade.RoboCom.Types
import ATrade.Types
import Ether
import Control.Lens
import Data.Aeson.Types
import qualified Data.Text as T
@ -57,19 +46,6 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where @@ -57,19 +46,6 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
setState (f oldState)
getEnvironment :: m StrategyEnvironment
data RState
data RConfig
data RActions
data REnv
type StrategyMonad c s = WriterT RActions [StrategyAction] (StateT RState s (ReaderT REnv StrategyEnvironment (Reader RConfig c)))
type StrategyElement c s r = (StrategyMonad c s) r
runStrategyElement :: c -> s -> StrategyEnvironment -> StrategyElement c s r -> (s, [StrategyAction], r)
runStrategyElement conf sta env action = (newState, actions, retValue)
where
((retValue, actions), newState) = runReader @RConfig (runReaderT @REnv (runStateT @RState (runWriterT @RActions action) sta) env) conf
type EventCallback c s = forall m . MonadRobot m c s => Event -> m ()
data Event = NewBar Bar
@ -82,12 +58,6 @@ data Event = NewBar Bar @@ -82,12 +58,6 @@ data Event = NewBar Bar
| ActionCompleted Int Value
deriving (Show, Eq)
data StrategyAction = ActionOrder Order
| ActionCancelOrder OrderId
| ActionLog T.Text
| ActionSetupTimer UTCTime
| ActionIO Int (IO Value)
data StrategyEnvironment = StrategyEnvironment {
_seInstanceId :: !T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable)
_seAccount :: !T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent
@ -98,27 +68,6 @@ data StrategyEnvironment = StrategyEnvironment { @@ -98,27 +68,6 @@ data StrategyEnvironment = StrategyEnvironment {
makeLenses ''StrategyEnvironment
instance Show StrategyAction where
show (ActionOrder order) = "ActionOrder " ++ show order
show (ActionCancelOrder oid) = "ActionCancelOrder " ++ show oid
show (ActionLog t) = "ActionLog " ++ show t
show (ActionIO x _) = "ActionIO " ++ show x
show (ActionSetupTimer t) = "ActionSetupTimer e" ++ show t
tellAction :: StrategyAction -> StrategyElement c s ()
tellAction a = tell @RActions [a]
instance MonadRobot (StrategyMonad c s) c s where
submitOrder order = tellAction $ ActionOrder order
cancelOrder oId = tellAction $ ActionCancelOrder oId
appendToLog = tellAction . ActionLog
setupTimer = tellAction . ActionSetupTimer
enqueueIOAction actionId action = tellAction $ ActionIO actionId action
getConfig = ask @RConfig
getState = get @RState
setState = put @RState
getEnvironment = ask @REnv
also :: EventCallback c s -> EventCallback c s -> EventCallback c s
also cb1 cb2 = (\event -> cb1 event >> cb2 event)

Loading…
Cancel
Save