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

Get rid of ParamsHasMainTicker

junction
Denis Tereshkin 4 years ago
parent
a8641b71f3
commit
610a67f9af
4 changed files with 63 additions and 42 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. 18
      src/ATrade/Driver/Junction.hs
  2. 12
      src/ATrade/Driver/Junction/RobotDriverThread.hs
  3. 10
      src/ATrade/RoboCom/Monad.hs
  4. 33
      src/ATrade/RoboCom/Positions.hs

18
src/ATrade/Driver/Junction.hs
Unescape View File

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

12
src/ATrade/Driver/Junction/RobotDriverThread.hs
Unescape View File

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

10
src/ATrade/RoboCom/Monad.hs
Unescape View File

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

33
src/ATrade/RoboCom/Positions.hs
Unescape View File

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

Write Preview
Loading…
Cancel
Save