From fd7add7b4e5ae6598341305ab36f3fac743a46a7 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Wed, 2 Jun 2021 22:00:56 +0700 Subject: [PATCH] Update to lts-17.14 --- robocom-zero.cabal | 4 ++-- src/ATrade/Exceptions.hs | 6 +++++- src/ATrade/RoboCom/Monad.hs | 6 +++--- src/ATrade/RoboCom/Positions.hs | 31 ++++++++++++++++--------------- stack.yaml | 6 ++---- 5 files changed, 28 insertions(+), 25 deletions(-) diff --git a/robocom-zero.cabal b/robocom-zero.cabal index 1a21917..6014371 100644 --- a/robocom-zero.cabal +++ b/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 diff --git a/src/ATrade/Exceptions.hs b/src/ATrade/Exceptions.hs index f18cd37..42aec43 100644 --- a/src/ATrade/Exceptions.hs +++ b/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 diff --git a/src/ATrade/RoboCom/Monad.hs b/src/ATrade/RoboCom/Monad.hs index 0f24a80..69a4769 100644 --- a/src/ATrade/RoboCom/Monad.hs +++ b/src/ATrade/RoboCom/Monad.hs @@ -19,7 +19,7 @@ module ATrade.RoboCom.Monad ( Event(..), MonadRobot(..), also, - st + t ) where import ATrade.RoboCom.Types @@ -27,9 +27,9 @@ import ATrade.Types import Control.Lens import Data.Aeson.Types -import qualified Data.Text as T +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 () diff --git a/src/ATrade/RoboCom/Positions.hs b/src/ATrade/RoboCom/Positions.hs index d9e3029..a8afc27 100644 --- a/src/ATrade/RoboCom/Positions.hs +++ b/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), diff --git a/stack.yaml b/stack.yaml index 0f38d38..ae397ab 100644 --- a/stack.yaml +++ b/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: {}