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

Formatting

master
Denis Tereshkin 7 years ago
parent
813b15fc6b
commit
a026e8ac60
16 changed files with 268 additions and 267 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. 2
      src/ATrade/Driver/Backtest.hs
  2. 38
      src/ATrade/Driver/Real/BrokerClientThread.hs
  3. 29
      src/ATrade/Driver/Real/QuoteSourceThread.hs
  4. 34
      src/ATrade/Driver/Real/Types.hs
  5. 44
      src/ATrade/Forums/Smartlab.hs
  6. 52
      src/ATrade/Quotes/HAP.hs
  7. 40
      src/ATrade/Quotes/QHP.hs
  8. 20
      src/ATrade/Quotes/QTIS.hs
  9. 11
      src/ATrade/RoboCom/Indicators.hs
  10. 47
      src/ATrade/RoboCom/Monad.hs
  11. 88
      src/ATrade/RoboCom/Positions.hs
  12. 32
      src/ATrade/RoboCom/Types.hs
  13. 16
      src/ATrade/RoboCom/Utils.hs
  14. 18
      test/Test/RoboCom/Indicators.hs
  15. 18
      test/Test/RoboCom/Utils.hs

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

@ -2,8 +2,8 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RankNTypes #-}
module ATrade.Driver.Backtest ( module ATrade.Driver.Backtest (
backtestMain backtestMain

38
src/ATrade/Driver/Real/BrokerClientThread.hs
Unescape View File

@ -5,26 +5,28 @@ module ATrade.Driver.Real.BrokerClientThread (
BrokerCommand(..) BrokerCommand(..)
) where ) where
import ATrade.Broker.Client import ATrade.Broker.Client
import ATrade.Broker.Protocol import ATrade.Broker.Protocol
import ATrade.RoboCom.Monad hiding (submitOrder, cancelOrder) import ATrade.RoboCom.Monad hiding (cancelOrder,
import ATrade.RoboCom.Types submitOrder)
import ATrade.Types import ATrade.RoboCom.Types
import ATrade.Types
import Control.Concurrent.BoundedChan import Control.Concurrent hiding (readChan, writeChan,
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield) writeList2Chan, yield)
import Control.Exception import Control.Concurrent.BoundedChan
import Control.Monad.Loops import Control.Exception
import Control.Monad import Control.Monad
import Control.Monad.Loops
import Data.IORef import Data.IORef
import qualified Data.Text as T import Data.Maybe
import Data.Text.Encoding import qualified Data.Text as T
import Data.Time.Clock import Data.Text.Encoding
import Data.Maybe import Data.Time.Clock
import System.Log.Logger import System.Log.Logger
import System.ZMQ4 hiding (Event) import System.ZMQ4 hiding (Event)
data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications
@ -78,4 +80,4 @@ sendNotification :: BoundedChan Event -> Notification -> IO ()
sendNotification eventChan notification = sendNotification eventChan notification =
writeChan eventChan $ case notification of writeChan eventChan $ case notification of
OrderNotification oid state -> OrderUpdate oid state OrderNotification oid state -> OrderUpdate oid state
TradeNotification trade -> NewTrade trade TradeNotification trade -> NewTrade trade

29
src/ATrade/Driver/Real/QuoteSourceThread.hs
Unescape View File

@ -5,23 +5,24 @@ module ATrade.Driver.Real.QuoteSourceThread
startQuoteSourceThread startQuoteSourceThread
) where ) where
import ATrade.BarAggregator import ATrade.BarAggregator
import ATrade.QuoteSource.Client import ATrade.Driver.Real.Types
import ATrade.RoboCom.Monad import ATrade.QuoteSource.Client
import ATrade.RoboCom.Types import ATrade.RoboCom.Monad
import ATrade.Types import ATrade.RoboCom.Types
import ATrade.Driver.Real.Types import ATrade.Types
import Data.IORef import Data.IORef
import qualified Data.Text as T import qualified Data.Text as T
import Control.Concurrent.BoundedChan import Control.Concurrent hiding (readChan, writeChan,
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield) writeList2Chan, yield)
import Control.Exception import Control.Concurrent.BoundedChan
import Control.Monad import Control.Exception
import Control.Monad
import System.Log.Logger import System.Log.Logger
import System.ZMQ4 hiding (Event) import System.ZMQ4 hiding (Event)
startQuoteSourceThread :: Context -> T.Text -> Strategy c s -> BoundedChan Event -> IORef BarAggregator -> (Tick -> Bool) -> IO ThreadId startQuoteSourceThread :: Context -> T.Text -> Strategy c s -> BoundedChan Event -> IORef BarAggregator -> (Tick -> Bool) -> IO ThreadId
startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter = forkIO $ do startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter = forkIO $ do

34
src/ATrade/Driver/Real/Types.hs
Unescape View File

@ -6,34 +6,34 @@ module ATrade.Driver.Real.Types (
InitializationCallback InitializationCallback
) where ) where
import ATrade.RoboCom.Monad import ATrade.RoboCom.Monad
import ATrade.RoboCom.Types import ATrade.RoboCom.Types
import Data.Time.Clock import qualified Data.Text as T
import qualified Data.Text as T import Data.Time.Clock
-- | Top-level strategy configuration and state -- | Top-level strategy configuration and state
data Strategy c s = BarStrategy { data Strategy c s = BarStrategy {
downloadDelta :: DiffTime, -- ^ How much history to download at strategy start downloadDelta :: DiffTime, -- ^ How much history to download at strategy start
eventCallback :: EventCallback c s, -- ^ Strategy event callback eventCallback :: EventCallback c s, -- ^ Strategy event callback
currentState :: s, -- ^ Current strategy state. Updated after each 'EventCallback' call currentState :: s, -- ^ Current strategy state. Updated after each 'EventCallback' call
strategyParams :: c, -- ^ Strategy params strategyParams :: c, -- ^ Strategy params
strategyTimers :: [UTCTime], strategyTimers :: [UTCTime],
strategyInstanceParams :: StrategyInstanceParams -- ^ Instance params strategyInstanceParams :: StrategyInstanceParams -- ^ Instance params
} }
-- | 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 {
strategyInstanceId :: T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable) strategyInstanceId :: T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable)
strategyAccount :: T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent strategyAccount :: T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent
strategyVolume :: Int, -- ^ Volume to use for this instance (in lots/contracts) strategyVolume :: Int, -- ^ Volume to use for this instance (in lots/contracts)
tickers :: [Ticker], -- ^ List of tickers which is used by this strategy tickers :: [Ticker], -- ^ List of tickers which is used by this strategy
strategyQuotesourceEp :: T.Text, -- ^ QuoteSource server endpoint strategyQuotesourceEp :: T.Text, -- ^ QuoteSource server endpoint
strategyBrokerEp :: T.Text, -- ^ Broker server endpoint strategyBrokerEp :: T.Text, -- ^ Broker server endpoint
strategyHistoryProviderType :: T.Text, strategyHistoryProviderType :: T.Text,
strategyHistoryProvider :: T.Text, strategyHistoryProvider :: T.Text,
strategyQTISEp :: Maybe T.Text strategyQTISEp :: Maybe T.Text
} }
type InitializationCallback c = c -> StrategyInstanceParams -> IO c type InitializationCallback c = c -> StrategyInstanceParams -> IO c

44
src/ATrade/Forums/Smartlab.hs
Unescape View File

@ -8,32 +8,32 @@ module ATrade.Forums.Smartlab (
) where ) where
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import qualified Data.List as L
import Data.Text.Encoding import Data.Maybe
import qualified Data.List as L import qualified Data.Text as T
import Data.Time.Calendar import Data.Text.Encoding
import Data.Time.Clock import Data.Time.Calendar
import Data.Maybe import Data.Time.Clock
import Network.HTTP.Simple import Network.HTTP.Simple
import Safe import Safe
import Text.HTML.TagSoup import Text.HTML.TagSoup
import Text.Parsec import Text.Parsec
import Text.Parsec.Text import Text.Parsec.Text
import Text.StringLike import Text.StringLike
import Debug.Trace import Debug.Trace
data NewsItem = NewsItem { data NewsItem = NewsItem {
niUrl :: !T.Text, niUrl :: !T.Text,
niHeader :: !T.Text, niHeader :: !T.Text,
niText :: !T.Text, niText :: !T.Text,
niAuthor :: !T.Text, niAuthor :: !T.Text,
niPubTime :: !UTCTime niPubTime :: !UTCTime
} deriving (Show, Eq) } deriving (Show, Eq)
data IndexItem = IndexItem { data IndexItem = IndexItem {
iiUrl :: !T.Text, iiUrl :: !T.Text,
iiTitle :: !T.Text, iiTitle :: !T.Text,
iiPubTime :: !UTCTime iiPubTime :: !UTCTime
} deriving (Show, Eq) } deriving (Show, Eq)
@ -49,13 +49,13 @@ extractBetween tagName = takeWhile (~/= closeTag) . dropWhile (~/= openTag)
matchClass :: T.Text -> T.Text -> Tag T.Text -> Bool matchClass :: T.Text -> T.Text -> Tag T.Text -> Bool
matchClass _ className (TagOpen _ attrs) = case L.lookup (T.pack "class") attrs of matchClass _ className (TagOpen _ attrs) = case L.lookup (T.pack "class") attrs of
Just klass -> className `L.elem` T.words klass Just klass -> className `L.elem` T.words klass
Nothing -> False Nothing -> False
matchClass _ _ _ = False matchClass _ _ _ = False
parseTimestamp :: T.Text -> Maybe UTCTime parseTimestamp :: T.Text -> Maybe UTCTime
parseTimestamp text = case parse timestampParser "" text of parseTimestamp text = case parse timestampParser "" text of
Left _ -> Nothing Left _ -> Nothing
Right val -> Just val Right val -> Just val
where where
timestampParser :: Parser UTCTime timestampParser :: Parser UTCTime

52
src/ATrade/Quotes/HAP.hs
Unescape View File

@ -6,17 +6,17 @@ module ATrade.Quotes.HAP (
RequestParams(..) RequestParams(..)
) where ) where
import ATrade.Types import ATrade.Types
import Data.Aeson import Data.Aeson
import qualified Data.Text as T import Data.Binary.Get
import qualified Data.ByteString.Lazy as BL import Data.Binary.IEEE754
import Data.Binary.Get import qualified Data.ByteString.Lazy as BL
import Data.Binary.IEEE754 import qualified Data.Text as T
import Data.Time.Clock import Data.Time.Calendar
import Data.Time.Calendar import Data.Time.Clock
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import System.ZMQ4 import System.Log.Logger
import System.Log.Logger import System.ZMQ4
data Period = data Period =
Period1Min | Period1Min |
@ -30,23 +30,23 @@ data Period =
deriving (Eq) deriving (Eq)
instance Show Period where instance Show Period where
show Period1Min = "M1" show Period1Min = "M1"
show Period5Min = "M5" show Period5Min = "M5"
show Period15Min = "M15" show Period15Min = "M15"
show Period30Min = "M30" show Period30Min = "M30"
show PeriodHour = "H1" show PeriodHour = "H1"
show PeriodDay = "D" show PeriodDay = "D"
show PeriodWeek = "W" show PeriodWeek = "W"
show PeriodMonth = "MN" show PeriodMonth = "MN"
data RequestParams = data RequestParams =
RequestParams RequestParams
{ {
endpoint :: T.Text, endpoint :: T.Text,
ticker :: T.Text, ticker :: T.Text,
startDate :: UTCTime, startDate :: UTCTime,
endDate :: UTCTime, endDate :: UTCTime,
period :: Period period :: Period
} deriving (Show, Eq) } deriving (Show, Eq)
instance ToJSON RequestParams where instance ToJSON RequestParams where
@ -73,13 +73,13 @@ getQuotes ctx params =
then resampleBars' p bars (aggregate currentBar bar) resampled then resampleBars' p bars (aggregate currentBar bar) resampled
else resampleBars' p bars bar (currentBar : resampled) else resampleBars' p bars bar (currentBar : resampled)
periodToSec Period1Min = 60 periodToSec Period1Min = 60
periodToSec Period5Min = 60 * 5 periodToSec Period5Min = 60 * 5
periodToSec Period15Min = 60 * 15 periodToSec Period15Min = 60 * 15
periodToSec Period30Min = 60 * 30 periodToSec Period30Min = 60 * 30
periodToSec PeriodHour = 60 * 60 periodToSec PeriodHour = 60 * 60
periodToSec PeriodDay = 60 * 60 * 24 periodToSec PeriodDay = 60 * 60 * 24
periodToSec PeriodWeek = 86400 * 7 periodToSec PeriodWeek = 86400 * 7
barNumber sec bar = truncate (utcTimeToPOSIXSeconds (barTimestamp bar)) `div` sec barNumber sec bar = truncate (utcTimeToPOSIXSeconds (barTimestamp bar)) `div` sec
@ -93,7 +93,7 @@ getQuotes ctx params =
parseBars :: TickerId -> BL.ByteString -> [Bar] parseBars :: TickerId -> BL.ByteString -> [Bar]
parseBars tickerId input = parseBars tickerId input =
case runGetOrFail parseBar input of case runGetOrFail parseBar input of
Left _ -> [] Left _ -> []
Right (rest, _, bar) -> bar : parseBars tickerId rest Right (rest, _, bar) -> bar : parseBars tickerId rest
where where
parseBar = do parseBar = do

40
src/ATrade/Quotes/QHP.hs
Unescape View File

@ -6,16 +6,16 @@ module ATrade.Quotes.QHP (
RequestParams(..) RequestParams(..)
) where ) where
import ATrade.Types import ATrade.Types
import Data.Aeson import Data.Aeson
import qualified Data.Text as T import Data.Binary.Get
import qualified Data.ByteString.Lazy as BL import Data.Binary.IEEE754
import Data.Binary.Get import qualified Data.ByteString.Lazy as BL
import Data.Binary.IEEE754 import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar
import Data.Time.Clock.POSIX import Data.Time.Clock.POSIX
import System.ZMQ4 import System.Log.Logger
import System.Log.Logger import System.ZMQ4
data Period = data Period =
Period1Min | Period1Min |
@ -29,23 +29,23 @@ data Period =
deriving (Eq) deriving (Eq)
instance Show Period where instance Show Period where
show Period1Min = "M1" show Period1Min = "M1"
show Period5Min = "M5" show Period5Min = "M5"
show Period15Min = "M15" show Period15Min = "M15"
show Period30Min = "M30" show Period30Min = "M30"
show PeriodHour = "H1" show PeriodHour = "H1"
show PeriodDay = "D" show PeriodDay = "D"
show PeriodWeek = "W" show PeriodWeek = "W"
show PeriodMonth = "MN" show PeriodMonth = "MN"
data RequestParams = data RequestParams =
RequestParams RequestParams
{ {
endpoint :: T.Text, endpoint :: T.Text,
ticker :: T.Text, ticker :: T.Text,
startDate :: Day, startDate :: Day,
endDate :: Day, endDate :: Day,
period :: Period period :: Period
} deriving (Show, Eq) } deriving (Show, Eq)
instance ToJSON RequestParams where instance ToJSON RequestParams where
@ -70,7 +70,7 @@ getQuotes ctx params =
parseBars :: TickerId -> BL.ByteString -> [Bar] parseBars :: TickerId -> BL.ByteString -> [Bar]
parseBars tickerId input = parseBars tickerId input =
case runGetOrFail parseBar input of case runGetOrFail parseBar input of
Left _ -> [] Left _ -> []
Right (rest, _, bar) -> bar : parseBars tickerId rest Right (rest, _, bar) -> bar : parseBars tickerId rest
where where
parseBar = do parseBar = do

20
src/ATrade/Quotes/QTIS.hs
Unescape View File

@ -7,19 +7,19 @@ module ATrade.Quotes.QTIS
qtisGetTickersInfo' qtisGetTickersInfo'
) where ) where
import ATrade.Types import ATrade.Types
import Control.Monad import Control.Monad
import Data.Aeson import Data.Aeson
import Data.Maybe
import qualified Data.ByteString.Char8 as BC8 import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T import Data.Maybe
import System.ZMQ4 import qualified Data.Text as T
import System.Log.Logger import System.Log.Logger
import System.ZMQ4
data TickerInfo = TickerInfo { data TickerInfo = TickerInfo {
tiTicker :: T.Text, tiTicker :: T.Text,
tiLotSize :: Integer, tiLotSize :: Integer,
tiTickSize :: Price tiTickSize :: Price
} deriving (Show, Eq) } deriving (Show, Eq)

11
src/ATrade/RoboCom/Indicators.hs
Unescape View File

@ -18,12 +18,11 @@ module ATrade.RoboCom.Indicators
percentRank percentRank
) where ) where
import ATrade.Types import ATrade.Types
import qualified Data.List as L import qualified Data.List as L
import Data.Time.Clock import Data.Time.Clock
import Safe import Safe
import Debug.Trace
cmf :: Int -> [Bar] -> Double cmf :: Int -> [Bar] -> Double
cmf period bars = sum (toDouble . clv <$> take period bars) / toDouble (sum (fromInteger . barVolume <$> bars)) cmf period bars = sum (toDouble . clv <$> take period bars) / toDouble (sum (fromInteger . barVolume <$> bars))
@ -90,7 +89,7 @@ emaWithAlpha alpha values = foldl (\x y -> x * (1 - alpha) + y * alpha) 0 $ reve
intradayBarNumber :: [Bar] -> Int intradayBarNumber :: [Bar] -> Int
intradayBarNumber bars = case headMay bars of intradayBarNumber bars = case headMay bars of
Just bar -> intradayBarNumber' bar bars - 1 Just bar -> intradayBarNumber' bar bars - 1
Nothing -> 0 Nothing -> 0
where where
intradayBarNumber' :: Bar -> [Bar] -> Int intradayBarNumber' :: Bar -> [Bar] -> Int
intradayBarNumber' bar bars' = case headMay bars' of intradayBarNumber' bar bars' = case headMay bars' of

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

@ -1,13 +1,12 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-} {-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
module ATrade.RoboCom.Monad ( module ATrade.RoboCom.Monad (
RState, RState,
@ -27,15 +26,15 @@ module ATrade.RoboCom.Monad (
st st
) where ) where
import ATrade.Types import ATrade.RoboCom.Types
import ATrade.RoboCom.Types import ATrade.Types
import Ether import Ether
import Data.Time.Clock import Data.Aeson.Types
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 Text.Printf.TH
class (Monad m) => MonadRobot m c s | m -> c, m -> s where class (Monad m) => MonadRobot m c s | m -> c, m -> s where
@ -85,19 +84,19 @@ data StrategyAction = ActionOrder Order
| ActionIO Int (IO Value) | ActionIO Int (IO Value)
data StrategyEnvironment = StrategyEnvironment { data StrategyEnvironment = StrategyEnvironment {
seInstanceId :: !T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable) seInstanceId :: !T.Text, -- ^ Strategy instance identifier. Should be unique among all strategies (very desirable)
seAccount :: !T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent seAccount :: !T.Text, -- ^ Account string to use for this strategy instance. Broker-dependent
seVolume :: !Int, -- ^ Volume to use for this instance (in lots/contracts) seVolume :: !Int, -- ^ Volume to use for this instance (in lots/contracts)
seBars :: !Bars, -- ^ List of tickers which is used by this strategy seBars :: !Bars, -- ^ List of tickers which is used by this strategy
seLastTimestamp :: !UTCTime seLastTimestamp :: !UTCTime
} deriving (Eq) } deriving (Eq)
instance Show StrategyAction where instance Show StrategyAction where
show (ActionOrder order) = "ActionOrder " ++ show order show (ActionOrder order) = "ActionOrder " ++ show order
show (ActionCancelOrder oid) = "ActionCancelOrder " ++ show oid show (ActionCancelOrder oid) = "ActionCancelOrder " ++ show oid
show (ActionLog t) = "ActionLog " ++ show t show (ActionLog t) = "ActionLog " ++ show t
show (ActionIO x _) = "ActionIO " ++ show x show (ActionIO x _) = "ActionIO " ++ show x
show (ActionSetupTimer t) = "ActionSetupTimer e" ++ show t show (ActionSetupTimer t) = "ActionSetupTimer e" ++ show t
tellAction :: StrategyAction -> StrategyElement c s () tellAction :: StrategyAction -> StrategyElement c s ()
tellAction a = tell @RActions [a] tellAction a = tell @RActions [a]

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

@ -1,9 +1,9 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE QuasiQuotes #-}
{-| {-|
- Module : ATrade.RoboCom.Combinators - Module : ATrade.RoboCom.Combinators
@ -67,20 +67,20 @@ module ATrade.RoboCom.Positions
setStopLossAndTakeProfit setStopLossAndTakeProfit
) where ) where
import GHC.Generics import GHC.Generics
import ATrade.Types import ATrade.RoboCom.Monad
import ATrade.RoboCom.Monad import ATrade.RoboCom.Types
import ATrade.RoboCom.Types import ATrade.Types
import Control.Monad import Control.Monad
import Ether import Ether
import Data.Aeson import Data.Aeson
import qualified Data.Map as M import qualified Data.List as L
import qualified Data.List as L import qualified Data.Map as M
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Clock import Data.Time.Clock
data PositionState = PositionWaitingOpenSubmission Order data PositionState = PositionWaitingOpenSubmission Order
| PositionWaitingOpen | PositionWaitingOpen
@ -93,20 +93,20 @@ data PositionState = PositionWaitingOpenSubmission Order
deriving (Show, Eq, Generic) deriving (Show, Eq, Generic)
data Position = Position { data Position = Position {
posId :: T.Text, posId :: T.Text,
posAccount :: T.Text, posAccount :: T.Text,
posTicker :: TickerId, posTicker :: TickerId,
posBalance :: Integer, posBalance :: Integer,
posState :: PositionState, posState :: PositionState,
posNextState :: Maybe PositionState, posNextState :: Maybe PositionState,
posStopPrice :: Maybe Price, posStopPrice :: Maybe Price,
posStopLimitPrice :: Maybe Price, posStopLimitPrice :: Maybe Price,
posTakeProfitPrice :: Maybe Price, posTakeProfitPrice :: Maybe Price,
posCurrentOrder :: Maybe Order, posCurrentOrder :: Maybe Order,
posSubmissionDeadline :: Maybe UTCTime, posSubmissionDeadline :: Maybe UTCTime,
posExecutionDeadline :: Maybe UTCTime, posExecutionDeadline :: Maybe UTCTime,
posEntryTime :: Maybe UTCTime, posEntryTime :: Maybe UTCTime,
posExitTime :: Maybe UTCTime posExitTime :: Maybe UTCTime
} deriving (Show, Eq, Generic) } deriving (Show, Eq, Generic)
posEqByIds :: Position -> Position -> Bool posEqByIds :: Position -> Position -> Bool
@ -171,7 +171,7 @@ orderDeadline :: Maybe UTCTime -> UTCTime -> Bool
orderDeadline maybeDeadline lastTs = orderDeadline maybeDeadline lastTs =
case maybeDeadline of case maybeDeadline of
Just deadline -> lastTs >= deadline Just deadline -> lastTs >= deadline
Nothing -> False Nothing -> False
dispatchPosition :: (StateHasPositions s, MonadRobot m c s) => Event -> Position -> m Position dispatchPosition :: (StateHasPositions s, MonadRobot m c s) => Event -> Position -> m Position
@ -249,7 +249,7 @@ dispatchPosition event pos = case posState pos of
| otherwise -> case event of | otherwise -> case event of
NewTick tick -> if NewTick tick -> if
| datatype tick == LastTradePrice && stopLoss tick -> case posStopLimitPrice pos of | datatype tick == LastTradePrice && stopLoss tick -> case posStopLimitPrice pos of
Nothing -> exitAtMarket pos "stop" Nothing -> exitAtMarket pos "stop"
Just lim -> exitAtLimit 86400 lim pos "stop" Just lim -> exitAtLimit 86400 lim pos "stop"
| datatype tick == LastTradePrice && takeProfit tick -> exitAtMarket pos "take_profit" | datatype tick == LastTradePrice && takeProfit tick -> exitAtMarket pos "take_profit"
| otherwise -> return pos | otherwise -> return pos
@ -285,7 +285,7 @@ dispatchPosition event pos = case posState pos of
then do then do
case posCurrentOrder pos of case posCurrentOrder pos of
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
Nothing -> doNothing Nothing -> doNothing
return $ pos { posCurrentOrder = Nothing, posState = PositionOpen, posSubmissionDeadline = Nothing } -- TODO call TimeoutHandler if present return $ pos { posCurrentOrder = Nothing, posState = PositionOpen, posSubmissionDeadline = Nothing } -- TODO call TimeoutHandler if present
else case event of else case event of
OrderSubmitted order -> OrderSubmitted order ->
@ -302,7 +302,7 @@ dispatchPosition event pos = case posState pos of
then do then do
case posCurrentOrder pos of case posCurrentOrder pos of
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
_ -> doNothing _ -> doNothing
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) ->
@ -381,7 +381,7 @@ getCurrentTicker = do
maybeBars <- flip M.lookup bars . mainTicker <$> getConfig maybeBars <- flip M.lookup bars . mainTicker <$> getConfig
case maybeBars of case maybeBars of
Just b -> return $ bsBars b Just b -> return $ bsBars b
_ -> return [] _ -> return []
getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries) getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries)
getCurrentTickerSeries = do getCurrentTickerSeries = do
@ -403,48 +403,48 @@ getAllActiveAndPendingPositions = L.filter
where where
isPositionWaitingOpenSubmission pos = case posState pos of isPositionWaitingOpenSubmission pos = case posState pos of
PositionWaitingOpenSubmission _ -> True PositionWaitingOpenSubmission _ -> True
_ -> False _ -> False
onNewBarEvent :: (MonadRobot m c s) => Event -> (Bar -> m ()) -> m () onNewBarEvent :: (MonadRobot m c s) => Event -> (Bar -> m ()) -> m ()
onNewBarEvent event f = case event of onNewBarEvent event f = case event of
NewBar bar -> f bar NewBar bar -> f bar
_ -> doNothing _ -> doNothing
onNewTickEvent :: (MonadRobot m c s) => Event -> (Tick -> m ()) -> m () onNewTickEvent :: (MonadRobot m c s) => Event -> (Tick -> m ()) -> m ()
onNewTickEvent event f = case event of onNewTickEvent event f = case event of
NewTick tick -> f tick NewTick tick -> f tick
_ -> doNothing _ -> doNothing
onNewTickEventWithDatatype :: (MonadRobot m c s) => Event -> DataType -> (Tick -> m ()) -> m () onNewTickEventWithDatatype :: (MonadRobot m c s) => Event -> DataType -> (Tick -> m ()) -> m ()
onNewTickEventWithDatatype event dtype f = case event of onNewTickEventWithDatatype event dtype f = case event of
NewTick tick -> when (datatype tick == dtype) $ f tick NewTick tick -> when (datatype tick == dtype) $ f tick
_ -> doNothing _ -> doNothing
onTimerFiredEvent :: (MonadRobot m c s) => Event -> (UTCTime -> m ()) -> m () onTimerFiredEvent :: (MonadRobot m c s) => Event -> (UTCTime -> m ()) -> m ()
onTimerFiredEvent event f = case event of onTimerFiredEvent event f = case event of
TimerFired timer -> f timer TimerFired timer -> f timer
_ -> doNothing _ -> doNothing
onOrderSubmittedEvent :: (MonadRobot m c s) => Event -> (Order -> m ()) -> m () onOrderSubmittedEvent :: (MonadRobot m c s) => Event -> (Order -> m ()) -> m ()
onOrderSubmittedEvent event f = case event of onOrderSubmittedEvent event f = case event of
OrderSubmitted order -> f order OrderSubmitted order -> f order
_ -> doNothing _ -> doNothing
onOrderUpdateEvent :: (MonadRobot m c s) => Event -> (OrderId -> OrderState -> m ()) -> m () onOrderUpdateEvent :: (MonadRobot m c s) => Event -> (OrderId -> OrderState -> m ()) -> m ()
onOrderUpdateEvent event f = case event of onOrderUpdateEvent event f = case event of
OrderUpdate oid newstate -> f oid newstate OrderUpdate oid newstate -> f oid newstate
_ -> doNothing _ -> doNothing
onTradeEvent :: (MonadRobot m c s) => Event -> (Trade -> m ()) -> m () onTradeEvent :: (MonadRobot m c s) => Event -> (Trade -> m ()) -> m ()
onTradeEvent event f = case event of onTradeEvent event f = case event of
NewTrade trade -> f trade NewTrade trade -> f trade
_ -> doNothing _ -> doNothing
onActionCompletedEvent :: (MonadRobot m c s) => Event -> (Int -> Value -> m ()) -> m () onActionCompletedEvent :: (MonadRobot m c s) => Event -> (Int -> Value -> m ()) -> m ()
onActionCompletedEvent event f = case event of onActionCompletedEvent event f = case event of
ActionCompleted tag v -> f tag v ActionCompleted tag v -> f tag v
_ -> doNothing _ -> doNothing
enterAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Operation -> m Position enterAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Operation -> m Position
enterAtMarket signalName operation = do enterAtMarket signalName operation = do
@ -567,7 +567,7 @@ exitAtLimit timeToCancel price position signalName = do
inst <- seInstanceId <$> getEnvironment inst <- seInstanceId <$> getEnvironment
case posCurrentOrder position of case posCurrentOrder position of
Just order -> cancelOrder (orderId order) Just order -> cancelOrder (orderId order)
Nothing -> doNothing Nothing -> doNothing
submitOrder (closeOrder inst) submitOrder (closeOrder inst)
appendToLog $ [st|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs) appendToLog $ [st|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs)
modifyPosition (\pos -> modifyPosition (\pos ->

32
src/ATrade/RoboCom/Types.hs
Unescape View File

@ -1,8 +1,8 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
module ATrade.RoboCom.Types ( module ATrade.RoboCom.Types (
Bar(..), Bar(..),
@ -13,15 +13,15 @@ module ATrade.RoboCom.Types (
Bars Bars
) where ) where
import qualified Data.Text as T import ATrade.Types
import qualified Data.Text.Lazy as TL import Data.Aeson
import qualified Data.Map.Strict as M import Data.Aeson.Types
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Aeson import qualified Data.Map.Strict as M
import Data.Aeson.Types import qualified Data.Text as T
import ATrade.Types import qualified Data.Text.Lazy as TL
import Data.Time.Clock import Data.Time.Clock
import Text.Read hiding (String) import Text.Read hiding (String)
newtype Timeframe = newtype Timeframe =
Timeframe Integer deriving (Show, Eq) Timeframe Integer deriving (Show, Eq)
@ -31,15 +31,15 @@ tfSeconds (Timeframe s) = fromInteger s
data BarSeries = data BarSeries =
BarSeries { BarSeries {
bsTickerId :: TickerId, bsTickerId :: TickerId,
bsTimeframe :: Timeframe, bsTimeframe :: Timeframe,
bsBars :: [Bar] bsBars :: [Bar]
} deriving (Show, Eq) } deriving (Show, Eq)
-- | Ticker description record -- | Ticker description record
data Ticker = Ticker { data Ticker = Ticker {
code :: T.Text, -- ^ Main ticker code, which is used to make orders and tick parsing code :: T.Text, -- ^ Main ticker code, which is used to make orders and tick parsing
aliases :: [(String, String)], -- ^ List of aliases for this tick in the form ("alias-name", "alias"). aliases :: [(String, String)], -- ^ List of aliases for this tick in the form ("alias-name", "alias").
-- This is needed when other data providers use different codcodes for the same tick. -- This is needed when other data providers use different codcodes for the same tick.
-- For now, only "finam" alias is used -- For now, only "finam" alias is used
timeframeSeconds :: Integer -- ^ Data timeframe. Will be used by 'BarAggregator' timeframeSeconds :: Integer -- ^ Data timeframe. Will be used by 'BarAggregator'

16
src/ATrade/RoboCom/Utils.hs
Unescape View File

@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module ATrade.RoboCom.Utils ( module ATrade.RoboCom.Utils (
barStartTime, barStartTime,
@ -13,14 +13,14 @@ module ATrade.RoboCom.Utils (
parseTime parseTime
) where ) where
import ATrade.Types import ATrade.Types
import Data.Time.Clock import qualified Data.Text as T
import Data.Time.Calendar import Data.Text.Lazy.Builder
import qualified Data.Text as T import Data.Time.Calendar
import Data.Text.Lazy.Builder import Data.Time.Clock
import Text.Read hiding (String) import Text.Read hiding (String)
rescaleToDaily :: [Bar] -> [Bar] rescaleToDaily :: [Bar] -> [Bar]
rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar

18
test/Test/RoboCom/Indicators.hs
Unescape View File

@ -5,17 +5,17 @@ module Test.RoboCom.Indicators
unitTests unitTests
) where ) where
import Test.Tasty import Test.Tasty
import Test.Tasty.SmallCheck as SC import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit import Test.Tasty.SmallCheck as SC
import qualified Data.Text as T import ATrade.Types
import ATrade.Types import qualified Data.Text as T
import Data.Time.Clock import Data.Time.Calendar
import Data.Time.Calendar import Data.Time.Clock
import ATrade.RoboCom.Indicators import ATrade.RoboCom.Indicators
unitTests = testGroup "RoboCom.Indicators" [ unitTests = testGroup "RoboCom.Indicators" [
testEma, testEma,

18
test/Test/RoboCom/Utils.hs
Unescape View File

@ -5,17 +5,17 @@ module Test.RoboCom.Utils
unitTests unitTests
) where ) where
import Test.Tasty import Test.Tasty
import Test.Tasty.SmallCheck as SC import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit import Test.Tasty.SmallCheck as SC
import qualified Data.Text as T import ATrade.Types
import ATrade.Types import qualified Data.Text as T
import Data.Time.Clock import Data.Time.Calendar
import Data.Time.Calendar import Data.Time.Clock
import ATrade.RoboCom.Utils import ATrade.RoboCom.Utils
unitTests = testGroup "RoboCom.Indicators" [ unitTests = testGroup "RoboCom.Indicators" [
testRescaleToDaily, testRescaleToDaily,

Write Preview
Loading…
Cancel
Save