From 17eb32ecc1e07d656efc9a98fc29da9105fe4a06 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Mon, 13 Apr 2020 12:38:55 +0700 Subject: [PATCH] Cleanup: old Monad definitions Finally, both Real and Backtest drivers use MonadRobot instances --- src/ATrade/Driver/Backtest.hs | 28 +++---------------- src/ATrade/Driver/Real.hs | 2 +- src/ATrade/RoboCom/Monad.hs | 51 ----------------------------------- 3 files changed, 4 insertions(+), 77 deletions(-) diff --git a/src/ATrade/Driver/Backtest.hs b/src/ATrade/Driver/Backtest.hs index 894ef99..c20de38 100644 --- a/src/ATrade/Driver/Backtest.hs +++ b/src/ATrade/Driver/Backtest.hs @@ -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 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 diff --git a/src/ATrade/Driver/Real.hs b/src/ATrade/Driver/Real.hs index 2611f41..77b087d 100644 --- a/src/ATrade/Driver/Real.hs +++ b/src/ATrade/Driver/Real.hs @@ -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 diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs index 71c8af8..0f24a80 100644 --- a/src/ATrade/RoboCom/Monad.hs +++ b/src/ATrade/RoboCom/Monad.hs @@ -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 ( 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 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 | 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 { 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)