appendToLog: take severity as argument

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

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

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 },