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

appendToLog: take severity as argument

junction
Denis Tereshkin 4 years ago
parent
0d350774df
commit
7f1b7bbaf9
3 changed files with 25 additions and 20 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. 7
      src/ATrade/Driver/Junction/RobotDriverThread.hs
  2. 3
      src/ATrade/RoboCom/Monad.hs
  3. 35
      src/ATrade/RoboCom/Positions.hs

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

@ -15,6 +15,7 @@ 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,7 +30,7 @@ import ATrade.Driver.Junction.Types (BigConfig,
strategyId, tickerId, strategyId, tickerId,
timeframe) timeframe)
import ATrade.Logging (Message, logDebug, import ATrade.Logging (Message, logDebug,
logInfo, logWarning) logInfo, logWarning, log)
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),
@ -159,9 +160,9 @@ instance MonadRobot (RobotM c s) c s where
bro <- asks brokerService bro <- asks brokerService
liftIO . void $ Bro.cancelOrder bro oid liftIO . void $ Bro.cancelOrder bro oid
appendToLog t = do appendToLog s t = do
instId <- _seInstanceId <$> (asks env >>= liftIO . readIORef) instId <- _seInstanceId <$> (asks env >>= liftIO . readIORef)
logInfo instId . TL.toStrict $ t log s instId $ TL.toStrict t
setupTimer t = do setupTimer t = do
ref <- asks timersRef ref <- asks timersRef

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

@ -32,11 +32,12 @@ import qualified Data.Text.Lazy as TL
import Data.Time.Clock 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)
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
cancelOrder :: OrderId -> m () cancelOrder :: OrderId -> m ()
appendToLog :: TL.Text -> m () appendToLog :: Severity -> TL.Text -> m ()
setupTimer :: UTCTime -> m () setupTimer :: UTCTime -> m ()
enqueueIOAction :: Int -> IO Value -> m () enqueueIOAction :: Int -> IO Value -> m ()
getConfig :: m c getConfig :: m c

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

@ -78,6 +78,7 @@ import ATrade.Types
import Control.Lens import Control.Lens
import Control.Monad import Control.Monad
import ATrade.Logging (Severity (Trace, Warning))
import Data.Aeson import Data.Aeson
import qualified Data.List as L import qualified Data.List as L
import qualified Data.Text as T import qualified Data.Text as T
@ -210,45 +211,49 @@ dispatchPosition event pos = case posState pos of
cancelOrder $ orderId order cancelOrder $ orderId order
return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled } return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled }
else do else do
appendToLog $ [t|Order executed (partially, %? / %?): %?|] (posBalance pos) (orderQuantity order) order appendToLog Trace $ [t|Order executed (partially, %? / %?): %?|] (posBalance pos) (orderQuantity order) order
return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posEntryTime = Just lastTs} return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posEntryTime = Just lastTs}
else case event of else case event of
OrderUpdate oid newstate -> OrderUpdate oid newstate ->
if oid == orderId order if oid == orderId order
then case newstate of then case newstate of
Cancelled -> do Cancelled -> do
appendToLog $ [t|Order cancelled in PositionWaitingOpen: balance %d, max %d|] (posBalance pos) (orderQuantity order) appendToLog Trace $ [t|Order cancelled in PositionWaitingOpen: balance %d, max %d|] (posBalance pos) (orderQuantity order)
if posBalance pos /= 0 if posBalance pos /= 0
then return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posEntryTime = Just lastTs} then return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posEntryTime = Just lastTs}
else return pos { posState = PositionCancelled } else return pos { posState = PositionCancelled }
Executed -> do Executed -> do
appendToLog $ [t|Order executed: %?|] order appendToLog Trace $ [t|Order executed: %?|] order
return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = balanceForOrder order, posEntryTime = Just lastTs} return pos { posState = PositionOpen,
posCurrentOrder = Nothing,
posExecutionDeadline = Nothing,
posBalance = balanceForOrder order,
posEntryTime = Just lastTs }
Rejected -> do Rejected -> do
appendToLog $ [t|Order rejected: %?|] order appendToLog Trace $ [t|Order rejected: %?|] order
return pos { posState = PositionCancelled, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = 0, posEntryTime = Nothing } return pos { posState = PositionCancelled, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = 0, posEntryTime = Nothing }
_ -> do _ -> do
appendToLog $ [t|In PositionWaitingOpen: order state update: %?|] newstate appendToLog Trace $ [t|In PositionWaitingOpen: order state update: %?|] newstate
return pos return pos
else return pos -- Update for another position's order else return pos -- Update for another position's order
NewTrade trade -> do NewTrade trade -> do
appendToLog $ [t|Order new trade: %?/%?|] order trade appendToLog Trace $ [t|Order new trade: %?/%?|] order trade
return $ if tradeOrderId trade == orderId order return $ if tradeOrderId trade == orderId order
then pos { posBalance = if tradeOperation trade == Buy then posBalance pos + tradeQuantity trade else posBalance pos - tradeQuantity trade } then pos { posBalance = if tradeOperation trade == Buy then posBalance pos + tradeQuantity trade else posBalance pos - tradeQuantity trade }
else pos else pos
_ -> return pos _ -> return pos
Nothing -> do Nothing -> do
appendToLog $ [t|W: No current order in PositionWaitingOpen state: %?|] pos appendToLog Warning $ [t|W: No current order in PositionWaitingOpen state: %?|] pos
return pos return pos
handlePositionOpen = do handlePositionOpen = do
lastTs <- view seLastTimestamp <$> getEnvironment lastTs <- view seLastTimestamp <$> getEnvironment
if if
| orderDeadline (posSubmissionDeadline pos) lastTs -> do | orderDeadline (posSubmissionDeadline pos) lastTs -> do
appendToLog $ [t|PositionId: %? : Missed submission deadline: %?, remaining in PositionOpen state|] (posId pos) (posSubmissionDeadline pos) appendToLog Warning $ [t|PositionId: %? : Missed submission deadline: %?, remaining in PositionOpen state|] (posId pos) (posSubmissionDeadline pos)
return pos { posSubmissionDeadline = Nothing, posExecutionDeadline = Nothing } return pos { posSubmissionDeadline = Nothing, posExecutionDeadline = Nothing }
| orderDeadline (posExecutionDeadline pos) lastTs -> do | orderDeadline (posExecutionDeadline pos) lastTs -> do
appendToLog $ [t|PositionId: %? : Missed execution deadline: %?, remaining in PositionOpen state|] (posId pos) (posExecutionDeadline pos) appendToLog Warning $ [t|PositionId: %? : Missed execution deadline: %?, remaining in PositionOpen state|] (posId pos) (posExecutionDeadline pos)
return pos { posExecutionDeadline = Nothing } return pos { posExecutionDeadline = Nothing }
| otherwise -> case event of | otherwise -> case event of
NewTick tick -> if NewTick tick -> if
@ -283,7 +288,7 @@ dispatchPosition event pos = case posState pos of
else return pos else return pos
_ -> return pos _ -> return pos
else do else do
appendToLog "Deadline when cancelling pending order" appendToLog Warning "Deadline when cancelling pending order"
return pos { posState = PositionCancelled } return pos { posState = PositionCancelled }
handlePositionWaitingCloseSubmission pendingOrder = do handlePositionWaitingCloseSubmission pendingOrder = do
@ -310,7 +315,7 @@ dispatchPosition event pos = case posState pos of
case posCurrentOrder pos of case posCurrentOrder pos of
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
_ -> doNothing _ -> doNothing
appendToLog $ [t|Was unable to close position, remaining balance: %?|] (posBalance pos) appendToLog Warning $ [t|Was unable to close position, remaining balance: %?|] (posBalance pos)
return $ pos { posState = PositionOpen, posSubmissionDeadline = Nothing, posExecutionDeadline = Nothing } -- TODO call TimeoutHandler if present return $ pos { posState = PositionOpen, posSubmissionDeadline = Nothing, posExecutionDeadline = Nothing } -- TODO call TimeoutHandler if present
else case (event, posCurrentOrder pos) of else case (event, posCurrentOrder pos) of
(OrderUpdate oid newstate, Just order) -> (OrderUpdate oid newstate, Just order) ->
@ -366,8 +371,6 @@ newPosition order account tickerId operation quantity submissionDeadline = do
posExitTime = Nothing posExitTime = Nothing
} }
modifyPositions (\p -> position : p) modifyPositions (\p -> position : p)
positions <- getPositions <$> getState
appendToLog $ [t|All positions: %?|] positions
return position return position
reapDeadPositions :: (StateHasPositions s) => EventCallback c s reapDeadPositions :: (StateHasPositions s) => EventCallback c s
@ -510,7 +513,7 @@ enterAtLimitForTickerWithParams :: (StateHasPositions s, MonadRobot m c s) => Ti
enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation = do enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation = do
lastTs <- view seLastTimestamp <$> getEnvironment lastTs <- view seLastTimestamp <$> getEnvironment
oid <- submitOrder order oid <- submitOrder order
appendToLog $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs) appendToLog Trace $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs)
newPosition (order {orderId = oid}) account tickerId operation quantity 20 >>= newPosition (order {orderId = oid}) account tickerId operation quantity 20 >>=
modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs })
where where
@ -580,7 +583,7 @@ exitAtLimit timeToCancel price position operationSignalName = do
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
Nothing -> doNothing Nothing -> doNothing
oid <- submitOrder (closeOrder inst) oid <- submitOrder (closeOrder inst)
appendToLog $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs) appendToLog Trace $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
modifyPosition (\pos -> modifyPosition (\pos ->
pos { posCurrentOrder = Nothing, pos { posCurrentOrder = Nothing,
posState = PositionWaitingCloseSubmission (closeOrder inst) { orderId = oid }, posState = PositionWaitingCloseSubmission (closeOrder inst) { orderId = oid },

Write Preview
Loading…
Cancel
Save