Get rid of ParamsHasMainTicker

src/ATrade/Driver/Junction.hs

@@ -38,9 +38,12 @@ import           ATrade.Driver.Junction.Types                (StrategyDescriptor
                                                               StrategyInstance (strategyInstanceId),
                                                               StrategyInstanceDescriptor (..),
                                                               confStrategy,
+                                                              confTickers,
                                                               strategyState,
-                                                              strategyTimers)
-import           ATrade.Logging                              (Message, Severity (Debug, Info, Trace, Warning),
+                                                              strategyTimers,
+                                                              tickerId,
+                                                              timeframe)
+import           ATrade.Logging                              (Message, Severity (Debug, Error, Info, Trace, Warning),
                                                               fmtMessage,
                                                               logWarning,
                                                               logWith)
@@ -48,7 +51,8 @@ import           ATrade.Quotes.QHP                           (mkQHPHandle)
 import           ATrade.RoboCom.ConfigStorage                (ConfigStorage (loadConfig))
 import           ATrade.RoboCom.Monad                        (StrategyEnvironment (..))
 import           ATrade.RoboCom.Persistence                  (MonadPersistence (loadState, saveState))
-import           ATrade.RoboCom.Types                        (Bars)
+import           ATrade.RoboCom.Types                        (BarSeriesId (BarSeriesId),
+                                                              Bars)
 import           ATrade.Types                                (ClientSecurityParams (ClientSecurityParams),
                                                               OrderId,
                                                               Trade (tradeOrderId))
@@ -74,6 +78,7 @@ import           Data.IORef                                  (IORef,
                                                               atomicModifyIORef',
                                                               newIORef,
                                                               readIORef)
+import           Data.List.NonEmpty                          (NonEmpty ((:|)))
 import qualified Data.Map.Strict                             as M
 import           Data.Set                                    (notMember)
 import qualified Data.Set                                    as S
@@ -238,25 +243,30 @@ junctionMain descriptors = do
       case M.lookup (strategyBaseName inst) descriptors of
         Just (StrategyDescriptorE desc) -> do
           bigConf <- loadConfig (configKey inst)
-          rConf <- liftIO $ newIORef (confStrategy bigConf)
-          rState <- loadState (stateKey inst) >>= liftIO . newIORef
-          rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef
-          localH <- liftIO $ openFile (logBasePath cfg <> "/" <> T.unpack (strategyId inst) <> ".log") AppendMode
-          liftIO $ hSetBuffering localH LineBuffering
-          let robotLogAction = logger logHandle <> (fmtMessage >$< logTextHandle localH)
-          stratEnv <- liftIO $ newIORef StrategyEnvironment
-                         {
-                           _seInstanceId = strategyId inst,
-                           _seAccount = "test", -- TODO configure
-                           _seVolume = 1,
-                           _seLastTimestamp = now
-                         }
-          let robotEnv = RobotEnv rState rConf rTimers barsMap stratEnv robotLogAction broService
-          robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers
-          robotsMap' <- asks peRobots
-          liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ()))
+          case confTickers bigConf of
+            (firstTicker:restTickers) -> do
+              rConf <- liftIO $ newIORef (confStrategy bigConf)
+              rState <- loadState (stateKey inst) >>= liftIO . newIORef
+              rTimers <- loadState (stateKey inst <> ":timers") >>= liftIO . newIORef
+              localH <- liftIO $ openFile (logBasePath cfg <> "/" <> T.unpack (strategyId inst) <> ".log") AppendMode
+              liftIO $ hSetBuffering localH LineBuffering
+              let robotLogAction = logger logHandle <> (fmtMessage >$< logTextHandle localH)
+              stratEnv <- liftIO $ newIORef StrategyEnvironment
+                             {
+                               _seInstanceId = strategyId inst,
+                               _seAccount = "test", -- TODO configure
+                               _seVolume = 1,
+                               _seLastTimestamp = now
+                             }
+              let robotEnv = RobotEnv rState rConf rTimers barsMap stratEnv robotLogAction broService (toBarSeriesId <$> (firstTicker :| restTickers))
+              robot <- createRobotDriverThread inst desc (flip runReaderT robotEnv . unRobotM) bigConf rConf rState rTimers
+              robotsMap' <- asks peRobots
+              liftIO $ atomicModifyIORef' robotsMap' (\s -> (M.insert (strategyId inst) robot s, ()))
+            _ -> logWith (logger logHandle) Error (strategyId inst) $ "No tickers configured !!!"
         Nothing   -> error "Unknown strategy"
 
+    toBarSeriesId t = BarSeriesId (tickerId t) (timeframe t)
+
     withJunction :: JunctionEnv -> JunctionM () -> IO ()
     withJunction env = (`runReaderT` env) . unJunctionM
 

src/ATrade/Driver/Junction/RobotDriverThread.hs

@@ -15,7 +15,6 @@ module ATrade.Driver.Junction.RobotDriverThread
   onStrategyInstance,
   postNotificationEvent) where
 
-import Prelude hiding (log)
 import           ATrade.Broker.Protocol               (Notification (OrderNotification, TradeNotification))
 import qualified ATrade.Driver.Junction.BrokerService as Bro
 import           ATrade.Driver.Junction.QuoteStream   (QuoteStream (addSubscription),
@@ -29,8 +28,8 @@ import           ATrade.Driver.Junction.Types         (BigConfig,
                                                        eventCallback, stateKey,
                                                        strategyId, tickerId,
                                                        timeframe)
-import           ATrade.Logging                       (Message, logDebug,
-                                                       logInfo, logWarning, log)
+import           ATrade.Logging                       (Message, log, logDebug,
+                                                       logInfo, logWarning)
 import           ATrade.QuoteSource.Client            (QuoteData (..))
 import           ATrade.RoboCom.ConfigStorage         (ConfigStorage)
 import           ATrade.RoboCom.Monad                 (Event (NewBar, NewTick, NewTrade, OrderSubmitted, OrderUpdate),
@@ -57,10 +56,12 @@ import           Data.Default
 import           Data.IORef                           (IORef,
                                                        atomicModifyIORef',
                                                        readIORef, writeIORef)
+import           Data.List.NonEmpty                   (NonEmpty)
 import qualified Data.Map.Strict                      as M
 import qualified Data.Text.Lazy                       as TL
 import           Data.Time                            (UTCTime, getCurrentTime)
 import           Dhall                                (FromDhall)
+import           Prelude                              hiding (log)
 
 data RobotDriverHandle = forall c s. (FromDhall c, Default s, FromJSON s, ToJSON s) =>
                            RobotDriverHandle (StrategyInstance c s) ThreadId ThreadId (BoundedChan RobotDriverEvent)
@@ -140,7 +141,8 @@ data RobotEnv c s =
     bars          :: IORef Bars,
     env           :: IORef StrategyEnvironment,
     logAction     :: LogAction (RobotM c s) Message,
-    brokerService :: Bro.BrokerService
+    brokerService :: Bro.BrokerService,
+    tickers       :: NonEmpty BarSeriesId
   }
 
 newtype RobotM c s a = RobotM { unRobotM :: ReaderT (RobotEnv c s) IO a }
@@ -181,6 +183,8 @@ instance MonadRobot (RobotM c s) c s where
     b <- asks bars >>= liftIO . readIORef
     return $ M.lookup (BarSeriesId tid tf) b
 
+  getAvailableTickers = asks tickers
+
 postNotificationEvent :: (MonadIO m) => RobotDriverHandle -> Notification -> m ()
 postNotificationEvent (RobotDriverHandle _ _ _ eventQueue) notification = liftIO $
   case notification of

src/ATrade/RoboCom/Monad.hs

@@ -19,8 +19,8 @@ module ATrade.RoboCom.Monad (
   MonadRobot(..),
   also,
   t,
-  st
-) where
+  st,
+  getFirstTickerId) where
 
 import           ATrade.RoboCom.Types
 import           ATrade.Types
@@ -33,6 +33,8 @@ import           Data.Time.Clock
 import           Language.Haskell.Printf
 import           Language.Haskell.TH.Quote (QuasiQuoter)
 import ATrade.Logging (Severity)
+import Data.List.NonEmpty (NonEmpty)
+import qualified Data.List.NonEmpty as NE
 
 class (Monad m) => MonadRobot m c s | m -> c, m -> s where
   submitOrder :: Order -> m OrderId
@@ -49,6 +51,10 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
     setState (f oldState)
   getEnvironment :: m StrategyEnvironment
   getTicker :: TickerId -> BarTimeframe -> m (Maybe BarSeries)
+  getAvailableTickers :: m (NonEmpty BarSeriesId)
+
+getFirstTickerId :: forall c s m. (Monad m, MonadRobot m c s) => m BarSeriesId
+getFirstTickerId = NE.head <$> getAvailableTickers
 
 st :: QuasiQuoter
 st = t

src/ATrade/RoboCom/Positions.hs

@@ -20,7 +20,6 @@
 module ATrade.RoboCom.Positions
 (
   StateHasPositions(..),
-  ParamsHasMainTicker(..),
   PositionState(..),
   Position(..),
   posIsOpen,
@@ -79,8 +78,10 @@ import           Control.Lens
 import           Control.Monad
 
 import           ATrade.Logging       (Severity (Trace, Warning))
+import           ATrade.RoboCom.Monad (MonadRobot (getAvailableTickers))
 import           Data.Aeson
 import qualified Data.List            as L
+import qualified Data.List.NonEmpty   as NE
 import qualified Data.Text            as T
 import qualified Data.Text.Lazy       as TL
 import           Data.Time.Clock
@@ -389,17 +390,17 @@ modifyPosition f oldpos = do
       return $ f oldpos
     Nothing -> return oldpos
 
-getCurrentTicker :: (ParamsHasMainTicker c, MonadRobot m c s) => m [Bar]
+getCurrentTicker :: (MonadRobot m c s) => m [Bar]
 getCurrentTicker = do
-  (tf, mainTicker') <- mainTicker <$> getConfig
+  (BarSeriesId mainTicker' tf) <- NE.head <$> getAvailableTickers
   maybeBars <- getTicker mainTicker' tf
   case maybeBars of
     Just b -> return $ bsBars b
     _      -> return []
 
-getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries)
+getCurrentTickerSeries :: (MonadRobot m c s) => m (Maybe BarSeries)
 getCurrentTickerSeries = do
-  (tf, mainTicker') <- mainTicker <$> getConfig
+  (BarSeriesId mainTicker' tf) <- NE.head <$> getAvailableTickers
   getTicker mainTicker' tf
 
 getLastActivePosition :: (StateHasPositions s, MonadRobot m c s) => m (Maybe Position)
@@ -460,14 +461,14 @@ onActionCompletedEvent event f = case event of
   ActionCompleted tag v -> f tag v
   _                     -> doNothing
 
-enterAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Operation -> m Position
+enterAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> Operation -> m Position
 enterAtMarket operationSignalName operation = do
   env <- getEnvironment
   enterAtMarketWithParams (env ^. seAccount) (env ^. seVolume) (SignalId (env ^. seInstanceId) operationSignalName "") operation
 
-enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position
+enterAtMarketWithParams :: (StateHasPositions s, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position
 enterAtMarketWithParams account quantity signalId operation = do
-  tickerId <- snd . mainTicker <$> getConfig
+  BarSeriesId tickerId _ <- getFirstTickerId
   oid <- submitOrder $ order tickerId
   newPosition ((order tickerId) { orderId = oid }) account tickerId operation quantity 20
   where
@@ -480,20 +481,20 @@ enterAtMarketWithParams account quantity signalId operation = do
     orderSignalId = signalId
   }
 
-enterAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Operation -> m Position
+enterAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Operation -> m Position
 enterAtLimit timeToCancel operationSignalName price operation = do
   env <- getEnvironment
   enterAtLimitWithParams timeToCancel (env ^. seAccount) (env ^. seVolume) (SignalId (env ^. seInstanceId) operationSignalName "") price operation
 
-enterAtLimitWithVolume :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position
+enterAtLimitWithVolume :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position
 enterAtLimitWithVolume timeToCancel operationSignalName price vol operation = do
   acc <- view seAccount <$> getEnvironment
   inst <- view seInstanceId <$> getEnvironment
   enterAtLimitWithParams timeToCancel acc vol (SignalId inst operationSignalName "") price operation
 
-enterAtLimitWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position
+enterAtLimitWithParams :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position
 enterAtLimitWithParams timeToCancel account quantity signalId price operation = do
-  tickerId <- snd . mainTicker <$> getConfig
+  BarSeriesId tickerId _ <- getFirstTickerId
   enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation
 
 enterAtLimitForTickerWithVolume :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position
@@ -526,19 +527,19 @@ enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId
     orderSignalId = signalId
   }
 
-enterLongAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position
+enterLongAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> m Position
 enterLongAtMarket operationSignalName = enterAtMarket operationSignalName Buy
 
-enterShortAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position
+enterShortAtMarket :: (StateHasPositions s, MonadRobot m c s) => T.Text -> m Position
 enterShortAtMarket operationSignalName = enterAtMarket operationSignalName Sell
 
-enterLongAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position
+enterLongAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position
 enterLongAtLimit timeToCancel price operationSignalName = enterAtLimit timeToCancel operationSignalName price Buy
 
 enterLongAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position
 enterLongAtLimitForTicker tickerId timeToCancel price operationSignalName = enterAtLimitForTicker tickerId timeToCancel operationSignalName price Buy
 
-enterShortAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position
+enterShortAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position
 enterShortAtLimit timeToCancel price operationSignalName = enterAtLimit timeToCancel operationSignalName price Sell
 
 enterShortAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position