Update to lts-17.14

robocom-zero.cabal

@@ -15,9 +15,10 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  ghc-options:         -Wall -Werror -fno-warn-orphans -Wno-type-defaults
+  ghc-options:         -Wall -fno-warn-orphans -Wno-type-defaults
   exposed-modules:     ATrade.RoboCom.Indicators
                      , ATrade.RoboCom.Monad
+                     , ATrade.RoboCom.Persistence
                      , ATrade.RoboCom.Positions
                      , ATrade.RoboCom.Types
                      , ATrade.RoboCom.Utils
@@ -51,7 +52,6 @@ library
                      , binary-ieee754
                      , zeromq4-haskell
                      , unordered-containers
-                     , ether
                      , th-printf
                      , BoundedChan
                      , monad-loops

src/ATrade/Exceptions.hs

@@ -8,7 +8,11 @@ import           Control.Exception
 import qualified Data.Text         as T
 import           GHC.Generics
 
-data RoboComException = UnableToLoadConfig T.Text | UnableToLoadFeed T.Text
+data RoboComException = UnableToLoadConfig T.Text
+                      | UnableToLoadFeed T.Text
+                      | UnableToLoadState T.Text
+                      | UnableToSaveState T.Text
+                      | BadParams T.Text
   deriving (Show, Generic)
 
 instance Exception RoboComException

src/ATrade/RoboCom/Monad.hs

@@ -19,7 +19,7 @@ module ATrade.RoboCom.Monad (
   Event(..),
   MonadRobot(..),
   also,
-  st
+  t
 ) where
 
 import           ATrade.RoboCom.Types
@@ -29,7 +29,7 @@ import           Control.Lens
 import           Data.Aeson.Types
 import qualified Data.Text               as T
 import           Data.Time.Clock
-import           Text.Printf.TH
+import           Language.Haskell.Printf
 
 class (Monad m) => MonadRobot m c s | m -> c, m -> s where
   submitOrder :: Order -> m ()

src/ATrade/RoboCom/Positions.hs

@@ -81,6 +81,7 @@ import           Data.Aeson
 import qualified Data.List            as L
 import qualified Data.Map             as M
 import qualified Data.Text            as T
+import qualified Data.Text.Lazy       as TL
 import           Data.Time.Clock
 
 data PositionState = PositionWaitingOpenSubmission Order
@@ -206,49 +207,49 @@ dispatchPosition event pos = case posState pos of
           then
             if posBalance pos == 0
               then do
-                appendToLog $ [st|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs
+                appendToLog $ TL.toStrict $ [t|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs
                 cancelOrder $ orderId order
                 return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled }
               else do
-                appendToLog $ [st|Order executed (partially, %? / %?): %?|] (posBalance pos) (orderQuantity order) order
+                appendToLog $ TL.toStrict $ [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 $ [st|Order cancelled in PositionWaitingOpen: balance %d, max %d|] (posBalance pos) (orderQuantity order)
+                    appendToLog $ TL.toStrict $ [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 $ [st|Order executed: %?|] order
+                    appendToLog $ TL.toStrict $ [t|Order executed: %?|] order
                     return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = balanceForOrder order, posEntryTime = Just lastTs}
                   Rejected -> do
-                    appendToLog $ [st|Order rejected: %?|] order
+                    appendToLog $ TL.toStrict $ [t|Order rejected: %?|] order
                     return pos { posState = PositionCancelled, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = 0, posEntryTime = Nothing }
                   _ -> do
-                    appendToLog $ [st|In PositionWaitingOpen: order state update: %?|] newstate
+                    appendToLog $ TL.toStrict $ [t|In PositionWaitingOpen: order state update: %?|] newstate
                     return pos
                 else return pos -- Update for another position's order
             NewTrade trade -> do
-              appendToLog $ [st|Order new trade: %?/%?|] order trade
+              appendToLog $ TL.toStrict $ [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 $ [st|W: No current order in PositionWaitingOpen state: %?|] pos
+          appendToLog $ TL.toStrict $ [t|W: No current order in PositionWaitingOpen state: %?|] pos
           return pos
 
     handlePositionOpen = do
       lastTs <- view seLastTimestamp <$> getEnvironment
       if
         | orderDeadline (posSubmissionDeadline pos) lastTs -> do
-            appendToLog $ [st|PositionId: %? : Missed submission deadline: %?, remaining in PositionOpen state|] (posId pos) (posSubmissionDeadline pos)
+            appendToLog $ TL.toStrict $ [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 $ [st|PositionId: %? : Missed execution deadline: %?, remaining in PositionOpen state|] (posId pos) (posExecutionDeadline pos)
+            appendToLog $ TL.toStrict $ [t|PositionId: %? : Missed execution deadline: %?, remaining in PositionOpen state|] (posId pos) (posExecutionDeadline pos)
             return pos { posExecutionDeadline = Nothing }
         | otherwise ->  case event of
           NewTick tick -> if
@@ -307,7 +308,7 @@ dispatchPosition event pos = case posState pos of
           case posCurrentOrder pos of
             Just order -> cancelOrder (orderId order)
             _          -> doNothing
-          appendToLog $ [st|Was unable to close position, remaining balance: %?|] (posBalance pos)
+          appendToLog $ TL.toStrict $ [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) ->
@@ -347,7 +348,7 @@ newPosition :: (StateHasPositions s, MonadRobot m c s) => Order -> T.Text -> Tic
 newPosition order account tickerId operation quantity submissionDeadline = do
   lastTs <- view seLastTimestamp <$> getEnvironment
   let position = Position {
-    posId = [st|%?/%?/%?/%?/%?|] account tickerId operation quantity lastTs,
+    posId = TL.toStrict $ [t|%?/%?/%?/%?/%?|] account tickerId operation quantity lastTs,
     posAccount = account,
     posTicker = tickerId,
     posBalance = 0,
@@ -364,7 +365,7 @@ newPosition order account tickerId operation quantity submissionDeadline = do
   }
   modifyPositions (\p -> position : p)
   positions <- getPositions <$> getState
-  appendToLog $ [st|All positions: %?|] positions
+  appendToLog $ TL.toStrict $ [t|All positions: %?|] positions
   return position
 
 reapDeadPositions :: (StateHasPositions s) => EventCallback c s
@@ -509,7 +510,7 @@ enterAtLimitForTickerWithParams :: (StateHasPositions s, MonadRobot m c s) => Ti
 enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation = do
   lastTs <- view seLastTimestamp <$> getEnvironment
   submitOrder order
-  appendToLog $ [st|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs)
+  appendToLog $ TL.toStrict $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs)
   newPosition order account tickerId operation quantity 20 >>=
     modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs })
   where
@@ -579,7 +580,7 @@ exitAtLimit timeToCancel price position operationSignalName = do
     Just order -> cancelOrder (orderId order)
     Nothing    -> doNothing
   submitOrder (closeOrder inst)
-  appendToLog $ [st|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
+  appendToLog $ TL.toStrict $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
   modifyPosition (\pos ->
     pos { posCurrentOrder = Nothing,
       posState = PositionWaitingCloseSubmission (closeOrder inst),

stack.yaml

@@ -18,7 +18,7 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-12.9
+resolver: lts-17.14
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.
@@ -46,10 +46,8 @@ extra-deps:
 - list-extras-0.4.1.4
 - snowball-1.0.0.1
 - binary-ieee754-0.1.0.0
-- th-printf-0.5.1
+- th-printf-0.7
 - normaldistribution-1.1.0.3
-- text-format-0.3.2
-- ether-0.5.1.0
 
 # Override default flag values for local packages and extra-deps
 # flags: {}