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
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 2
      src/ATrade/BarAggregator.hs
  2. 2
      src/ATrade/Driver/Backtest.hs
  3. 40
      src/ATrade/Driver/Real/BrokerClientThread.hs
  4. 29
      src/ATrade/Driver/Real/QuoteSourceThread.hs
  5. 34
      src/ATrade/Driver/Real/Types.hs
  6. 54
      src/ATrade/Forums/Smartlab.hs
  7. 60
      src/ATrade/Quotes/HAP.hs
  8. 46
      src/ATrade/Quotes/QHP.hs
  9. 22
      src/ATrade/Quotes/QTIS.hs
  10. 11
      src/ATrade/RoboCom/Indicators.hs
  11. 51
      src/ATrade/RoboCom/Monad.hs
  12. 94
      src/ATrade/RoboCom/Positions.hs
  13. 32
      src/ATrade/RoboCom/Types.hs
  14. 20
      src/ATrade/RoboCom/Utils.hs
  15. 18
      test/Test/RoboCom/Indicators.hs
  16. 20
      test/Test/RoboCom/Utils.hs

2
src/ATrade/BarAggregator.hs
Unescape View File

@ -112,7 +112,7 @@ handleTick tick = runState $ do @@ -112,7 +112,7 @@ handleTick tick = runState $ do
updateBarTimestamp !bar newtick = bar { barTimestamp = newTimestamp }
where
newTimestamp = timestamp newtick
emptyBarFrom !bar newtick = newBar
where
newTimestamp = timestamp newtick

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

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

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

@ -5,26 +5,28 @@ module ATrade.Driver.Real.BrokerClientThread ( @@ -5,26 +5,28 @@ module ATrade.Driver.Real.BrokerClientThread (
BrokerCommand(..)
) where
import ATrade.Broker.Client
import ATrade.Broker.Protocol
import ATrade.RoboCom.Monad hiding (submitOrder, cancelOrder)
import ATrade.RoboCom.Types
import ATrade.Types
import ATrade.Broker.Client
import ATrade.Broker.Protocol
import ATrade.RoboCom.Monad hiding (cancelOrder,
submitOrder)
import ATrade.RoboCom.Types
import ATrade.Types
import Control.Concurrent.BoundedChan
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield)
import Control.Exception
import Control.Monad.Loops
import Control.Monad
import Control.Concurrent hiding (readChan, writeChan,
writeList2Chan, yield)
import Control.Concurrent.BoundedChan
import Control.Exception
import Control.Monad
import Control.Monad.Loops
import Data.IORef
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Time.Clock
import Data.Maybe
import Data.IORef
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Time.Clock
import System.Log.Logger
import System.ZMQ4 hiding (Event)
import System.Log.Logger
import System.ZMQ4 hiding (Event)
data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications
@ -56,7 +58,7 @@ startBrokerClientThread instId ctx brEp ordersChan eventChan shutdownVar = forkI @@ -56,7 +58,7 @@ startBrokerClientThread instId ctx brEp ordersChan eventChan shutdownVar = forkI
debugM "Strategy" "Order cancelled"
BrokerRequestNotifications -> do
t <- getCurrentTime
nt <- readIORef lastNotificationTime
nt <- readIORef lastNotificationTime
when (t `diffUTCTime` nt > 1) $ do
maybeNs <- getNotifications bs
case maybeNs of
@ -78,4 +80,4 @@ sendNotification :: BoundedChan Event -> Notification -> IO () @@ -78,4 +80,4 @@ sendNotification :: BoundedChan Event -> Notification -> IO ()
sendNotification eventChan notification =
writeChan eventChan $ case notification of
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 @@ -5,23 +5,24 @@ module ATrade.Driver.Real.QuoteSourceThread
startQuoteSourceThread
) where
import ATrade.BarAggregator
import ATrade.QuoteSource.Client
import ATrade.RoboCom.Monad
import ATrade.RoboCom.Types
import ATrade.Types
import ATrade.Driver.Real.Types
import ATrade.BarAggregator
import ATrade.Driver.Real.Types
import ATrade.QuoteSource.Client
import ATrade.RoboCom.Monad
import ATrade.RoboCom.Types
import ATrade.Types
import Data.IORef
import qualified Data.Text as T
import Data.IORef
import qualified Data.Text as T
import Control.Concurrent.BoundedChan
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield)
import Control.Exception
import Control.Monad
import Control.Concurrent hiding (readChan, writeChan,
writeList2Chan, yield)
import Control.Concurrent.BoundedChan
import Control.Exception
import Control.Monad
import System.Log.Logger
import System.ZMQ4 hiding (Event)
import System.Log.Logger
import System.ZMQ4 hiding (Event)
startQuoteSourceThread :: Context -> T.Text -> Strategy c s -> BoundedChan Event -> IORef BarAggregator -> (Tick -> Bool) -> IO ThreadId
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 ( @@ -6,34 +6,34 @@ module ATrade.Driver.Real.Types (
InitializationCallback
) where
import ATrade.RoboCom.Monad
import ATrade.RoboCom.Types
import ATrade.RoboCom.Monad
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
data Strategy c s = BarStrategy {
downloadDelta :: DiffTime, -- ^ How much history to download at strategy start
eventCallback :: EventCallback c s, -- ^ Strategy event callback
currentState :: s, -- ^ Current strategy state. Updated after each 'EventCallback' call
strategyParams :: c, -- ^ Strategy params
strategyTimers :: [UTCTime],
downloadDelta :: DiffTime, -- ^ How much history to download at strategy start
eventCallback :: EventCallback c s, -- ^ Strategy event callback
currentState :: s, -- ^ Current strategy state. Updated after each 'EventCallback' call
strategyParams :: c, -- ^ Strategy params
strategyTimers :: [UTCTime],
strategyInstanceParams :: StrategyInstanceParams -- ^ Instance params
}
-- | Strategy instance params store few params which are common for all strategies
data StrategyInstanceParams = StrategyInstanceParams {
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
strategyVolume :: Int, -- ^ Volume to use for this instance (in lots/contracts)
tickers :: [Ticker], -- ^ List of tickers which is used by this strategy
strategyQuotesourceEp :: T.Text, -- ^ QuoteSource server endpoint
strategyBrokerEp :: T.Text, -- ^ Broker server endpoint
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
strategyVolume :: Int, -- ^ Volume to use for this instance (in lots/contracts)
tickers :: [Ticker], -- ^ List of tickers which is used by this strategy
strategyQuotesourceEp :: T.Text, -- ^ QuoteSource server endpoint
strategyBrokerEp :: T.Text, -- ^ Broker server endpoint
strategyHistoryProviderType :: T.Text,
strategyHistoryProvider :: T.Text,
strategyQTISEp :: Maybe T.Text
strategyHistoryProvider :: T.Text,
strategyQTISEp :: Maybe T.Text
}
type InitializationCallback c = c -> StrategyInstanceParams -> IO c

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

@ -8,32 +8,32 @@ module ATrade.Forums.Smartlab ( @@ -8,32 +8,32 @@ module ATrade.Forums.Smartlab (
) where
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import Data.Text.Encoding
import qualified Data.List as L
import Data.Time.Calendar
import Data.Time.Clock
import Data.Maybe
import Network.HTTP.Simple
import Safe
import Text.HTML.TagSoup
import Text.Parsec
import Text.Parsec.Text
import Text.StringLike
import Debug.Trace
import qualified Data.List as L
import Data.Maybe
import qualified Data.Text as T
import Data.Text.Encoding
import Data.Time.Calendar
import Data.Time.Clock
import Network.HTTP.Simple
import Safe
import Text.HTML.TagSoup
import Text.Parsec
import Text.Parsec.Text
import Text.StringLike
import Debug.Trace
data NewsItem = NewsItem {
niUrl :: !T.Text,
niHeader :: !T.Text,
niText :: !T.Text,
niAuthor :: !T.Text,
niUrl :: !T.Text,
niHeader :: !T.Text,
niText :: !T.Text,
niAuthor :: !T.Text,
niPubTime :: !UTCTime
} deriving (Show, Eq)
data IndexItem = IndexItem {
iiUrl :: !T.Text,
iiTitle :: !T.Text,
iiUrl :: !T.Text,
iiTitle :: !T.Text,
iiPubTime :: !UTCTime
} deriving (Show, Eq)
@ -49,14 +49,14 @@ extractBetween tagName = takeWhile (~/= closeTag) . dropWhile (~/= openTag) @@ -49,14 +49,14 @@ extractBetween tagName = takeWhile (~/= closeTag) . dropWhile (~/= openTag)
matchClass :: T.Text -> T.Text -> Tag T.Text -> Bool
matchClass _ className (TagOpen _ attrs) = case L.lookup (T.pack "class") attrs of
Just klass -> className `L.elem` T.words klass
Nothing -> False
Nothing -> False
matchClass _ _ _ = False
parseTimestamp :: T.Text -> Maybe UTCTime
parseTimestamp text = case parse timestampParser "" text of
Left _ -> Nothing
Right val -> Just val
Left _ -> Nothing
Right val -> Just val
where
timestampParser :: Parser UTCTime
timestampParser = do
@ -113,7 +113,7 @@ getItem indexItem = do @@ -113,7 +113,7 @@ getItem indexItem = do
dropWhile (not . matchClass (T.pack "li") (T.pack "date")) $ tags
tags = parseTags rawHtml
getIndex :: T.Text -> Int -> IO ([IndexItem], Bool)
getIndex rootUrl pageNumber = do
@ -121,7 +121,7 @@ getIndex rootUrl pageNumber = do @@ -121,7 +121,7 @@ getIndex rootUrl pageNumber = do
resp <- httpLBS rq
return $ if getResponseStatusCode resp == 200
then parseIndex . decodeUtf8 . BL.toStrict . getResponseBody $ resp
else ([], False)
else ([], False)
where
parseIndex :: T.Text -> ([IndexItem], Bool)
parseIndex x = (mapMaybe parseIndexEntry $ partitions (matchClass (T.pack "div") (T.pack "topic")) $ parseTags x, hasNextPage $ parseTags x)
@ -138,7 +138,7 @@ getIndex rootUrl pageNumber = do @@ -138,7 +138,7 @@ getIndex rootUrl pageNumber = do
iiTitle = text,
iiPubTime = ts }
_ -> Nothing
makeUrl root pagenumber
| pagenumber == 0 || pagenumber == 1 = root
@ -149,5 +149,5 @@ getIndex rootUrl pageNumber = do @@ -149,5 +149,5 @@ getIndex rootUrl pageNumber = do
else paginationLinksCount > 1
where
paginationLinksCount = length . filter (~== "<a>") . extractBetween "p" . dropWhile (~/= "<div id=pagination>") $ tags

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

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

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

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

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

@ -7,19 +7,19 @@ module ATrade.Quotes.QTIS @@ -7,19 +7,19 @@ module ATrade.Quotes.QTIS
qtisGetTickersInfo'
) where
import ATrade.Types
import Control.Monad
import Data.Aeson
import Data.Maybe
import ATrade.Types
import Control.Monad
import Data.Aeson
import qualified Data.ByteString.Char8 as BC8
import qualified Data.ByteString.Lazy as BL
import qualified Data.Text as T
import System.ZMQ4
import System.Log.Logger
import qualified Data.ByteString.Lazy as BL
import Data.Maybe
import qualified Data.Text as T
import System.Log.Logger
import System.ZMQ4
data TickerInfo = TickerInfo {
tiTicker :: T.Text,
tiLotSize :: Integer,
tiTicker :: T.Text,
tiLotSize :: Integer,
tiTickSize :: Price
} deriving (Show, Eq)
@ -57,4 +57,4 @@ qtisGetTickersInfo ctx endpoint tickers = @@ -57,4 +57,4 @@ qtisGetTickersInfo ctx endpoint tickers =
then decode $ BL.fromStrict payload
else Nothing
parseResponse _ = Nothing

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

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

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

@ -1,13 +1,12 @@ @@ -1,13 +1,12 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeSynonymInstances #-}
module ATrade.RoboCom.Monad (
RState,
@ -27,15 +26,15 @@ module ATrade.RoboCom.Monad ( @@ -27,15 +26,15 @@ module ATrade.RoboCom.Monad (
st
) 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 qualified Data.Text as T
import Text.Printf.TH
import Data.Aeson.Types
import qualified Data.Text as T
import Data.Time.Clock
import Text.Printf.TH
class (Monad m) => MonadRobot m c s | m -> c, m -> s where
@ -52,7 +51,7 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where @@ -52,7 +51,7 @@ class (Monad m) => MonadRobot m c s | m -> c, m -> s where
oldState <- getState
setState (f oldState)
getEnvironment :: m StrategyEnvironment
data RState
data RConfig
data RActions
@ -85,21 +84,21 @@ data StrategyAction = ActionOrder Order @@ -85,21 +84,21 @@ data StrategyAction = ActionOrder Order
| ActionIO Int (IO Value)
data StrategyEnvironment = StrategyEnvironment {
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
seVolume :: !Int, -- ^ Volume to use for this instance (in lots/contracts)
seBars :: !Bars, -- ^ List of tickers which is used by this strategy
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
seVolume :: !Int, -- ^ Volume to use for this instance (in lots/contracts)
seBars :: !Bars, -- ^ List of tickers which is used by this strategy
seLastTimestamp :: !UTCTime
} deriving (Eq)
instance Show StrategyAction where
show (ActionOrder order) = "ActionOrder " ++ show order
show (ActionOrder order) = "ActionOrder " ++ show order
show (ActionCancelOrder oid) = "ActionCancelOrder " ++ show oid
show (ActionLog t) = "ActionLog " ++ show t
show (ActionIO x _) = "ActionIO " ++ show x
show (ActionSetupTimer t) = "ActionSetupTimer e" ++ show t
show (ActionLog t) = "ActionLog " ++ show t
show (ActionIO x _) = "ActionIO " ++ show x
show (ActionSetupTimer t) = "ActionSetupTimer e" ++ show t
tellAction :: StrategyAction -> StrategyElement c s ()
tellAction :: StrategyAction -> StrategyElement c s ()
tellAction a = tell @RActions [a]
instance MonadRobot (StrategyMonad c s) c s where

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

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

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

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

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

@ -1,6 +1,6 @@ @@ -1,6 +1,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}
module ATrade.RoboCom.Utils (
barStartTime,
@ -13,14 +13,14 @@ module ATrade.RoboCom.Utils ( @@ -13,14 +13,14 @@ module ATrade.RoboCom.Utils (
parseTime
) where
import ATrade.Types
import ATrade.Types
import Data.Time.Clock
import Data.Time.Calendar
import qualified Data.Text as T
import Data.Text.Lazy.Builder
import qualified Data.Text as T
import Data.Text.Lazy.Builder
import Data.Time.Calendar
import Data.Time.Clock
import Text.Read hiding (String)
import Text.Read hiding (String)
rescaleToDaily :: [Bar] -> [Bar]
rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar
@ -37,10 +37,10 @@ rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar @@ -37,10 +37,10 @@ rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar
rescaleToDaily [] = []
barEndTime :: Bar -> Integer -> UTCTime
barEndTime bar tframe = addUTCTime (fromIntegral $ (1 + barNumber (barTimestamp bar) tframe) * tframe) epoch
barEndTime bar tframe = addUTCTime (fromIntegral $ (1 + barNumber (barTimestamp bar) tframe) * tframe) epoch
barStartTime :: Bar -> Integer -> UTCTime
barStartTime bar tframe = addUTCTime (fromIntegral $ barNumber (barTimestamp bar) tframe * tframe) epoch
barStartTime bar tframe = addUTCTime (fromIntegral $ barNumber (barTimestamp bar) tframe * tframe) epoch
barNumber :: UTCTime -> Integer -> Integer
barNumber ts barlen = floor (diffUTCTime ts epoch) `div` barlen

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

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

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

@ -5,17 +5,17 @@ module Test.RoboCom.Utils @@ -5,17 +5,17 @@ module Test.RoboCom.Utils
unitTests
) where
import Test.Tasty
import Test.Tasty.SmallCheck as SC
import Test.Tasty.QuickCheck as QC
import Test.Tasty.HUnit
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck as QC
import Test.Tasty.SmallCheck as SC
import qualified Data.Text as T
import ATrade.Types
import Data.Time.Clock
import Data.Time.Calendar
import ATrade.Types
import qualified Data.Text as T
import Data.Time.Calendar
import Data.Time.Clock
import ATrade.RoboCom.Utils
import ATrade.RoboCom.Utils
unitTests = testGroup "RoboCom.Indicators" [
testRescaleToDaily,
@ -75,7 +75,7 @@ testRescaleToDaily = testCase "Rescale to daily" $ assertEqual "Incorrect rescal @@ -75,7 +75,7 @@ testRescaleToDaily = testCase "Rescale to daily" $ assertEqual "Incorrect rescal
testRescaleToDaily2 = testCase "Rescale to daily 2" $ assertEqual "Incorrect rescale" dailyBars $ rescaleToDaily min30Bars
where
dailyBars = reverse [
dailyBars = reverse [
ibar 1 17 3.6065000 3.6740000 3.5670000 3.6740000 47398000,
ibar 2 17 3.6760000 3.6980000 3.6350000 3.6980000 32643000,
ibar 3 17 3.7000000 3.7090000 3.6545000 3.6800000 35727000,

Write Preview
Loading…
Cancel
Save