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

Cleanup

stable
Denis Tereshkin 5 years ago
parent
23f5e0ab8c
commit
e4c4699c69
6 changed files with 28 additions and 22 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. 1
      robocom-zero.cabal
  2. 3
      src/ATrade/Driver/Backtest.hs
  3. 4
      src/ATrade/Driver/Real.hs
  4. 2
      src/ATrade/Driver/Types.hs
  5. 12
      src/ATrade/RoboCom/Monad.hs
  6. 28
      src/ATrade/RoboCom/Positions.hs

1
robocom-zero.cabal
Unescape View File

@ -66,6 +66,7 @@ library
, hedis , hedis
, gitrev , gitrev
, data-default , data-default
, template-haskell
default-language: Haskell2010 default-language: Haskell2010
other-modules: ATrade.Exceptions other-modules: ATrade.Exceptions

3
src/ATrade/Driver/Backtest.hs
Unescape View File

@ -44,6 +44,7 @@ import qualified Data.Sequence as Seq
import Data.STRef (newSTRef, readSTRef, writeSTRef) import Data.STRef (newSTRef, readSTRef, writeSTRef)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.IO (putStrLn) import Data.Text.IO (putStrLn)
import qualified Data.Text.Lazy as TL
import Data.Time.Calendar (fromGregorian) import Data.Time.Calendar (fromGregorian)
import Data.Time.Clock (DiffTime, UTCTime (..)) import Data.Time.Clock (DiffTime, UTCTime (..))
import Data.Vector ((!), (!?), (//)) import Data.Vector ((!), (!?), (//))
@ -314,7 +315,7 @@ instance MonadRobot (BacktestingMonad c s) c s where
xs -> do xs -> do
mapM_ (\o -> pendingEvents %= (\s -> s |> (OrderUpdate (orderId o) Cancelled))) xs mapM_ (\o -> pendingEvents %= (\s -> s |> (OrderUpdate (orderId o) Cancelled))) xs
pendingOrders .= otherOrders pendingOrders .= otherOrders
appendToLog txt = logs %= ((:) txt) appendToLog txt = logs %= ((:) (TL.toStrict txt))
setupTimer time = pendingTimers %= ((:) time) setupTimer time = pendingTimers %= ((:) time)
enqueueIOAction _actionId _action = error "Backtesting io actions is not supported" enqueueIOAction _actionId _action = error "Backtesting io actions is not supported"
getConfig = use robotParams getConfig = use robotParams

4
src/ATrade/Driver/Real.hs
Unescape View File

@ -47,6 +47,7 @@ import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import qualified Data.Text as T import qualified Data.Text as T
import Data.Text.Encoding import Data.Text.Encoding
import qualified Data.Text.Lazy as TL
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
@ -59,7 +60,6 @@ import System.Log.Formatter
import System.Log.Handler (setFormatter) import System.Log.Handler (setFormatter)
import System.Log.Handler.Simple import System.Log.Handler.Simple
import System.Log.Logger import System.Log.Logger
import System.Random
import System.Signal import System.Signal
import System.ZMQ4 hiding (Event (..)) import System.ZMQ4 hiding (Event (..))
@ -141,7 +141,7 @@ instance MonadRobot (App historySource c s) c s where
bc <- asks envBrokerChan bc <- asks envBrokerChan
lift $ BC.writeChan bc $ BrokerCancelOrder oId lift $ BC.writeChan bc $ BrokerCancelOrder oId
appendToLog = lift . debugM "Strategy" . T.unpack appendToLog = lift . debugM "Strategy" . T.unpack . TL.toStrict
setupTimer t = do setupTimer t = do
timers <- asks envTimers timers <- asks envTimers
lift $ atomicModifyIORef' timers (\s -> (t : s, ())) lift $ atomicModifyIORef' timers (\s -> (t : s, ()))

2
src/ATrade/Driver/Types.hs
Unescape View File

@ -6,11 +6,9 @@ module ATrade.Driver.Types
InitializationCallback InitializationCallback
) where ) where
import ATrade.RoboCom.Monad
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Clock
-- | Strategy instance params store few params which are common for all strategies -- | Strategy instance params store few params which are common for all strategies
data StrategyInstanceParams = StrategyInstanceParams { data StrategyInstanceParams = StrategyInstanceParams {

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

@ -19,7 +19,8 @@ module ATrade.RoboCom.Monad (
Event(..), Event(..),
MonadRobot(..), MonadRobot(..),
also, also,
t t,
st
) where ) where
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
@ -27,14 +28,16 @@ import ATrade.Types
import Control.Lens import Control.Lens
import Data.Aeson.Types import Data.Aeson.Types
import qualified Data.Text as T import qualified Data.Text as T
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)
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 () submitOrder :: Order -> m ()
cancelOrder :: OrderId -> m () cancelOrder :: OrderId -> m ()
appendToLog :: T.Text -> m () appendToLog :: 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
@ -46,6 +49,9 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
setState (f oldState) setState (f oldState)
getEnvironment :: m StrategyEnvironment getEnvironment :: m StrategyEnvironment
st :: QuasiQuoter
st = t
type EventCallback c s = forall m . MonadRobot m c s => Event -> m () type EventCallback c s = forall m . MonadRobot m c s => Event -> m ()
data Event = NewBar Bar data Event = NewBar Bar

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

@ -207,49 +207,49 @@ dispatchPosition event pos = case posState pos of
then then
if posBalance pos == 0 if posBalance pos == 0
then do then do
appendToLog $ TL.toStrict $ [t|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs appendToLog $ [t|"In PositionWaitingOpen: execution timeout: %?/%?"|] (posExecutionDeadline pos) lastTs
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 $ TL.toStrict $ [t|Order executed (partially, %? / %?): %?|] (posBalance pos) (orderQuantity order) order appendToLog $ [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 $ TL.toStrict $ [t|Order cancelled in PositionWaitingOpen: balance %d, max %d|] (posBalance pos) (orderQuantity order) appendToLog $ [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 $ TL.toStrict $ [t|Order executed: %?|] order appendToLog $ [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 $ TL.toStrict $ [t|Order rejected: %?|] order appendToLog $ [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 $ TL.toStrict $ [t|In PositionWaitingOpen: order state update: %?|] newstate appendToLog $ [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 $ TL.toStrict $ [t|Order new trade: %?/%?|] order trade appendToLog $ [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 $ TL.toStrict $ [t|W: No current order in PositionWaitingOpen state: %?|] pos appendToLog $ [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 $ TL.toStrict $ [t|PositionId: %? : Missed submission deadline: %?, remaining in PositionOpen state|] (posId pos) (posSubmissionDeadline pos) appendToLog $ [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 $ TL.toStrict $ [t|PositionId: %? : Missed execution deadline: %?, remaining in PositionOpen state|] (posId pos) (posExecutionDeadline pos) appendToLog $ [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
@ -308,7 +308,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 $ TL.toStrict $ [t|Was unable to close position, remaining balance: %?|] (posBalance pos) appendToLog $ [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) ->
@ -365,7 +365,7 @@ newPosition order account tickerId operation quantity submissionDeadline = do
} }
modifyPositions (\p -> position : p) modifyPositions (\p -> position : p)
positions <- getPositions <$> getState positions <- getPositions <$> getState
appendToLog $ TL.toStrict $ [t|All positions: %?|] positions appendToLog $ [t|All positions: %?|] positions
return position return position
reapDeadPositions :: (StateHasPositions s) => EventCallback c s reapDeadPositions :: (StateHasPositions s) => EventCallback c s
@ -510,7 +510,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
submitOrder order submitOrder order
appendToLog $ TL.toStrict $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs) appendToLog $ [t|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs)
newPosition order account tickerId operation quantity 20 >>= newPosition order 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 +580,7 @@ exitAtLimit timeToCancel price position operationSignalName = do
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
Nothing -> doNothing Nothing -> doNothing
submitOrder (closeOrder inst) submitOrder (closeOrder inst)
appendToLog $ TL.toStrict $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs) appendToLog $ [t|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
modifyPosition (\pos -> modifyPosition (\pos ->
pos { posCurrentOrder = Nothing, pos { posCurrentOrder = Nothing,
posState = PositionWaitingCloseSubmission (closeOrder inst), posState = PositionWaitingCloseSubmission (closeOrder inst),

Write Preview
Loading…
Cancel
Save