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
Split 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 @@ -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) @@ -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, @@ -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,6 +243,8 @@ junctionMain descriptors = do @@ -238,6 +243,8 @@ junctionMain descriptors = do
case M.lookup (strategyBaseName inst) descriptors of
Just (StrategyDescriptorE desc) -> do
bigConf <- loadConfig (configKey inst)
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
@ -251,12 +258,15 @@ junctionMain descriptors = do @@ -251,12 +258,15 @@ junctionMain descriptors = do
_seVolume = 1,
_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
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

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

@ -15,7 +15,6 @@ module ATrade.Driver.Junction.RobotDriverThread @@ -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, @@ -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 @@ -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 = @@ -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 @@ -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

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

@ -19,8 +19,8 @@ module ATrade.RoboCom.Monad ( @@ -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 @@ -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 @@ -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

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

@ -20,7 +20,6 @@ @@ -20,7 +20,6 @@
module ATrade.RoboCom.Positions
(
StateHasPositions(..),
ParamsHasMainTicker(..),
PositionState(..),
Position(..),
posIsOpen,
@ -79,8 +78,10 @@ import Control.Lens @@ -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 @@ -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 @@ -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 @@ -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 @@ -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

Write Preview
Loading…
Cancel
Save