diff --git a/src/ATrade/Driver/Junction/RobotDriverThread.hs b/src/ATrade/Driver/Junction/RobotDriverThread.hs index d06554a..93b3ac4 100644 --- a/src/ATrade/Driver/Junction/RobotDriverThread.hs +++ b/src/ATrade/Driver/Junction/RobotDriverThread.hs @@ -15,6 +15,7 @@ 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,7 +30,7 @@ import ATrade.Driver.Junction.Types (BigConfig, strategyId, tickerId, timeframe) import ATrade.Logging (Message, logDebug, - logInfo, logWarning) + logInfo, logWarning, log) import ATrade.QuoteSource.Client (QuoteData (..)) import ATrade.RoboCom.ConfigStorage (ConfigStorage) 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 liftIO . void $ Bro.cancelOrder bro oid - appendToLog t = do + appendToLog s t = do instId <- _seInstanceId <$> (asks env >>= liftIO . readIORef) - logInfo instId . TL.toStrict $ t + log s instId $ TL.toStrict t setupTimer t = do ref <- asks timersRef diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs index 69eb915..399d16c 100644 --- a/src/ATrade/RoboCom/Monad.hs +++ b/src/ATrade/RoboCom/Monad.hs @@ -32,11 +32,12 @@ import qualified Data.Text.Lazy as TL import Data.Time.Clock import Language.Haskell.Printf import Language.Haskell.TH.Quote (QuasiQuoter) +import ATrade.Logging (Severity) class (Monad m) => MonadRobot m c s | m -> c, m -> s where submitOrder :: Order -> m OrderId cancelOrder :: OrderId -> m () - appendToLog :: TL.Text -> m () + appendToLog :: Severity -> TL.Text -> m () setupTimer :: UTCTime -> m () enqueueIOAction :: Int -> IO Value -> m () getConfig :: m c diff --git a/src/ATrade/RoboCom/Positions.hs b/src/ATrade/RoboCom/Positions.hs index c054608..4d9f1ad 100644 --- a/src/ATrade/RoboCom/Positions.hs +++ b/src/ATrade/RoboCom/Positions.hs @@ -78,6 +78,7 @@ import ATrade.Types import Control.Lens import Control.Monad +import ATrade.Logging (Severity (Trace, Warning)) import Data.Aeson import qualified Data.List as L import qualified Data.Text as T @@ -210,45 +211,49 @@ dispatchPosition event pos = case posState pos of cancelOrder $ orderId order return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled } 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} else case event of OrderUpdate oid newstate -> if oid == orderId order then case newstate of 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 then return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posEntryTime = Just lastTs} else return pos { posState = PositionCancelled } Executed -> do - appendToLog $ [t|Order executed: %?|] order - return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = balanceForOrder order, posEntryTime = Just lastTs} + appendToLog Trace $ [t|Order executed: %?|] order + return pos { posState = PositionOpen, + posCurrentOrder = Nothing, + posExecutionDeadline = Nothing, + posBalance = balanceForOrder order, + posEntryTime = Just lastTs } 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 } _ -> do - appendToLog $ [t|In PositionWaitingOpen: order state update: %?|] newstate + appendToLog Trace $ [t|In PositionWaitingOpen: order state update: %?|] newstate return pos else return pos -- Update for another position's order NewTrade trade -> do - appendToLog $ [t|Order new trade: %?/%?|] order trade + appendToLog Trace $ [t|Order new trade: %?/%?|] order trade return $ if tradeOrderId trade == orderId order then pos { posBalance = if tradeOperation trade == Buy then posBalance pos + tradeQuantity trade else posBalance pos - tradeQuantity trade } else pos _ -> return pos 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 handlePositionOpen = do lastTs <- view seLastTimestamp <$> getEnvironment if | 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 } | 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 } | otherwise -> case event of NewTick tick -> if @@ -283,7 +288,7 @@ dispatchPosition event pos = case posState pos of else return pos _ -> return pos else do - appendToLog "Deadline when cancelling pending order" + appendToLog Warning "Deadline when cancelling pending order" return pos { posState = PositionCancelled } handlePositionWaitingCloseSubmission pendingOrder = do @@ -310,7 +315,7 @@ dispatchPosition event pos = case posState pos of case posCurrentOrder pos of Just order -> cancelOrder (orderId order) _ -> 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 else case (event, posCurrentOrder pos) of (OrderUpdate oid newstate, Just order) -> @@ -366,8 +371,6 @@ newPosition order account tickerId operation quantity submissionDeadline = do posExitTime = Nothing } modifyPositions (\p -> position : p) - positions <- getPositions <$> getState - appendToLog $ [t|All positions: %?|] positions return position 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 lastTs <- view seLastTimestamp <$> getEnvironment 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 >>= modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) where @@ -580,7 +583,7 @@ exitAtLimit timeToCancel price position operationSignalName = do Just order -> cancelOrder (orderId order) Nothing -> doNothing 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 -> pos { posCurrentOrder = Nothing, posState = PositionWaitingCloseSubmission (closeOrder inst) { orderId = oid },