commit
813b15fc6b
27 changed files with 3523 additions and 0 deletions
@ -0,0 +1,30 @@
@@ -0,0 +1,30 @@
|
||||
Copyright Author name here (c) 2018 |
||||
|
||||
All rights reserved. |
||||
|
||||
Redistribution and use in source and binary forms, with or without |
||||
modification, are permitted provided that the following conditions are met: |
||||
|
||||
* Redistributions of source code must retain the above copyright |
||||
notice, this list of conditions and the following disclaimer. |
||||
|
||||
* Redistributions in binary form must reproduce the above |
||||
copyright notice, this list of conditions and the following |
||||
disclaimer in the documentation and/or other materials provided |
||||
with the distribution. |
||||
|
||||
* Neither the name of Author name here nor the names of other |
||||
contributors may be used to endorse or promote products derived |
||||
from this software without specific prior written permission. |
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
||||
@ -0,0 +1,2 @@
@@ -0,0 +1,2 @@
|
||||
import Distribution.Simple |
||||
main = defaultMain |
||||
@ -0,0 +1,97 @@
@@ -0,0 +1,97 @@
|
||||
name: robocom-zero |
||||
version: 0.1.0.0 |
||||
-- synopsis: |
||||
-- description: |
||||
homepage: https://github.com/asakul/robocom-zero#readme |
||||
license: BSD3 |
||||
license-file: LICENSE |
||||
author: Denis Tereshkin |
||||
maintainer: denis@kasan.ws |
||||
copyright: 2018 Denis Tereshkin |
||||
category: Web |
||||
build-type: Simple |
||||
extra-source-files: README.md |
||||
cabal-version: >=1.10 |
||||
|
||||
library |
||||
hs-source-dirs: src |
||||
ghc-options: -Wall -fno-warn-orphans -Wno-type-defaults |
||||
exposed-modules: ATrade.RoboCom.Indicators |
||||
, ATrade.RoboCom.Monad |
||||
, ATrade.RoboCom.Positions |
||||
, ATrade.RoboCom.Types |
||||
, ATrade.RoboCom.Utils |
||||
, ATrade.Quotes.Finam |
||||
, ATrade.Quotes.HAP |
||||
, ATrade.Quotes.QHP |
||||
, ATrade.Quotes.QTIS |
||||
, ATrade.Driver.Real |
||||
, ATrade.Driver.Backtest |
||||
build-depends: base >= 4.7 && < 5 |
||||
, libatrade |
||||
, text |
||||
, text-icu |
||||
, errors |
||||
, lens |
||||
, bytestring |
||||
, cassava |
||||
, containers |
||||
, time |
||||
, vector |
||||
, wreq |
||||
, safe |
||||
, hslogger |
||||
, parsec |
||||
, parsec-numbers |
||||
, aeson |
||||
, binary |
||||
, binary-ieee754 |
||||
, zeromq4-haskell |
||||
, unordered-containers |
||||
, ether |
||||
, th-printf |
||||
, BoundedChan |
||||
, monad-loops |
||||
, conduit |
||||
, safe-exceptions |
||||
, mtl |
||||
, transformers |
||||
, list-extras |
||||
, optparse-applicative |
||||
, split |
||||
, signal |
||||
, random |
||||
, hedis |
||||
|
||||
default-language: Haskell2010 |
||||
other-modules: ATrade.BarAggregator |
||||
, ATrade.Exceptions |
||||
, ATrade.Driver.Real.BrokerClientThread |
||||
, ATrade.Driver.Real.QuoteSourceThread |
||||
, ATrade.Driver.Real.Types |
||||
|
||||
test-suite robots-test |
||||
type: exitcode-stdio-1.0 |
||||
hs-source-dirs: test |
||||
main-is: Spec.hs |
||||
build-depends: base |
||||
, robocom-zero |
||||
, libatrade |
||||
, time |
||||
, text |
||||
, tasty |
||||
, tasty-hunit |
||||
, tasty-golden |
||||
, tasty-smallcheck |
||||
, tasty-quickcheck |
||||
, tasty-hspec |
||||
, quickcheck-text |
||||
, quickcheck-instances |
||||
ghc-options: -threaded -rtsopts -with-rtsopts=-N |
||||
default-language: Haskell2010 |
||||
other-modules: Test.RoboCom.Indicators |
||||
, Test.RoboCom.Utils |
||||
|
||||
source-repository head |
||||
type: git |
||||
location: https://github.com/asakul/robocom-zero |
||||
@ -0,0 +1,102 @@
@@ -0,0 +1,102 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Backtest.Execution ( |
||||
mkExecutionAgent, |
||||
ExecutionAgent(..), |
||||
executePending, |
||||
executeStep |
||||
) where |
||||
|
||||
import qualified Data.Text as T |
||||
import qualified Data.Map as M |
||||
import qualified Data.List as L |
||||
import ATrade.Types |
||||
import ATrade.Strategy.Types |
||||
import ATrade.Strategy |
||||
import Control.Monad.State |
||||
import Control.Monad.Trans.Writer |
||||
import Data.Decimal |
||||
import Data.Time.Clock |
||||
import Data.Time.Calendar |
||||
|
||||
data Position = Position { |
||||
ticker :: T.Text, |
||||
balance :: Int } |
||||
|
||||
data ExecutionAgent = ExecutionAgent { |
||||
pendingOrders :: [Order], |
||||
cash :: Decimal, |
||||
currentTime :: UTCTime, |
||||
orderIdCounter :: Integer |
||||
} |
||||
|
||||
mkExecutionAgent startCash = ExecutionAgent { pendingOrders = [], |
||||
cash = startCash, |
||||
currentTime = UTCTime (fromGregorian 1970 1 1) 0, |
||||
orderIdCounter = 1 } |
||||
|
||||
executeAtPrice :: Order -> Decimal -> WriterT [Event] (State ExecutionAgent) () |
||||
executeAtPrice order price = do |
||||
when (orderState order == Unsubmitted) $ tell [OrderSubmitted order] |
||||
tell [OrderUpdate (orderId order) Executed] |
||||
timestamp <- gets currentTime |
||||
tell [NewTrade (mkTradeForOrder timestamp order price)] |
||||
|
||||
case orderOperation order of |
||||
Buy -> modify' (\agent -> agent { cash = cash agent - price * realFracToDecimal 10 (toRational $ orderQuantity order) }) |
||||
Sell -> modify' (\agent -> agent { cash = cash agent + price * realFracToDecimal 10 (toRational $ orderQuantity order) }) |
||||
|
||||
mkTradeForOrder timestamp order price = Trade { tradeOrderId = orderId order, |
||||
tradePrice = price, |
||||
tradeQuantity = orderQuantity order, |
||||
tradeVolume = price * realFracToDecimal 10 (toRational $ orderQuantity order), |
||||
tradeVolumeCurrency = "TEST_CURRENCY", |
||||
tradeOperation = orderOperation order, |
||||
tradeAccount = orderAccountId order, |
||||
tradeSecurity = orderSecurity order, |
||||
tradeTimestamp = timestamp, |
||||
tradeSignalId = orderSignalId order } |
||||
|
||||
|
||||
executePending :: Bars -> WriterT [Event] (State ExecutionAgent) () |
||||
executePending bars = do |
||||
orders <- gets pendingOrders |
||||
let (executedOrders, leftover) = L.partition shouldExecute orders |
||||
|
||||
mapM_ executeAtOrdersPrice executedOrders |
||||
modify' (\s -> s { pendingOrders = leftover } ) |
||||
where |
||||
executeAtOrdersPrice order = case orderPrice order of |
||||
Limit price -> executeAtPrice order price |
||||
_ -> return () -- TODO handle stops |
||||
|
||||
shouldExecute order = case M.lookup (orderSecurity order) bars of |
||||
Just (DataSeries ((ts, bar) : _)) -> case orderPrice order of |
||||
Limit price -> crosses bar price |
||||
_ -> False |
||||
Nothing -> False |
||||
|
||||
crosses bar price = (barClose bar > price && barOpen bar < price) || (barClose bar < price && barOpen bar > price) |
||||
|
||||
executeStep :: Bars -> [Order] -> WriterT [Event] (State ExecutionAgent) () |
||||
executeStep bars orders = do |
||||
-- Assign consecutive IDs |
||||
orders' <- mapM (\o -> do |
||||
id <- gets orderIdCounter |
||||
modify(\s -> s { orderIdCounter = id + 1 }) |
||||
return o { orderId = id }) orders |
||||
|
||||
let (executableNow, pending) = L.partition isExecutableNow orders' |
||||
mapM_ (executeOrderAtLastPrice bars) executableNow |
||||
modify' (\s -> s { pendingOrders = pending ++ pendingOrders s }) |
||||
|
||||
where |
||||
isExecutableNow order = case M.lookup (orderSecurity order) bars of |
||||
Just (DataSeries (x:xs)) -> case orderPrice order of |
||||
Limit price -> (orderOperation order == Buy && price >= (barClose . snd) x) || (orderOperation order == Sell && price <= (barClose . snd) x) |
||||
Market -> True |
||||
_ -> False |
||||
|
||||
executeOrderAtLastPrice bars order = case M.lookup (orderSecurity order) bars of |
||||
Just (DataSeries ((ts, bar) : _)) -> executeAtPrice order (barClose bar) |
||||
_ -> return () |
||||
@ -0,0 +1,126 @@
@@ -0,0 +1,126 @@
|
||||
{-# LANGUAGE BangPatterns #-} |
||||
|
||||
{-| |
||||
- Module : ATrade.BarAggregator |
||||
- Description : Aggregates incoming tick stream to bars |
||||
- Copyright : (c) Denis Tereshkin 2016-2017 |
||||
- License : Proprietary |
||||
- Maintainer : denis@kasan.ws |
||||
- Stability : experimental |
||||
- Portability : POSIX |
||||
- |
||||
- This module defines a set of functions that help to convert stream of ticks into bars. |
||||
-} |
||||
|
||||
module ATrade.BarAggregator ( |
||||
lBars, |
||||
lLastTicks, |
||||
BarAggregator(..), |
||||
mkAggregatorFromBars, |
||||
handleTick, |
||||
hmsToDiffTime |
||||
) where |
||||
|
||||
import ATrade.RoboCom.Types |
||||
import ATrade.RoboCom.Utils |
||||
import ATrade.Types |
||||
import Control.Lens |
||||
import Control.Monad.State |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Time.Clock |
||||
|
||||
-- | Bar aggregator state |
||||
data BarAggregator = BarAggregator { |
||||
bars :: !(M.Map TickerId BarSeries), |
||||
lastTicks :: !(M.Map (TickerId, DataType) Tick), |
||||
tickTimeWindows :: [(DiffTime, DiffTime)] |
||||
} deriving (Show) |
||||
|
||||
-- | Creates `BarAggregator` from history |
||||
mkAggregatorFromBars :: M.Map TickerId BarSeries -> [(DiffTime, DiffTime)] -> BarAggregator |
||||
mkAggregatorFromBars myBars timeWindows = BarAggregator { |
||||
bars = myBars, |
||||
lastTicks = M.empty, |
||||
tickTimeWindows = timeWindows } |
||||
|
||||
lBars :: (M.Map TickerId BarSeries -> Identity (M.Map TickerId BarSeries)) -> BarAggregator -> Identity BarAggregator |
||||
lBars = lens bars (\s b -> s { bars = b }) |
||||
|
||||
lLastTicks :: (M.Map (TickerId, DataType) Tick -> Identity (M.Map (TickerId, DataType) Tick)) -> BarAggregator -> Identity BarAggregator |
||||
lLastTicks = lens lastTicks (\s b -> s { lastTicks = b }) |
||||
|
||||
hmsToDiffTime :: Int -> Int -> Int -> DiffTime |
||||
hmsToDiffTime h m s = secondsToDiffTime $ toInteger $ h * 3600 + m * 60 + s |
||||
|
||||
-- | main logic of bar aggregator |
||||
handleTick :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) |
||||
handleTick tick = runState $ do |
||||
lLastTicks %= M.insert (security tick, datatype tick) tick |
||||
tws <- gets tickTimeWindows |
||||
mybars <- gets bars |
||||
if (any (isInTimeInterval tick) tws) |
||||
then |
||||
case M.lookup (security tick) mybars of |
||||
Just series -> case bsBars series of |
||||
(b:bs) -> do |
||||
let currentBn = barNumber (barTimestamp b) (tfSeconds $ bsTimeframe series) |
||||
case datatype tick of |
||||
LastTradePrice -> |
||||
if volume tick > 0 |
||||
then |
||||
if currentBn == barNumber (timestamp tick) (tfSeconds $ bsTimeframe series) |
||||
then do |
||||
lBars %= M.insert (security tick) series { bsBars = updateBar b tick : bs } |
||||
return Nothing |
||||
else do |
||||
lBars %= M.insert (security tick) series { bsBars = barFromTick tick : b : bs } |
||||
return . Just $ b |
||||
else |
||||
return Nothing |
||||
_ -> |
||||
if currentBn == barNumber (timestamp tick) (tfSeconds $ bsTimeframe series) |
||||
then do |
||||
lBars %= M.insert (security tick) series { bsBars = updateBarTimestamp b tick : bs } |
||||
return Nothing |
||||
else |
||||
return Nothing |
||||
_ -> return Nothing |
||||
_ -> return Nothing |
||||
else |
||||
return Nothing |
||||
where |
||||
isInTimeInterval tick (a, b) = (utctDayTime . timestamp) tick >= a && (utctDayTime . timestamp) tick <= b |
||||
barFromTick !newtick = Bar { barSecurity = security newtick, |
||||
barTimestamp = timestamp newtick, |
||||
barOpen = value newtick, |
||||
barHigh = value newtick, |
||||
barLow = value newtick, |
||||
barClose = value newtick, |
||||
barVolume = abs . volume $ newtick } |
||||
updateBar !bar newtick = |
||||
let newHigh = max (barHigh bar) (value newtick) |
||||
newLow = min (barLow bar) (value newtick) in |
||||
if timestamp newtick >= barTimestamp bar |
||||
then bar { |
||||
barTimestamp = timestamp newtick, |
||||
barHigh = newHigh, |
||||
barLow = newLow, |
||||
barClose = value newtick, |
||||
barVolume = barVolume bar + (abs . volume $ newtick) } |
||||
else bar |
||||
|
||||
updateBarTimestamp !bar newtick = bar { barTimestamp = newTimestamp } |
||||
where |
||||
newTimestamp = timestamp newtick |
||||
|
||||
emptyBarFrom !bar newtick = newBar |
||||
where |
||||
newTimestamp = timestamp newtick |
||||
newBar = Bar { |
||||
barSecurity = barSecurity bar, |
||||
barTimestamp = newTimestamp, |
||||
barOpen = barClose bar, |
||||
barHigh = barClose bar, |
||||
barLow = barClose bar, |
||||
barClose = barClose bar, |
||||
barVolume = 0 } |
||||
@ -0,0 +1,313 @@
@@ -0,0 +1,313 @@
|
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-} |
||||
{-# LANGUAGE LambdaCase #-} |
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE ScopedTypeVariables #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module ATrade.Driver.Backtest ( |
||||
backtestMain |
||||
) where |
||||
|
||||
import ATrade.Driver.Real.Types (InitializationCallback, |
||||
Strategy (..), |
||||
StrategyInstanceParams (..)) |
||||
import ATrade.Exceptions |
||||
import ATrade.Quotes.Finam as QF |
||||
import ATrade.RoboCom.Monad (Event (..), EventCallback, |
||||
StrategyAction (..), |
||||
StrategyEnvironment (..), |
||||
runStrategyElement) |
||||
import ATrade.RoboCom.Positions |
||||
import ATrade.RoboCom.Types (BarSeries (..), Ticker (..), |
||||
Timeframe (..)) |
||||
import ATrade.Types |
||||
import Conduit (awaitForever, runConduit, yield, |
||||
(.|)) |
||||
import Control.Exception.Safe |
||||
import Control.Monad.ST (runST) |
||||
import Control.Monad.State |
||||
import Data.Aeson (FromJSON (..), Result (..), |
||||
Value (..), decode) |
||||
import Data.Aeson.Types (parseMaybe) |
||||
import Data.ByteString.Lazy (readFile, toStrict) |
||||
import Data.HashMap.Strict (lookup) |
||||
import Data.List (concat, filter, find, partition) |
||||
import Data.List.Split (splitOn) |
||||
import qualified Data.Map.Strict as M |
||||
import Data.Semigroup ((<>)) |
||||
import Data.STRef (newSTRef, readSTRef, writeSTRef) |
||||
import qualified Data.Text as T |
||||
import Data.Text.IO (putStrLn) |
||||
import Data.Time.Calendar (fromGregorian) |
||||
import Data.Time.Clock (DiffTime, UTCTime (..)) |
||||
import Data.Vector ((!), (!?), (//)) |
||||
import qualified Data.Vector as V |
||||
import Options.Applicative hiding (Success) |
||||
import Prelude hiding (lookup, putStrLn, readFile) |
||||
import Safe (headMay) |
||||
|
||||
data Feed = Feed TickerId FilePath |
||||
deriving (Show, Eq) |
||||
|
||||
data Params = Params { |
||||
strategyConfigFile :: FilePath, |
||||
qtisEndpoint :: Maybe String, |
||||
paramsFeeds :: [Feed] |
||||
} deriving (Show, Eq) |
||||
|
||||
paramsParser :: Parser Params |
||||
paramsParser = Params |
||||
<$> strOption ( |
||||
long "config" <> short 'c' |
||||
) |
||||
<*> optional ( strOption |
||||
( long "qtis" <> short 'q' <> metavar "ENDPOINT/ID" )) |
||||
<*> some (option feedArgParser ( |
||||
long "feed" <> short 'f' |
||||
)) |
||||
|
||||
feedArgParser :: ReadM Feed |
||||
feedArgParser = eitherReader (\s -> case splitOn ":" s of |
||||
[tid, fpath] -> Right $ Feed (T.pack tid) fpath |
||||
_ -> Left $ "Unable to parse feed id: " ++ s) |
||||
|
||||
backtestMain :: (FromJSON c, StateHasPositions s) => DiffTime -> s -> Maybe (InitializationCallback c) -> EventCallback c s -> IO () |
||||
backtestMain dataDownloadDelta defaultState initCallback callback = do |
||||
params <- execParser opts |
||||
(tickerList, config) <- loadStrategyConfig params |
||||
|
||||
let instanceParams = StrategyInstanceParams { |
||||
strategyInstanceId = "foo", |
||||
strategyAccount = "foo", |
||||
strategyVolume = 1, |
||||
tickers = tickerList, |
||||
strategyQuotesourceEp = "", |
||||
strategyBrokerEp = "", |
||||
strategyHistoryProviderType = "", |
||||
strategyHistoryProvider = "", |
||||
strategyQTISEp = T.pack <$> qtisEndpoint params} |
||||
|
||||
updatedConfig <- case initCallback of |
||||
Just cb -> cb config instanceParams |
||||
Nothing -> return config |
||||
|
||||
feeds <- loadFeeds (paramsFeeds params) |
||||
|
||||
runBacktestDriver feeds config tickerList |
||||
where |
||||
opts = info (helper <*> paramsParser) |
||||
( fullDesc <> header "ATrade strategy backtesting framework" ) |
||||
|
||||
runBacktestDriver feeds params tickerList = do |
||||
let s = runConduit $ barStreamFromFeeds feeds .| backtestLoop |
||||
let finalState = execState (unBacktestingMonad s) $ defaultBacktestState defaultState params tickerList |
||||
print $ cash finalState |
||||
print $ tradesLog finalState |
||||
forM_ (logs finalState) putStrLn |
||||
print $ (M.keys . seBars . strategyEnvironment) finalState |
||||
|
||||
loadStrategyConfig :: (FromJSON c) => Params -> IO ([Ticker], c) |
||||
loadStrategyConfig params = do |
||||
content <- readFile (strategyConfigFile params) |
||||
case loadStrategyConfig' content of |
||||
Just (tickersList, config) -> return (tickersList, config) |
||||
_ -> throw $ UnableToLoadConfig (T.pack . strategyConfigFile $ params) |
||||
|
||||
loadStrategyConfig' content = do |
||||
v <- decode content |
||||
case v of |
||||
Object o -> do |
||||
mbTickers <- "tickers" `lookup` o |
||||
mbParams <- "params" `lookup` o |
||||
tickers <- parseMaybe parseJSON mbTickers |
||||
params <- parseMaybe parseJSON mbParams |
||||
return (tickers, params) |
||||
_ -> Nothing |
||||
|
||||
resultToMaybe (Error _) = Nothing |
||||
resultToMaybe (Success a) = Just a |
||||
|
||||
barStreamFromFeeds feeds = case nextBar feeds of |
||||
Just (bar, feeds') -> yield bar >> barStreamFromFeeds feeds' |
||||
_ -> return () |
||||
|
||||
nextBar :: V.Vector [Bar] -> Maybe (Bar, V.Vector [Bar]) |
||||
nextBar feeds = case indexOfNextFeed feeds of |
||||
Just ix -> do |
||||
f <- feeds !? ix |
||||
h <- headMay f |
||||
return (h, feeds // [(ix, tail f)]) |
||||
_ -> Nothing |
||||
|
||||
indexOfNextFeed feeds = runST $ do |
||||
minTs <- newSTRef Nothing |
||||
minIx <- newSTRef Nothing |
||||
forM_ [0..(V.length feeds-1)] (\ix -> do |
||||
let feed = feeds ! ix |
||||
curIx <- readSTRef minIx |
||||
curTs <- readSTRef minTs |
||||
case feed of |
||||
x:_ -> case curTs of |
||||
Just ts -> when (barTimestamp x < ts) $ do |
||||
writeSTRef minIx $ Just ix |
||||
writeSTRef minTs $ Just (barTimestamp x) |
||||
_ -> do |
||||
writeSTRef minIx $ Just ix |
||||
writeSTRef minTs $ Just (barTimestamp x) |
||||
_ -> return ()) |
||||
readSTRef minIx |
||||
|
||||
backtestLoop = awaitForever (\bar -> do |
||||
env <- gets strategyEnvironment |
||||
let oldTimestamp = seLastTimestamp env |
||||
let newTimestamp = barTimestamp bar |
||||
let newenv = env { seBars = updateBars (seBars env) bar } |
||||
curState <- gets robotState |
||||
modify' (\s -> s { strategyEnvironment = newenv }) |
||||
handleEvents [NewBar bar]) |
||||
|
||||
handleEvents events = do |
||||
newActions <- mapM handleEvent events |
||||
newEvents <- executeActions (concat newActions) |
||||
unless (null newEvents) $ handleEvents newEvents |
||||
|
||||
executeActions actions = concat <$> mapM executeAction actions |
||||
|
||||
executeAction (ActionOrder order) = do |
||||
oid <- nextOrderId |
||||
let submittedOrder = order { orderState = Submitted, orderId = oid } |
||||
modify' (\s -> s { pendingOrders = submittedOrder : pendingOrders s }) |
||||
return [OrderSubmitted submittedOrder] |
||||
|
||||
executeAction (ActionCancelOrder oid) = do |
||||
mbOrder <- find (\o -> orderId o == oid && orderState o == Submitted) <$> gets pendingOrders |
||||
case mbOrder of |
||||
Just _ -> do |
||||
modify' (\s -> s { pendingOrders = filter (\o -> orderId o == oid) (pendingOrders s)}) |
||||
return [OrderUpdate oid Cancelled] |
||||
_ -> return [] |
||||
|
||||
executeAction (ActionLog t) = modify' (\s -> s { logs = t : logs s }) >> return [] |
||||
executeAction (ActionSetupTimer t) = modify' (\s -> s { pendingTimers = t : pendingTimers s }) >> return [] |
||||
executeAction (ActionIO _ _) = return [] |
||||
|
||||
executePendingOrders bar = do |
||||
ev1 <- executeMarketOrders bar |
||||
ev2 <- executeLimitOrders bar |
||||
return $ ev1 ++ ev2 |
||||
|
||||
executeLimitOrders bar = do |
||||
(limitOrders, otherOrders) <- partition |
||||
(\o -> case orderPrice o of |
||||
Limit _ -> True |
||||
_ -> False) <$> gets pendingOrders |
||||
let (executableOrders, otherOrders) = partition (isExecutable bar) limitOrders |
||||
modify' (\s -> s { pendingOrders = otherOrders } ) |
||||
forM executableOrders $ \order -> |
||||
order `executeAtPrice` priceForLimitOrder order bar |
||||
|
||||
isExecutable bar order = case orderPrice order of |
||||
Limit price -> if orderOperation order == Buy |
||||
then price <= barLow bar |
||||
else price >= barHigh bar |
||||
_ -> True |
||||
|
||||
priceForLimitOrder order bar = case orderPrice order of |
||||
Limit price -> if orderOperation order == Buy |
||||
then if price >= barOpen bar |
||||
then barOpen bar |
||||
else price |
||||
else if price <= barOpen bar |
||||
then barOpen bar |
||||
else price |
||||
_ -> error "Should've been limit order" |
||||
|
||||
executeMarketOrders bar = do |
||||
(marketOrders, otherOrders) <- partition (\o -> orderPrice o == Market) <$> gets pendingOrders |
||||
modify' (\s -> s { pendingOrders = otherOrders }) |
||||
forM marketOrders $ \order -> |
||||
order `executeAtPrice` barOpen bar |
||||
|
||||
executeAtPrice order price = do |
||||
ts <- seLastTimestamp <$> gets strategyEnvironment |
||||
modify' (\s -> s { tradesLog = mkTrade order price ts : tradesLog s }) |
||||
return $ OrderUpdate (orderId order) Executed |
||||
|
||||
mkTrade order price ts = Trade { |
||||
tradeOrderId = orderId order, |
||||
tradePrice = price, |
||||
tradeQuantity = orderQuantity order, |
||||
tradeVolume = (fromIntegral . orderQuantity $ order) * price, |
||||
tradeVolumeCurrency = "pt", |
||||
tradeOperation = orderOperation order, |
||||
tradeAccount = orderAccountId order, |
||||
tradeSecurity = orderSecurity order, |
||||
tradeTimestamp = ts, |
||||
tradeCommission = 0, |
||||
tradeSignalId = orderSignalId order |
||||
} |
||||
|
||||
handleEvent event@(NewBar bar) = do |
||||
events <- executePendingOrders bar |
||||
firedTimers <- fireTimers (barTimestamp bar) |
||||
actions <- concat <$> mapM handleEvent (events ++ map TimerFired firedTimers) |
||||
actions' <- handleEvent' event |
||||
return $ actions ++ actions' |
||||
|
||||
handleEvent event = handleEvent' event |
||||
|
||||
handleEvent' event = do |
||||
env <- gets strategyEnvironment |
||||
params <- gets robotParams |
||||
curState <- gets robotState |
||||
let (newState, actions, _) = runStrategyElement params curState env $ callback event |
||||
modify' (\s -> s { robotState = newState } ) |
||||
return actions |
||||
|
||||
updateBars barMap newbar = M.alter (\case |
||||
Nothing -> Just BarSeries { bsTickerId = barSecurity newbar, |
||||
bsTimeframe = Timeframe 60, |
||||
bsBars = [newbar] } |
||||
Just bs -> Just bs { bsBars = newbar : bsBars bs }) (barSecurity newbar) barMap |
||||
|
||||
fireTimers ts = do |
||||
(firedTimers, otherTimers) <- partition (< ts) <$> gets pendingTimers |
||||
modify' (\s -> s { pendingTimers = otherTimers }) |
||||
return firedTimers |
||||
|
||||
loadFeeds :: [Feed] -> IO (V.Vector [Bar]) |
||||
loadFeeds feeds = V.fromList <$> mapM loadFeed feeds |
||||
loadFeed (Feed tid path) = do |
||||
content <- readFile path |
||||
case QF.parseQuotes $ toStrict content of |
||||
Just quotes -> return $ fmap (rowToBar tid) quotes |
||||
_ -> throw $ UnableToLoadFeed (T.pack path) |
||||
|
||||
rowToBar tid r = Bar tid (rowTime r) (rowOpen r) (rowHigh r) (rowLow r) (rowClose r) (rowVolume r) |
||||
|
||||
nextOrderId = do |
||||
oid <- gets orderIdCounter |
||||
modify' (\s -> s { orderIdCounter = oid + 1 }) |
||||
return oid |
||||
|
||||
|
||||
data BacktestState s c = BacktestState { |
||||
cash :: Double, |
||||
robotState :: s, |
||||
robotParams :: c, |
||||
strategyEnvironment :: StrategyEnvironment, |
||||
pendingOrders :: [Order], |
||||
tradesLog :: [Trade], |
||||
orderIdCounter :: Integer, |
||||
pendingTimers :: [UTCTime], |
||||
logs :: [T.Text] |
||||
} |
||||
|
||||
defaultBacktestState s c tickerList = BacktestState 0 s c (StrategyEnvironment "" "" 1 tickers (UTCTime (fromGregorian 1970 1 1) 0)) [] [] 1 [] [] |
||||
where |
||||
tickers = M.fromList $ map (\x -> (code x, BarSeries (code x) (Timeframe (timeframeSeconds x)) [])) tickerList |
||||
|
||||
newtype BacktestingMonad s c a = BacktestingMonad { unBacktestingMonad :: State (BacktestState s c) a } |
||||
deriving (Functor, Applicative, Monad, MonadState (BacktestState s c)) |
||||
|
||||
@ -0,0 +1,455 @@
@@ -0,0 +1,455 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE MultiWayIf #-} |
||||
{-# LANGUAGE BangPatterns #-} |
||||
{-# LANGUAGE CPP #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module ATrade.Driver.Real ( |
||||
Strategy(..), |
||||
StrategyInstanceParams(..), |
||||
robotMain, |
||||
BigConfig(..), |
||||
mkBarStrategy, |
||||
barStrategyDriver |
||||
) where |
||||
|
||||
import Options.Applicative |
||||
import System.IO |
||||
import System.Signal |
||||
import System.Exit |
||||
import System.Random |
||||
import System.Log.Logger |
||||
import System.Log.Handler.Simple |
||||
import System.Log.Handler (setFormatter) |
||||
import System.Log.Formatter |
||||
import Control.Monad |
||||
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield) |
||||
import Control.Concurrent.BoundedChan as BC |
||||
import Control.Exception |
||||
import qualified Data.ByteString as BS |
||||
import qualified Data.ByteString.Lazy as BL |
||||
import qualified Data.List as L |
||||
import qualified Data.Map as M |
||||
import qualified Data.Text as T |
||||
import Data.Text.Encoding |
||||
import Data.Aeson |
||||
import Data.IORef |
||||
import Data.Time.Calendar |
||||
import Data.Time.Clock |
||||
import Data.Time.Clock.POSIX |
||||
import Data.Maybe |
||||
import Data.Monoid |
||||
import Database.Redis hiding (info, decode) |
||||
import ATrade.Types |
||||
import ATrade.RoboCom.Monad (StrategyMonad, StrategyAction(..), EventCallback, Event(..), runStrategyElement, StrategyEnvironment(..), Event(..)) |
||||
import ATrade.BarAggregator |
||||
import ATrade.Driver.Real.BrokerClientThread |
||||
import ATrade.Driver.Real.QuoteSourceThread |
||||
import ATrade.Driver.Real.Types (Strategy(..), StrategyInstanceParams(..), InitializationCallback) |
||||
import ATrade.RoboCom.Types (BarSeries(..), Ticker(..), Timeframe(..)) |
||||
import ATrade.Exceptions |
||||
import ATrade.Quotes.Finam as QF |
||||
import ATrade.Quotes.QHP as QQ |
||||
import ATrade.Quotes.HAP as QH |
||||
import System.ZMQ4 hiding (Event(..)) |
||||
|
||||
data Params = Params { |
||||
instanceId :: String, |
||||
strategyConfigFile :: FilePath, |
||||
strategyStateFile :: FilePath, |
||||
brokerEp :: String, |
||||
quotesourceEp :: String, |
||||
historyProviderType :: Maybe String, |
||||
historyProvider :: Maybe String, |
||||
redisSocket :: Maybe String, |
||||
qtisSocket :: Maybe String, |
||||
accountId :: String, |
||||
volumeFactor :: Int |
||||
} deriving (Show, Eq) |
||||
|
||||
paramsParser :: Parser Params |
||||
paramsParser = Params |
||||
<$> strOption |
||||
( long "instance-id" |
||||
<> metavar "ID" ) |
||||
<*> strOption |
||||
( long "config" |
||||
<> metavar "FILEPATH" ) |
||||
<*> strOption |
||||
( long "state" |
||||
<> metavar "FILEPATH" ) |
||||
<*> strOption |
||||
( long "broker" |
||||
<> metavar "BROKER_ENDPOINT" ) |
||||
<*> strOption |
||||
( long "quotesource" |
||||
<> metavar "QUOTESOURCE_ENDPOINT" ) |
||||
<*> optional ( strOption |
||||
( long "history-provider-type" |
||||
<> metavar "TYPE/ID" )) |
||||
<*> optional ( strOption |
||||
( long "history-provider" |
||||
<> metavar "ENDPOINT/ID" )) |
||||
<*> optional ( strOption |
||||
( long "redis-socket" |
||||
<> metavar "ADDRESS" )) |
||||
<*> optional ( strOption |
||||
( long "qtis" |
||||
<> metavar "ENDPOINT/ID" )) |
||||
<*> strOption |
||||
( long "account" |
||||
<> metavar "ACCOUNT" ) |
||||
<*> option auto |
||||
( long "volume" |
||||
<> metavar "VOLUME" ) |
||||
|
||||
|
||||
data BigConfig c = BigConfig { |
||||
confTickers :: [Ticker], |
||||
strategyConfig :: c |
||||
} |
||||
|
||||
instance (FromJSON c) => FromJSON (BigConfig c) where |
||||
parseJSON = withObject "object" (\obj -> BigConfig <$> |
||||
obj .: "tickers" <*> |
||||
obj .: "params") |
||||
|
||||
instance (ToJSON c) => ToJSON (BigConfig c) where |
||||
toJSON conf = object ["tickers" .= confTickers conf, |
||||
"params" .= strategyConfig conf ] |
||||
|
||||
storeState :: (ToJSON s) => Params -> IORef s -> IORef [UTCTime] -> IO () |
||||
storeState params stateRef timersRef = do |
||||
currentStrategyState <- readIORef stateRef |
||||
currentTimersState <- readIORef timersRef |
||||
case redisSocket params of |
||||
Nothing -> withFile (strategyStateFile params) WriteMode (\f -> BS.hPut f $ BL.toStrict $ encode currentStrategyState) |
||||
`catch` (\e -> warningM "main" ("Unable to save state: " ++ show (e :: IOException))) |
||||
Just sock -> do |
||||
#ifdef linux_HOST_OS |
||||
conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } |
||||
now <- getPOSIXTime |
||||
res <- runRedis conn $ mset [(encodeUtf8 $ T.pack $ instanceId params, BL.toStrict $ encode currentStrategyState), |
||||
(encodeUtf8 $ T.pack $ instanceId params ++ ":last_store", encodeUtf8 $ T.pack $ show now), |
||||
(encodeUtf8 $ T.pack $ instanceId params ++ ":timers", encodeUtf8 $ T.pack $ show now) ] |
||||
|
||||
case res of |
||||
Left _ -> warningM "main" "Unable to save state" |
||||
Right _ -> return () |
||||
#else |
||||
return () |
||||
#endif |
||||
|
||||
|
||||
gracefulShutdown :: (ToJSON s) => Params -> IORef s -> IORef [UTCTime] -> MVar () -> Signal -> IO () |
||||
gracefulShutdown params stateRef timersRef shutdownMv _ = do |
||||
infoM "main" "Shutdown, saving state" |
||||
storeState params stateRef timersRef |
||||
putMVar shutdownMv () |
||||
exitSuccess |
||||
|
||||
robotMain :: (ToJSON s, FromJSON s, FromJSON c) => DiffTime -> s -> Maybe (InitializationCallback c) -> EventCallback c s -> IO () |
||||
robotMain dataDownloadDelta defaultState initCallback callback = do |
||||
params <- execParser opts |
||||
initLogging params |
||||
infoM "main" "Starting" |
||||
|
||||
(tickerList, config) <- loadStrategyConfig params |
||||
stratState <- loadStrategyState params |
||||
|
||||
let instanceParams = StrategyInstanceParams { |
||||
strategyInstanceId = T.pack . instanceId $ params, |
||||
strategyAccount = T.pack . accountId $ params, |
||||
strategyVolume = volumeFactor params, |
||||
tickers = tickerList, |
||||
strategyQuotesourceEp = T.pack . quotesourceEp $ params, |
||||
strategyBrokerEp = T.pack . brokerEp $ params, |
||||
strategyHistoryProviderType = T.pack $ fromMaybe "finam" $ historyProviderType params, |
||||
strategyHistoryProvider = T.pack $ fromMaybe "" $ historyProvider params, |
||||
strategyQTISEp = T.pack <$> qtisSocket params} |
||||
|
||||
updatedConfig <- case initCallback of |
||||
Just cb -> cb config instanceParams |
||||
Nothing -> return config |
||||
|
||||
let strategy = mkBarStrategy instanceParams dataDownloadDelta updatedConfig stratState callback |
||||
stateRef <- newIORef stratState |
||||
timersRef <- newIORef [] |
||||
shutdownMv <- newEmptyMVar |
||||
installHandler sigINT (gracefulShutdown params stateRef timersRef shutdownMv) |
||||
installHandler sigTERM (gracefulShutdown params stateRef timersRef shutdownMv) |
||||
randsec <- getStdRandom(randomR(1, 10)) |
||||
threadDelay $ randsec * 1000000 |
||||
debugM "main" "Forking state saving thread" |
||||
stateSavingThread <- forkIO $ forever $ do |
||||
threadDelay 1000000 |
||||
storeState params stateRef timersRef |
||||
|
||||
debugM "main" "Starting strategy driver" |
||||
barStrategyDriver tickFilter strategy stateRef timersRef shutdownMv `finally` killThread stateSavingThread |
||||
where |
||||
tickFilter :: Tick -> Bool |
||||
tickFilter tick = |
||||
let classCode = T.takeWhile (/= '#') (security tick) in |
||||
if |
||||
| classCode == "SPBFUT" || classCode == "SPBOPT" -> any (inInterval . utctDayTime . timestamp $ tick) fortsIntervals |
||||
| otherwise -> any (inInterval . utctDayTime . timestamp $ tick) secIntervals |
||||
|
||||
fortsIntervals = [(fromHMS 7 0 0, fromHMS 11 0 0), (fromHMS 11 5 0, fromHMS 15 45 0), (fromHMS 16 0 0, fromHMS 20 50 0)] |
||||
secIntervals = [(fromHMS 6 50 0, fromHMS 15 51 0)] |
||||
|
||||
fromHMS h m s = h * 3600 + m * 60 + s |
||||
inInterval ts (start, end) = ts >= start && ts <= end |
||||
|
||||
opts = info (helper <*> paramsParser) |
||||
( fullDesc <> header "ATrade strategy execution framework" ) |
||||
|
||||
initLogging params = do |
||||
handler <- streamHandler stderr DEBUG >>= |
||||
(\x -> return $ |
||||
setFormatter x (simpleLogFormatter $ |
||||
"$utcTime\t[" ++ instanceId params ++ "]\t\t{$loggername}\t\t<$prio> -> $msg")) |
||||
|
||||
hSetBuffering stderr LineBuffering |
||||
updateGlobalLogger rootLoggerName (setLevel DEBUG) |
||||
updateGlobalLogger rootLoggerName (setHandlers [handler]) |
||||
|
||||
loadStrategyConfig params = withFile (strategyConfigFile params) ReadMode (\f -> do |
||||
bigconfig <- eitherDecode . BL.fromStrict <$> BS.hGetContents f |
||||
case bigconfig of |
||||
Right conf -> return (confTickers conf, strategyConfig conf) |
||||
Left errmsg -> throw $ UnableToLoadConfig $ (T.pack . show) errmsg) |
||||
|
||||
loadStrategyState params = case redisSocket params of |
||||
Nothing -> loadStateFromFile (strategyStateFile params) |
||||
Just sock -> do |
||||
#ifdef linux_HOST_OS |
||||
conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } |
||||
res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params) |
||||
case res of |
||||
Left _ -> do |
||||
warningM "main" "Unable to load state" |
||||
return defaultState |
||||
Right mv -> case mv of |
||||
Just v -> case eitherDecode $ BL.fromStrict v of |
||||
Left _ -> do |
||||
warningM "main" "Unable to load state" |
||||
return defaultState |
||||
Right s -> return s |
||||
Nothing -> do |
||||
warningM "main" "Unable to load state" |
||||
return defaultState |
||||
#else |
||||
error "Not implemented" |
||||
#endif |
||||
|
||||
loadStateFromFile filepath = withFile filepath ReadMode (\f -> do |
||||
maybeState <- decode . BL.fromStrict <$> BS.hGetContents f |
||||
case maybeState of |
||||
Just st -> return st |
||||
Nothing -> return defaultState ) `catch` |
||||
(\e -> warningM "main" ("Unable to load state: " ++ show (e :: IOException)) >> return defaultState) |
||||
|
||||
-- | Helper function to make 'Strategy' instances |
||||
mkBarStrategy :: StrategyInstanceParams -> DiffTime -> c -> s -> EventCallback c s -> Strategy c s |
||||
mkBarStrategy instanceParams dd params initialState cb = BarStrategy { |
||||
downloadDelta = dd, |
||||
eventCallback = cb, |
||||
currentState = initialState, |
||||
strategyParams = params, |
||||
strategyTimers = [], |
||||
|
||||
strategyInstanceParams = instanceParams } |
||||
|
||||
-- | Main function which handles incoming events (ticks/orders), passes them to strategy callback |
||||
-- and executes returned strategy actions |
||||
barStrategyDriver :: (Tick -> Bool) -> Strategy c s -> IORef s -> IORef [UTCTime] -> MVar () -> IO () |
||||
barStrategyDriver tickFilter strategy stateRef timersRef shutdownVar = do |
||||
-- Make channels |
||||
-- Event channel is for strategy events, like new tick arrival, or order execution notification |
||||
eventChan <- BC.newBoundedChan 1000 |
||||
-- Orders channel passes strategy orders to broker thread |
||||
ordersChan <- BC.newBoundedChan 1000 |
||||
|
||||
withContext (\ctx -> do |
||||
-- Load tickers data and create BarAggregator from them |
||||
historyBars <- |
||||
if |
||||
| (strategyHistoryProviderType . strategyInstanceParams) strategy == "finam" -> |
||||
M.fromList <$> mapM loadTickerFromFinam (tickers . strategyInstanceParams $ strategy) |
||||
| (strategyHistoryProviderType . strategyInstanceParams) strategy == "hap" -> |
||||
M.fromList <$> mapM (loadTickerFromHAP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy)) (tickers . strategyInstanceParams $ strategy) |
||||
| otherwise -> |
||||
M.fromList <$> mapM (loadTickerFromQHP ctx ((strategyHistoryProvider . strategyInstanceParams) strategy)) (tickers . strategyInstanceParams $ strategy) |
||||
agg <- newIORef $ mkAggregatorFromBars historyBars [(hmsToDiffTime 6 50 0, hmsToDiffTime 21 0 0)] |
||||
bracket (startQuoteSourceThread ctx qsEp strategy eventChan agg tickFilter) killThread (\_ -> do |
||||
debugM "Strategy" "QuoteSource thread forked" |
||||
bracket (startBrokerClientThread (strategyInstanceId . strategyInstanceParams $ strategy) ctx brEp ordersChan eventChan shutdownVar) killThread (\_ -> do |
||||
debugM "Strategy" "Broker thread forked" |
||||
|
||||
wakeupTid <- forkIO $ forever $ do |
||||
maybeShutdown <- tryTakeMVar shutdownVar |
||||
if isJust maybeShutdown |
||||
then writeChan eventChan Shutdown |
||||
else do |
||||
threadDelay 1000000 |
||||
writeChan ordersChan BrokerRequestNotifications |
||||
debugM "Strategy" "Wakeup thread forked" |
||||
|
||||
let env = StrategyEnvironment { |
||||
seInstanceId = strategyInstanceId . strategyInstanceParams $ strategy, |
||||
seAccount = strategyAccount . strategyInstanceParams $ strategy, |
||||
seVolume = strategyVolume . strategyInstanceParams $ strategy, |
||||
seBars = M.empty, |
||||
seLastTimestamp = UTCTime (fromGregorian 1970 1 1) 0 |
||||
} |
||||
readAndHandleEvents agg ordersChan eventChan strategy env |
||||
debugM "Strategy" "Stopping strategy driver" |
||||
killThread wakeupTid))) |
||||
|
||||
debugM "Strategy" "Strategy done" |
||||
|
||||
where |
||||
qsEp = strategyQuotesourceEp . strategyInstanceParams $ strategy |
||||
brEp = strategyBrokerEp . strategyInstanceParams $ strategy |
||||
readAndHandleEvents agg ordersChan eventChan strategy' env = do |
||||
event <- readChan eventChan |
||||
if event /= Shutdown |
||||
then do |
||||
currentBars <- bars <$> readIORef agg |
||||
let params = strategyParams strategy' |
||||
let curState = currentState strategy' |
||||
let instId = strategyInstanceId . strategyInstanceParams $ strategy' |
||||
let acc = strategyAccount . strategyInstanceParams $ strategy' |
||||
let vol = strategyVolume . strategyInstanceParams $ strategy' |
||||
|
||||
let oldTimestamp = seLastTimestamp env |
||||
let newTimestamp = case event of |
||||
NewTick tick -> timestamp tick |
||||
_ -> seLastTimestamp env |
||||
|
||||
newTimers <- catMaybes <$> (mapM (checkTimer eventChan newTimestamp) $ strategyTimers strategy') |
||||
|
||||
let !newenv = env { seBars = currentBars, seLastTimestamp = newTimestamp } |
||||
let (!newState, !actions, _) = runStrategyElement params curState newenv $ (eventCallback strategy) event |
||||
writeIORef stateRef newState |
||||
writeIORef timersRef newTimers |
||||
|
||||
newTimers' <- catMaybes <$> mapM handleTimerActions actions |
||||
mapM_ (handleActions ordersChan) actions |
||||
readAndHandleEvents agg ordersChan eventChan (strategy' { currentState = newState, strategyTimers = newTimers ++ newTimers' }) newenv |
||||
else debugM "Strategy" "Shutdown requested" |
||||
where |
||||
handleTimerActions action = |
||||
case action of |
||||
ActionSetupTimer timerTime -> return $ Just timerTime |
||||
_ -> return Nothing |
||||
|
||||
handleActions ordersChan' action = |
||||
case action of |
||||
(ActionLog logText) -> debugM "Strategy" $ T.unpack logText |
||||
(ActionOrder order) -> writeChan ordersChan' $ BrokerSubmitOrder order |
||||
(ActionCancelOrder oid) -> writeChan ordersChan' $ BrokerCancelOrder oid |
||||
(ActionSetupTimer _) -> return () |
||||
(ActionIO tag io) -> void $ forkIO $ do |
||||
v <- io |
||||
writeChan eventChan (ActionCompleted tag v) |
||||
|
||||
checkTimer eventChan' newTimestamp timerTime = |
||||
if newTimestamp >= timerTime |
||||
then do |
||||
writeChan eventChan' $ TimerFired timerTime |
||||
return Nothing |
||||
else |
||||
return $ Just timerTime |
||||
|
||||
loadTickerFromHAP :: Context -> T.Text -> Ticker -> IO (TickerId, BarSeries) |
||||
loadTickerFromHAP ctx ep t = do |
||||
debugM "Strategy" $ "Loading ticker from HAP: " ++ show (code t) |
||||
case parseHAPPeriod $ timeframeSeconds t of |
||||
Just tf -> do |
||||
now <- getCurrentTime |
||||
historyBars <- QH.getQuotes ctx QH.RequestParams { |
||||
QH.endpoint = ep, |
||||
QH.ticker = code t, |
||||
QH.startDate = addUTCTime (negate . (1 +) . fromRational . toRational $ downloadDelta strategy) now, |
||||
QH.endDate = now, |
||||
QH.period = tf } |
||||
debugM "Strategy" $ "Obtained " ++ show (length historyBars) ++ " bars" |
||||
return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = historyBars }) |
||||
_ -> return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = [] }) |
||||
|
||||
|
||||
loadTickerFromQHP :: Context -> T.Text -> Ticker -> IO (TickerId, BarSeries) |
||||
loadTickerFromQHP ctx ep t = do |
||||
debugM "Strategy" $ "Loading ticker from QHP: " ++ show (code t) |
||||
case parseQHPPeriod $ timeframeSeconds t of |
||||
Just tf -> do |
||||
now <- getCurrentTime |
||||
historyBars <- QQ.getQuotes ctx QQ.RequestParams { |
||||
QQ.endpoint = ep, |
||||
QQ.ticker = code t, |
||||
QQ.startDate = addDays (negate . (1 +) . ceiling $ downloadDelta strategy / 86400) (utctDay now), |
||||
QQ.endDate = utctDay now, |
||||
QQ.period = tf } |
||||
debugM "Strategy" $ "Obtained " ++ show (length historyBars) ++ " bars" |
||||
return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = historyBars }) |
||||
_ -> return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = [] }) |
||||
|
||||
|
||||
loadTickerFromFinam :: Ticker -> IO (TickerId, BarSeries) |
||||
loadTickerFromFinam t = do |
||||
randDelay <- getStdRandom (randomR (1, 5)) |
||||
threadDelay $ randDelay * 1000000 |
||||
now <- getCurrentTime |
||||
debugM "Strategy" $ show (L.lookup "finam" (aliases t), parseFinamPeriod $ timeframeSeconds t) |
||||
case (L.lookup "finam" (aliases t), parseFinamPeriod $ timeframeSeconds t) of |
||||
(Just finamCode, Just per) -> do |
||||
debugM "Strategy" $ "Downloading ticker: " ++ finamCode |
||||
history <- downloadAndParseQuotes $ defaultParams { QF.ticker = T.pack finamCode, |
||||
QF.startDate = addDays (negate . (1 +) . ceiling $ downloadDelta strategy / 86400) (utctDay now), |
||||
QF.endDate = utctDay now, |
||||
QF.period = per } |
||||
case history of |
||||
Just h -> return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = convertFromFinamHistory (code t) h }) |
||||
Nothing -> return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = [] }) |
||||
_ -> return (code t, BarSeries { bsTickerId = code t, bsTimeframe = Timeframe (timeframeSeconds t), bsBars = [] }) |
||||
|
||||
convertFromFinamHistory :: TickerId -> [Row] -> [Bar] |
||||
convertFromFinamHistory tid = L.reverse . fmap (\row -> Bar { barSecurity = tid, |
||||
barTimestamp = rowTime row, |
||||
barOpen = rowOpen row, |
||||
barHigh = rowHigh row, |
||||
barLow = rowLow row, |
||||
barClose = rowClose row, |
||||
barVolume = rowVolume row }) |
||||
|
||||
parseFinamPeriod x |
||||
| x == 0 = Just QF.PeriodTick |
||||
| x == 60 = Just QF.Period1Min |
||||
| x == 5 * 60 = Just QF.Period5Min |
||||
| x == 10 * 60 = Just QF.Period10Min |
||||
| x == 15 * 60 = Just QF.Period15Min |
||||
| x == 30 * 60 = Just QF.Period30Min |
||||
| x == 60 * 60 = Just QF.PeriodHour |
||||
| x == 24 * 60 * 60 = Just QF.PeriodDay |
||||
| otherwise = Nothing |
||||
|
||||
parseQHPPeriod x |
||||
| x == 60 = Just QQ.Period1Min |
||||
| x == 5 * 60 = Just QQ.Period5Min |
||||
| x == 15 * 60 = Just QQ.Period15Min |
||||
| x == 30 * 60 = Just QQ.Period30Min |
||||
| x == 60 * 60 = Just QQ.PeriodHour |
||||
| x == 24 * 60 * 60 = Just QQ.PeriodDay |
||||
| otherwise = Nothing |
||||
|
||||
parseHAPPeriod x |
||||
| x == 60 = Just QH.Period1Min |
||||
| x == 5 * 60 = Just QH.Period5Min |
||||
| x == 15 * 60 = Just QH.Period15Min |
||||
| x == 30 * 60 = Just QH.Period30Min |
||||
| x == 60 * 60 = Just QH.PeriodHour |
||||
| x == 24 * 60 * 60 = Just QH.PeriodDay |
||||
| otherwise = Nothing |
||||
|
||||
@ -0,0 +1,81 @@
@@ -0,0 +1,81 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Driver.Real.BrokerClientThread ( |
||||
startBrokerClientThread, |
||||
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 Control.Concurrent.BoundedChan |
||||
import Control.Concurrent hiding (writeChan, readChan, writeList2Chan, yield) |
||||
import Control.Exception |
||||
import Control.Monad.Loops |
||||
import Control.Monad |
||||
|
||||
import Data.IORef |
||||
import qualified Data.Text as T |
||||
import Data.Text.Encoding |
||||
import Data.Time.Clock |
||||
import Data.Maybe |
||||
|
||||
import System.Log.Logger |
||||
import System.ZMQ4 hiding (Event) |
||||
|
||||
data BrokerCommand = BrokerSubmitOrder Order | BrokerCancelOrder Integer | BrokerRequestNotifications |
||||
|
||||
|
||||
startBrokerClientThread :: T.Text -> Context -> T.Text -> BoundedChan BrokerCommand -> BoundedChan Event -> MVar a -> IO ThreadId |
||||
startBrokerClientThread instId ctx brEp ordersChan eventChan shutdownVar = forkIO $ whileM_ (isNothing <$> tryReadMVar shutdownVar) $ |
||||
bracket (startBrokerClient (encodeUtf8 instId) ctx brEp defaultClientSecurityParams) |
||||
(\bro -> do |
||||
stopBrokerClient bro |
||||
debugM "Strategy" "Broker client: stop") |
||||
(\bs -> handle (\e -> do |
||||
warningM "Strategy" $ "Broker client: exception: " ++ show (e :: SomeException) |
||||
throwIO e) $ do |
||||
now <- getCurrentTime |
||||
lastNotificationTime <- newIORef now |
||||
whileM_ (andM [notTimeout lastNotificationTime, isNothing <$> tryReadMVar shutdownVar]) $ do |
||||
brokerCommand <- readChan ordersChan |
||||
case brokerCommand of |
||||
BrokerSubmitOrder order -> do |
||||
debugM "Strategy" $ "Submitting order: " ++ show order |
||||
maybeOid <- submitOrder bs order |
||||
debugM "Strategy" "Order submitted" |
||||
case maybeOid of |
||||
Right oid -> writeChan eventChan (OrderSubmitted order { orderId = oid }) |
||||
Left errmsg -> debugM "Strategy" $ T.unpack $ "Error: " `T.append` errmsg |
||||
BrokerCancelOrder oid -> do |
||||
debugM "Strategy" $ "Cancelling order: " ++ show oid |
||||
_ <- cancelOrder bs oid |
||||
debugM "Strategy" "Order cancelled" |
||||
BrokerRequestNotifications -> do |
||||
t <- getCurrentTime |
||||
nt <- readIORef lastNotificationTime |
||||
when (t `diffUTCTime` nt > 1) $ do |
||||
maybeNs <- getNotifications bs |
||||
case maybeNs of |
||||
Left errmsg -> debugM "Strategy" $ T.unpack $ "Error: " `T.append` errmsg |
||||
Right ns -> do |
||||
mapM_ (sendNotification eventChan) ns |
||||
getCurrentTime >>= (writeIORef lastNotificationTime) |
||||
nTimeout <- notTimeout lastNotificationTime |
||||
shouldShutdown <- isNothing <$> tryReadMVar shutdownVar |
||||
debugM "Strategy" $ "Broker loop end: " ++ show nTimeout ++ "/" ++ show shouldShutdown) |
||||
|
||||
notTimeout :: IORef UTCTime -> IO Bool |
||||
notTimeout ts = do |
||||
now <- getCurrentTime |
||||
heartbeatTs <- readIORef ts |
||||
return $ diffUTCTime now heartbeatTs < 30 |
||||
|
||||
sendNotification :: BoundedChan Event -> Notification -> IO () |
||||
sendNotification eventChan notification = |
||||
writeChan eventChan $ case notification of |
||||
OrderNotification oid state -> OrderUpdate oid state |
||||
TradeNotification trade -> NewTrade trade |
||||
@ -0,0 +1,44 @@
@@ -0,0 +1,44 @@
|
||||
{-# LANGUAGE BangPatterns #-} |
||||
|
||||
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 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 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 |
||||
tickChan <- newBoundedChan 1000 |
||||
bracket (startQuoteSourceClient tickChan (fmap code . (tickers . strategyInstanceParams) $ strategy) ctx qsEp) |
||||
(\qs -> do |
||||
stopQuoteSourceClient qs |
||||
debugM "Strategy" "Quotesource client: stop") |
||||
(\_ -> forever $ do |
||||
tick <- readChan tickChan |
||||
when (goodTick tick) $ do |
||||
writeChan eventChan (NewTick tick) |
||||
aggValue <- readIORef agg |
||||
case handleTick tick aggValue of |
||||
(Just bar, !newAggValue) -> writeChan eventChan (NewBar bar) >> writeIORef agg newAggValue |
||||
(Nothing, !newAggValue) -> writeIORef agg newAggValue) |
||||
where |
||||
goodTick tick = tickFilter tick && |
||||
(datatype tick /= LastTradePrice || (datatype tick == LastTradePrice && volume tick > 0)) |
||||
|
||||
@ -0,0 +1,39 @@
@@ -0,0 +1,39 @@
|
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module ATrade.Driver.Real.Types ( |
||||
Strategy(..), |
||||
StrategyInstanceParams(..), |
||||
InitializationCallback |
||||
) where |
||||
|
||||
import ATrade.RoboCom.Monad |
||||
import ATrade.RoboCom.Types |
||||
|
||||
import Data.Time.Clock |
||||
import qualified Data.Text as T |
||||
|
||||
-- | 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], |
||||
|
||||
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 |
||||
strategyHistoryProviderType :: T.Text, |
||||
strategyHistoryProvider :: T.Text, |
||||
strategyQTISEp :: Maybe T.Text |
||||
} |
||||
|
||||
type InitializationCallback c = c -> StrategyInstanceParams -> IO c |
||||
@ -0,0 +1,15 @@
@@ -0,0 +1,15 @@
|
||||
{-# LANGUAGE DeriveGeneric #-} |
||||
|
||||
module ATrade.Exceptions ( |
||||
RoboComException(..) |
||||
) where |
||||
|
||||
import Control.Exception |
||||
import qualified Data.Text as T |
||||
import GHC.Generics |
||||
|
||||
data RoboComException = UnableToLoadConfig T.Text | UnableToLoadFeed T.Text |
||||
deriving (Show, Generic) |
||||
|
||||
instance Exception RoboComException |
||||
|
||||
@ -0,0 +1,153 @@
@@ -0,0 +1,153 @@
|
||||
{-# OPTIONS_GHC -Wno-type-defaults #-} |
||||
|
||||
module ATrade.Forums.Smartlab ( |
||||
NewsItem(..), |
||||
IndexItem(..), |
||||
getIndex, |
||||
getItem |
||||
) 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 |
||||
|
||||
data NewsItem = NewsItem { |
||||
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, |
||||
iiPubTime :: !UTCTime |
||||
} deriving (Show, Eq) |
||||
|
||||
monthNames :: [T.Text] |
||||
monthNames = fmap T.pack ["января", "февраля", "марта", "апреля", "мая", "июня", "июля", "августа", "сентября", "октября", "ноября", "декабря"] |
||||
|
||||
extractBetween :: StringLike str => String -> [Tag str] -> [Tag str] |
||||
extractBetween tagName = takeWhile (~/= closeTag) . dropWhile (~/= openTag) |
||||
where |
||||
openTag = "<" ++ tagName ++ ">" |
||||
closeTag = "</" ++ tagName ++ ">" |
||||
|
||||
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 |
||||
|
||||
matchClass _ _ _ = False |
||||
|
||||
parseTimestamp :: T.Text -> Maybe UTCTime |
||||
parseTimestamp text = case parse timestampParser "" text of |
||||
Left _ -> Nothing |
||||
Right val -> Just val |
||||
where |
||||
timestampParser :: Parser UTCTime |
||||
timestampParser = do |
||||
spaces |
||||
day <- read <$> many1 digit |
||||
spaces |
||||
monthName <- T.pack <$> many1 letter |
||||
case L.elemIndex monthName monthNames of |
||||
Nothing -> fail "Can't parse month" |
||||
Just month -> do |
||||
spaces |
||||
year <- fromIntegral . read <$> many1 digit |
||||
_ <- char ',' |
||||
spaces |
||||
hour <- fromIntegral . read <$> many1 digit |
||||
_ <- char ':' |
||||
minute <- fromIntegral . read <$> many1 digit |
||||
return $ UTCTime (fromGregorian year (month + 1) day) (hour * 3600 + minute * 60) |
||||
|
||||
getItem :: IndexItem -> IO (Maybe NewsItem) |
||||
getItem indexItem = do |
||||
rq <- parseRequest $ T.unpack (iiUrl indexItem) |
||||
resp <- httpLBS rq |
||||
if getResponseStatusCode resp == 200 |
||||
then return . parseItem . decodeUtf8 . BL.toStrict . getResponseBody $ resp |
||||
else return Nothing |
||||
where |
||||
parseItem rawHtml = case parseTimestamp timestamp of |
||||
Just itemPubtime -> Just NewsItem { |
||||
niUrl = iiUrl indexItem, |
||||
niHeader = itemHeader, |
||||
niText = itemText, |
||||
niAuthor = itemAuthor, |
||||
niPubTime = itemPubtime |
||||
} |
||||
Nothing -> Nothing |
||||
where |
||||
itemHeader = innerText . |
||||
extractBetween "span" . |
||||
extractBetween "h1" . |
||||
dropWhile (not . matchClass (T.pack "div") (T.pack "topic")) $ tags |
||||
|
||||
itemText = innerText . |
||||
extractBetween "div" . |
||||
dropWhile (not . matchClass (T.pack "div") (T.pack "content")) . |
||||
dropWhile (~/= "<div id=content_box>") $ tags |
||||
|
||||
itemAuthor = innerText . |
||||
extractBetween "li" . |
||||
dropWhile (not . matchClass (T.pack "li") (T.pack "author")) $ tags |
||||
|
||||
timestamp = traceShowId $ innerText . |
||||
extractBetween "li" . |
||||
dropWhile (not . matchClass (T.pack "li") (T.pack "date")) $ tags |
||||
|
||||
tags = parseTags rawHtml |
||||
|
||||
|
||||
getIndex :: T.Text -> Int -> IO ([IndexItem], Bool) |
||||
getIndex rootUrl pageNumber = do |
||||
rq <- parseRequest $ T.unpack $ makeUrl rootUrl pageNumber |
||||
resp <- httpLBS rq |
||||
return $ if getResponseStatusCode resp == 200 |
||||
then parseIndex . decodeUtf8 . BL.toStrict . getResponseBody $ resp |
||||
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) |
||||
|
||||
parseIndexEntry :: [Tag T.Text] -> Maybe IndexItem |
||||
parseIndexEntry divTag = do |
||||
a <- headMay . dropWhile (~/= "<a>") $ divTag |
||||
let text = innerText . takeWhile (~/= "</a>") . dropWhile (~/= "<a>") $ divTag |
||||
case a of |
||||
TagOpen _ attr -> do |
||||
href <- L.lookup (T.pack "href") attr |
||||
ts <- parseTimestamp (innerText $ takeWhile (~/= "</li>") . dropWhile (not . matchClass (T.pack "li") (T.pack "date")) $ divTag) |
||||
Just IndexItem { iiUrl = href, |
||||
iiTitle = text, |
||||
iiPubTime = ts } |
||||
_ -> Nothing |
||||
|
||||
|
||||
makeUrl root pagenumber |
||||
| pagenumber == 0 || pagenumber == 1 = root |
||||
| otherwise = root `T.append` (T.pack "/page") `T.append` T.pack (show pagenumber) |
||||
|
||||
hasNextPage tags = if pageNumber <= 1 |
||||
then paginationLinksCount > 0 |
||||
else paginationLinksCount > 1 |
||||
where |
||||
paginationLinksCount = length . filter (~== "<a>") . extractBetween "p" . dropWhile (~/= "<div id=pagination>") $ tags |
||||
|
||||
|
||||
@ -0,0 +1,361 @@
@@ -0,0 +1,361 @@
|
||||
{-# LANGUAGE FlexibleInstances #-} |
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE TypeSynonymInstances #-} |
||||
|
||||
module ATrade.Quotes.Finam ( |
||||
downloadFinamSymbols, |
||||
Symbol(..), |
||||
Period(..), |
||||
DateFormat(..), |
||||
TimeFormat(..), |
||||
FieldSeparator(..), |
||||
RequestParams(..), |
||||
defaultParams, |
||||
downloadQuotes, |
||||
parseQuotes, |
||||
downloadAndParseQuotes, |
||||
Row(..) |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
import Control.Error.Util |
||||
import Control.Exception |
||||
import Control.Lens |
||||
import Control.Monad |
||||
import qualified Data.ByteString as B |
||||
import qualified Data.ByteString.Char8 as B8 |
||||
import qualified Data.ByteString.Lazy as BL |
||||
import Data.Csv hiding (Options) |
||||
import Data.List |
||||
import qualified Data.Map as M |
||||
import Data.Maybe |
||||
import qualified Data.Text as T |
||||
import qualified Data.Text.ICU.Convert as TC |
||||
import Data.Time.Calendar |
||||
import Data.Time.Clock |
||||
import Data.Time.Format |
||||
import qualified Data.Vector as V |
||||
import Network.Wreq |
||||
import Safe |
||||
import System.Log.Logger |
||||
import Text.Parsec |
||||
import Text.ParserCombinators.Parsec.Number |
||||
|
||||
data Period = |
||||
PeriodTick | |
||||
Period1Min | |
||||
Period5Min | |
||||
Period10Min | |
||||
Period15Min | |
||||
Period30Min | |
||||
PeriodHour | |
||||
PeriodDay | |
||||
PeriodWeek | |
||||
PeriodMonth |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum Period where |
||||
fromEnum PeriodTick = 1 |
||||
fromEnum Period1Min = 2 |
||||
fromEnum Period5Min = 3 |
||||
fromEnum Period10Min = 4 |
||||
fromEnum Period15Min = 5 |
||||
fromEnum Period30Min = 6 |
||||
fromEnum PeriodHour = 7 |
||||
fromEnum PeriodDay = 8 |
||||
fromEnum PeriodWeek = 9 |
||||
fromEnum PeriodMonth = 10 |
||||
|
||||
toEnum 1 = PeriodTick |
||||
toEnum 2 = Period1Min |
||||
toEnum 3 = Period5Min |
||||
toEnum 4 = Period10Min |
||||
toEnum 5 = Period15Min |
||||
toEnum 6 = Period30Min |
||||
toEnum 7 = PeriodHour |
||||
toEnum 8 = PeriodDay |
||||
toEnum 9 = PeriodWeek |
||||
toEnum 10 = PeriodMonth |
||||
toEnum _ = PeriodDay |
||||
|
||||
data DateFormat = |
||||
FormatYYYYMMDD | |
||||
FormatYYMMDD | |
||||
FormatDDMMYY | |
||||
FormatDD_MM_YY | |
||||
FormatMM_DD_YY |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum DateFormat where |
||||
fromEnum FormatYYYYMMDD = 1 |
||||
fromEnum FormatYYMMDD = 2 |
||||
fromEnum FormatDDMMYY = 3 |
||||
fromEnum FormatDD_MM_YY = 4 |
||||
fromEnum FormatMM_DD_YY = 5 |
||||
|
||||
toEnum 1 = FormatYYYYMMDD |
||||
toEnum 2 = FormatYYMMDD |
||||
toEnum 3 = FormatDDMMYY |
||||
toEnum 4 = FormatDD_MM_YY |
||||
toEnum 5 = FormatMM_DD_YY |
||||
toEnum _ = FormatYYYYMMDD |
||||
|
||||
|
||||
data TimeFormat = |
||||
FormatHHMMSS | |
||||
FormatHHMM | |
||||
FormatHH_MM_SS | |
||||
FormatHH_MM |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum TimeFormat where |
||||
fromEnum FormatHHMMSS = 1 |
||||
fromEnum FormatHHMM = 2 |
||||
fromEnum FormatHH_MM_SS = 3 |
||||
fromEnum FormatHH_MM = 4 |
||||
|
||||
toEnum 1 = FormatHHMMSS |
||||
toEnum 2 = FormatHHMM |
||||
toEnum 3 = FormatHH_MM_SS |
||||
toEnum 4 = FormatHH_MM |
||||
toEnum _ = FormatHHMMSS |
||||
|
||||
data FieldSeparator = |
||||
SeparatorComma | |
||||
SeparatorPeriod | |
||||
SeparatorSemicolon | |
||||
SeparatorTab | |
||||
SeparatorSpace |
||||
deriving (Show, Eq) |
||||
|
||||
instance Enum FieldSeparator where |
||||
fromEnum SeparatorComma = 1 |
||||
fromEnum SeparatorPeriod = 2 |
||||
fromEnum SeparatorSemicolon = 3 |
||||
fromEnum SeparatorTab = 4 |
||||
fromEnum SeparatorSpace = 5 |
||||
|
||||
toEnum 1 = SeparatorComma |
||||
toEnum 2 = SeparatorPeriod |
||||
toEnum 3 = SeparatorSemicolon |
||||
toEnum 4 = SeparatorTab |
||||
toEnum 5 = SeparatorSpace |
||||
toEnum _ = SeparatorComma |
||||
|
||||
data RequestParams = RequestParams { |
||||
ticker :: T.Text, |
||||
startDate :: Day, |
||||
endDate :: Day, |
||||
period :: Period, |
||||
dateFormat :: DateFormat, |
||||
timeFormat :: TimeFormat, |
||||
fieldSeparator :: FieldSeparator, |
||||
includeHeader :: Bool, |
||||
fillEmpty :: Bool |
||||
} |
||||
|
||||
defaultParams :: RequestParams |
||||
defaultParams = RequestParams { |
||||
ticker = "", |
||||
startDate = fromGregorian 1970 1 1, |
||||
endDate = fromGregorian 1970 1 1, |
||||
period = PeriodDay, |
||||
dateFormat = FormatYYYYMMDD, |
||||
timeFormat = FormatHHMMSS, |
||||
fieldSeparator = SeparatorComma, |
||||
includeHeader = True, |
||||
fillEmpty = False |
||||
} |
||||
|
||||
data Symbol = Symbol { |
||||
symCode :: T.Text, |
||||
symName :: T.Text, |
||||
symId :: Integer, |
||||
symMarketCode :: Integer, |
||||
symMarketName :: T.Text |
||||
} |
||||
deriving (Show, Eq) |
||||
|
||||
data Row = Row { |
||||
rowTicker :: T.Text, |
||||
rowTime :: UTCTime, |
||||
rowOpen :: Price, |
||||
rowHigh :: Price, |
||||
rowLow :: Price, |
||||
rowClose :: Price, |
||||
rowVolume :: Integer |
||||
} deriving (Show, Eq) |
||||
|
||||
instance FromField Price where |
||||
parseField s = fromDouble <$> (parseField s :: Parser Double) |
||||
|
||||
instance FromRecord Row where |
||||
parseRecord v |
||||
| length v == 9 = do |
||||
tkr <- v .! 0 |
||||
date <- v .! 2 |
||||
time <- v .! 3 |
||||
dt <- addUTCTime (-3 * 3600) <$> (parseDt date time) |
||||
open <- v .! 4 |
||||
high <- v .! 5 |
||||
low <- v .! 6 |
||||
close <- v .! 7 |
||||
volume <- v .! 8 |
||||
return $ Row tkr dt open high low close volume |
||||
| otherwise = mzero |
||||
where |
||||
parseDt :: B.ByteString -> B.ByteString -> Parser UTCTime |
||||
parseDt d t = case parseTimeM True defaultTimeLocale "%Y%m%d %H%M%S" $ B8.unpack d ++ " " ++ B8.unpack t of |
||||
Just dt -> return dt |
||||
Nothing -> fail "Unable to parse date/time" |
||||
|
||||
downloadAndParseQuotes :: RequestParams -> IO (Maybe [Row]) |
||||
downloadAndParseQuotes requestParams = downloadAndParseQuotes' 3 |
||||
where |
||||
downloadAndParseQuotes' iter = do |
||||
raw <- downloadQuotes requestParams `catch` (\e -> do |
||||
debugM "History" $ "exception: " ++ show (e :: SomeException) |
||||
return Nothing) |
||||
case raw of |
||||
Just r -> return $ parseQuotes r |
||||
Nothing -> if iter <= 0 then return Nothing else downloadAndParseQuotes' (iter - 1) |
||||
|
||||
parseQuotes :: B.ByteString -> Maybe [Row] |
||||
parseQuotes csvData = case decode HasHeader $ BL.fromStrict csvData of |
||||
Left _ -> Nothing |
||||
Right d -> Just $ V.toList d |
||||
|
||||
downloadQuotes :: RequestParams -> IO (Maybe B.ByteString) |
||||
downloadQuotes requestParams = do |
||||
symbols <- downloadFinamSymbols |
||||
case requestUrl symbols requestParams of |
||||
Just (url, options') -> do |
||||
resp <- getWith options' url |
||||
return $ Just $ BL.toStrict $ resp ^. responseBody |
||||
Nothing -> return Nothing |
||||
|
||||
requestUrl :: [Symbol] -> RequestParams -> Maybe (String, Options) |
||||
requestUrl symbols requestParams = case getFinamCode symbols (ticker requestParams) of |
||||
Just (sym, market) -> Just ("http://export.finam.ru/export9.out", getOptions sym market) |
||||
Nothing -> Nothing |
||||
where |
||||
getOptions sym market = defaults & |
||||
param "market" .~ [T.pack . show $ market] & |
||||
param "f" .~ [ticker requestParams] & |
||||
param "e" .~ [".csv"] & |
||||
param "dtf" .~ [T.pack . show . fromEnum . dateFormat $ requestParams] & |
||||
param "tmf" .~ [T.pack . show . fromEnum . dateFormat $ requestParams] & |
||||
param "MSOR" .~ ["0"] & |
||||
param "mstime" .~ ["on"] & |
||||
param "mstimever" .~ ["1"] & |
||||
param "sep" .~ [T.pack . show . fromEnum . fieldSeparator $ requestParams] & |
||||
param "sep2" .~ ["1"] & |
||||
param "at" .~ [if includeHeader requestParams then "1" else "0"] & |
||||
param "fsp" .~ [if fillEmpty requestParams then "1" else "0"] & |
||||
param "p" .~ [T.pack . show . fromEnum $ period requestParams] & |
||||
param "em" .~ [T.pack . show $ sym ] & |
||||
param "df" .~ [T.pack . show $ dayFrom] & |
||||
param "mf" .~ [T.pack . show $ (monthFrom - 1)] & |
||||
param "yf" .~ [T.pack . show $ yearFrom] & |
||||
param "dt" .~ [T.pack . show $ dayTo] & |
||||
param "mt" .~ [T.pack . show $ (monthTo - 1)] & |
||||
param "yt" .~ [T.pack . show $ yearTo] & |
||||
param "code" .~ [ticker requestParams] & |
||||
param "datf" .~ if period requestParams == PeriodTick then ["11"] else ["1"] |
||||
(yearFrom, monthFrom, dayFrom) = toGregorian $ startDate requestParams |
||||
(yearTo, monthTo, dayTo) = toGregorian $ endDate requestParams |
||||
|
||||
getFinamCode :: [Symbol] -> T.Text -> Maybe (Integer, Integer) |
||||
getFinamCode symbols tickerCode = case find (\x -> symCode x == tickerCode && symMarketCode x `notElem` archives) symbols of |
||||
Just sym -> Just (symId sym, symMarketCode sym) |
||||
Nothing -> Nothing |
||||
|
||||
downloadFinamSymbols :: IO [Symbol] |
||||
downloadFinamSymbols = do |
||||
conv <- TC.open "cp1251" Nothing |
||||
result <- get "http://www.finam.ru/cache/icharts/icharts.js" |
||||
if result ^. responseStatus . statusCode == 200 |
||||
then return $ parseSymbols . T.lines $ TC.toUnicode conv $ BL.toStrict $ result ^. responseBody |
||||
else return [] |
||||
where |
||||
parseSymbols :: [T.Text] -> [Symbol] |
||||
parseSymbols strs = zipWith5 Symbol codes names ids marketCodes marketNames |
||||
where |
||||
getWithParser parser pos = fromMaybe [] $ do |
||||
s <- T.unpack <$> strs `atMay` pos |
||||
hush $ parse parser "" s |
||||
|
||||
ids :: [Integer] |
||||
ids = getWithParser intlist 0 |
||||
|
||||
names :: [T.Text] |
||||
names = T.pack <$> getWithParser strlist 1 |
||||
|
||||
codes :: [T.Text] |
||||
codes = T.pack <$> getWithParser strlist 2 |
||||
|
||||
marketCodes :: [Integer] |
||||
marketCodes = getWithParser intlist 3 |
||||
|
||||
marketNames :: [T.Text] |
||||
marketNames = fmap (\code -> fromMaybe "" $ M.lookup code codeToName) marketCodes |
||||
|
||||
intlist = do |
||||
_ <- string "var" |
||||
spaces |
||||
skipMany1 alphaNum |
||||
spaces |
||||
_ <- char '=' |
||||
spaces |
||||
_ <- char '[' |
||||
manyTill (do |
||||
i <- int |
||||
_ <- char ',' <|> char ']' |
||||
return i) (char '\'' <|> char ';') |
||||
|
||||
strlist = do |
||||
_ <- string "var" |
||||
spaces |
||||
skipMany1 alphaNum |
||||
spaces |
||||
_ <- char '=' |
||||
spaces |
||||
_ <- char '[' |
||||
(char '\'' >> manyTill ((char '\\' >> char '\'') <|> anyChar) (char '\'')) `sepBy` char ',' |
||||
|
||||
codeToName :: M.Map Integer T.Text |
||||
codeToName = M.fromList [ |
||||
(200, "МосБиржа топ"), |
||||
(1 , "МосБиржа акции"), |
||||
(14 , "МосБиржа фьючерсы"), |
||||
(41, "Курс рубля"), |
||||
(45, "МосБиржа валютный рынок"), |
||||
(2, "МосБиржа облигации"), |
||||
(12, "МосБиржа внесписочные облигации"), |
||||
(29, "МосБиржа пифы"), |
||||
(8, "Расписки"), |
||||
(6, "Мировые Индексы"), |
||||
(24, "Товары"), |
||||
(5, "Мировые валюты"), |
||||
(25, "Акции США(BATS)"), |
||||
(7, "Фьючерсы США"), |
||||
(27, "Отрасли экономики США"), |
||||
(26, "Гособлигации США"), |
||||
(28, "ETF"), |
||||
(30, "Индексы мировой экономики"), |
||||
(3, "РТС"), |
||||
(20, "RTS Board"), |
||||
(10, "РТС-GAZ"), |
||||
(17, "ФОРТС Архив"), |
||||
(31, "Сырье Архив"), |
||||
(38, "RTS Standard Архив"), |
||||
(16, "ММВБ Архив"), |
||||
(18, "РТС Архив"), |
||||
(9, "СПФБ Архив"), |
||||
(32, "РТС-BOARD Архив"), |
||||
(39, "Расписки Архив"), |
||||
(-1, "Отрасли") ] |
||||
|
||||
|
||||
archives :: [Integer] |
||||
archives = [3, 8, 16, 17, 18, 31, 32, 38, 39, 517] |
||||
@ -0,0 +1,115 @@
@@ -0,0 +1,115 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Quotes.HAP ( |
||||
getQuotes, |
||||
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 |
||||
|
||||
data Period = |
||||
Period1Min | |
||||
Period5Min | |
||||
Period15Min | |
||||
Period30Min | |
||||
PeriodHour | |
||||
PeriodDay | |
||||
PeriodWeek | |
||||
PeriodMonth |
||||
deriving (Eq) |
||||
|
||||
instance Show Period where |
||||
show Period1Min = "M1" |
||||
show Period5Min = "M5" |
||||
show Period15Min = "M15" |
||||
show Period30Min = "M30" |
||||
show PeriodHour = "H1" |
||||
show PeriodDay = "D" |
||||
show PeriodWeek = "W" |
||||
show PeriodMonth = "MN" |
||||
|
||||
data RequestParams = |
||||
RequestParams |
||||
{ |
||||
endpoint :: T.Text, |
||||
ticker :: T.Text, |
||||
startDate :: UTCTime, |
||||
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) ] |
||||
|
||||
getQuotes :: Context -> RequestParams -> IO [Bar] |
||||
getQuotes ctx params = |
||||
withSocket ctx Req $ \sock -> do |
||||
debugM "HAP" $ "Connecting to ep: " ++ show (endpoint params) |
||||
connect sock $ (T.unpack . endpoint) params |
||||
send sock [] (BL.toStrict $ encode params { period = Period1Min}) |
||||
response <- receiveMulti sock |
||||
case response of |
||||
[header, rest] -> if header == "OK" |
||||
then return $ reverse $ resampleBars (period params) $ parseBars (ticker params) $ BL.fromStrict rest |
||||
else return [] |
||||
_ -> return [] |
||||
where |
||||
resampleBars p bars@(firstBar:rest) = resampleBars' (periodToSec p) rest firstBar [] |
||||
resampleBars' p (bar:bars) currentBar resampled = if barNumber p currentBar == barNumber p bar |
||||
then resampleBars' p bars (aggregate currentBar bar) resampled |
||||
else resampleBars' p bars bar (currentBar : resampled) |
||||
|
||||
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 |
||||
|
||||
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), |
||||
barClose = barClose newBar, |
||||
barTimestamp = barTimestamp newBar |
||||
} |
||||
|
||||
parseBars :: TickerId -> BL.ByteString -> [Bar] |
||||
parseBars tickerId input = |
||||
case runGetOrFail parseBar input of |
||||
Left _ -> [] |
||||
Right (rest, _, bar) -> bar : parseBars tickerId rest |
||||
where |
||||
parseBar = do |
||||
rawTimestamp <- realToFrac <$> getWord64le |
||||
baropen <- getDoublele |
||||
barhigh <- getDoublele |
||||
barlow <- getDoublele |
||||
barclose <- getDoublele |
||||
barvolume <- getWord64le |
||||
return Bar |
||||
{ |
||||
barSecurity = tickerId, |
||||
barTimestamp = posixSecondsToUTCTime rawTimestamp, |
||||
barOpen = fromDouble baropen, |
||||
barHigh = fromDouble barhigh, |
||||
barLow = fromDouble barlow, |
||||
barClose = fromDouble barclose, |
||||
barVolume = toInteger barvolume |
||||
} |
||||
@ -0,0 +1,92 @@
@@ -0,0 +1,92 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Quotes.QHP ( |
||||
getQuotes, |
||||
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 |
||||
|
||||
data Period = |
||||
Period1Min | |
||||
Period5Min | |
||||
Period15Min | |
||||
Period30Min | |
||||
PeriodHour | |
||||
PeriodDay | |
||||
PeriodWeek | |
||||
PeriodMonth |
||||
deriving (Eq) |
||||
|
||||
instance Show Period where |
||||
show Period1Min = "M1" |
||||
show Period5Min = "M5" |
||||
show Period15Min = "M15" |
||||
show Period30Min = "M30" |
||||
show PeriodHour = "H1" |
||||
show PeriodDay = "D" |
||||
show PeriodWeek = "W" |
||||
show PeriodMonth = "MN" |
||||
|
||||
data RequestParams = |
||||
RequestParams |
||||
{ |
||||
endpoint :: T.Text, |
||||
ticker :: T.Text, |
||||
startDate :: Day, |
||||
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) ] |
||||
|
||||
getQuotes :: Context -> RequestParams -> IO [Bar] |
||||
getQuotes ctx params = |
||||
withSocket ctx Req $ \sock -> do |
||||
debugM "QHP" $ "Connecting to ep: " ++ show (endpoint params) |
||||
connect sock $ (T.unpack . endpoint) params |
||||
send sock [] (BL.toStrict $ encode params) |
||||
response <- receiveMulti sock |
||||
case response of |
||||
[header, rest] -> if header == "OK" |
||||
then return $ reverse $ parseBars (ticker params) $ BL.fromStrict rest |
||||
else return [] |
||||
_ -> return [] |
||||
|
||||
parseBars :: TickerId -> BL.ByteString -> [Bar] |
||||
parseBars tickerId input = |
||||
case runGetOrFail parseBar input of |
||||
Left _ -> [] |
||||
Right (rest, _, bar) -> bar : parseBars tickerId rest |
||||
where |
||||
parseBar = do |
||||
rawTimestamp <- realToFrac <$> getWord64le |
||||
baropen <- getDoublele |
||||
barhigh <- getDoublele |
||||
barlow <- getDoublele |
||||
barclose <- getDoublele |
||||
barvolume <- getWord64le |
||||
return Bar |
||||
{ |
||||
barSecurity = tickerId, |
||||
barTimestamp = posixSecondsToUTCTime rawTimestamp, |
||||
barOpen = fromDouble baropen, |
||||
barHigh = fromDouble barhigh, |
||||
barLow = fromDouble barlow, |
||||
barClose = fromDouble barclose, |
||||
barVolume = toInteger barvolume |
||||
} |
||||
@ -0,0 +1,60 @@
@@ -0,0 +1,60 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
module ATrade.Quotes.QTIS |
||||
( |
||||
TickerInfo(..), |
||||
qtisGetTickersInfo, |
||||
qtisGetTickersInfo' |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
import Control.Monad |
||||
import Data.Aeson |
||||
import Data.Maybe |
||||
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 |
||||
|
||||
data TickerInfo = TickerInfo { |
||||
tiTicker :: T.Text, |
||||
tiLotSize :: Integer, |
||||
tiTickSize :: Price |
||||
} deriving (Show, Eq) |
||||
|
||||
instance FromJSON TickerInfo where |
||||
parseJSON = withObject "object" (\obj -> |
||||
TickerInfo <$> |
||||
obj .: "ticker" <*> |
||||
obj .: "lot_size" <*> |
||||
obj .: "tick_size") |
||||
|
||||
instance ToJSON TickerInfo where |
||||
toJSON ti = object [ "ticker" .= tiTicker ti, |
||||
"lot_size" .= tiLotSize ti, |
||||
"tick_size" .= tiTickSize ti ] |
||||
|
||||
qtisGetTickersInfo' :: T.Text -> [TickerId] -> IO [TickerInfo] |
||||
qtisGetTickersInfo' endpoint tickers = withContext (\ctx -> qtisGetTickersInfo ctx endpoint tickers) |
||||
|
||||
qtisGetTickersInfo :: Context -> T.Text -> [TickerId] -> IO [TickerInfo] |
||||
qtisGetTickersInfo ctx endpoint tickers = |
||||
withSocket ctx Req (\sock -> do |
||||
debugM "QTIS" $ "Connecting to: " ++ T.unpack endpoint |
||||
connect sock $ T.unpack endpoint |
||||
catMaybes <$> forM tickers (\tickerId -> do |
||||
debugM "QTIS" $ "Requesting: " ++ T.unpack tickerId |
||||
send sock [] $ BL.toStrict (tickerRequest tickerId) |
||||
response <- receiveMulti sock |
||||
let r = parseResponse response |
||||
debugM "QTIS" $ "Got response: " ++ show r |
||||
return r)) |
||||
where |
||||
tickerRequest tickerId = encode $ object ["ticker" .= tickerId] |
||||
parseResponse :: [BC8.ByteString] -> Maybe TickerInfo |
||||
parseResponse (header:payload:_) = if header == "OK" |
||||
then decode $ BL.fromStrict payload |
||||
else Nothing |
||||
parseResponse _ = Nothing |
||||
|
||||
@ -0,0 +1,125 @@
@@ -0,0 +1,125 @@
|
||||
|
||||
module ATrade.RoboCom.Indicators |
||||
( |
||||
cmf, |
||||
cci, |
||||
atr, |
||||
rsi, |
||||
highest, |
||||
lowest, |
||||
highestOf, |
||||
lowestOf, |
||||
sma, |
||||
ema, |
||||
intradayBarNumber, |
||||
hVolumeAt, |
||||
getMaxHVol, |
||||
bbandUpper, |
||||
percentRank |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
|
||||
import qualified Data.List as L |
||||
import Data.Time.Clock |
||||
import Safe |
||||
import Debug.Trace |
||||
|
||||
cmf :: Int -> [Bar] -> Double |
||||
cmf period bars = sum (toDouble . clv <$> take period bars) / toDouble (sum (fromInteger . barVolume <$> bars)) |
||||
where |
||||
clv bar = fromInteger (barVolume bar) * (barClose bar - barOpen bar) / (barHigh bar - barLow bar + 0.000001) |
||||
|
||||
cci :: Int -> [Bar] -> Double |
||||
cci period bars = (head tp - tpMean) / (0.015 * meanDev) |
||||
where |
||||
meanDev = sma period diff |
||||
diff = zipWith (\x y -> abs (x - y)) tp tpSma |
||||
tpMean = sma period tp |
||||
tpSma = fmap (sma period) $ take (2 * period) $ L.tails tp |
||||
tp = zipWith3 typicalPrice (toDouble . barClose <$> bars) (toDouble . barHigh <$> bars) (toDouble . barLow <$> bars) |
||||
typicalPrice a b c = (a + b + c) / 3 |
||||
|
||||
atr :: Int -> [Bar] -> Double |
||||
atr period bars = foldl (\x y -> (x * (period' - 1) + y) / period') 0 (reverse $ take (5 * period) trueranges) |
||||
where |
||||
trueranges :: [Double] |
||||
trueranges = zipWith trueRange bars (tail bars) |
||||
trueRange b1 b2 = toDouble $ maximum [ barHigh b1 - barLow b1, abs (barHigh b1 - barClose b2), abs (barLow b1 - barClose b2) ] |
||||
period' = fromIntegral period |
||||
|
||||
rsi :: Int -> [Double] -> Double |
||||
rsi period values = 100 - (100 / (1 + rs)) |
||||
where |
||||
rs = if emaWithAlpha (1 / fromIntegral period) downbars /= 0 then emaWithAlpha (1 / fromIntegral period) upbars / emaWithAlpha (1 / fromIntegral period) downbars else 100000000 |
||||
upbars = (\(bar1,bar2) -> if bar1 < bar2 then bar2 - bar1 else 0) <$> zip (tail values) values |
||||
downbars = (\(bar1,bar2) -> if bar1 > bar2 then bar1 - bar2 else 0) <$> zip (tail values) values |
||||
|
||||
lastNValues :: Int -> (Bar -> Price) -> [Bar] -> [Double] |
||||
lastNValues period f bars = toDouble . f <$> take period bars |
||||
|
||||
highest :: Int -> [Double] -> Maybe Double |
||||
highest period values = maximumMay $ take period values |
||||
|
||||
lowest :: Int -> [Double] -> Maybe Double |
||||
lowest period values = minimumMay $ take period values |
||||
|
||||
highestOf :: (Bar -> Price) -> Int -> [Bar] -> Double |
||||
highestOf f period bars = maximum $ lastNValues period f bars |
||||
|
||||
lowestOf :: (Bar -> Price) -> Int -> [Bar] -> Double |
||||
lowestOf f period bars = minimum $ lastNValues period f bars |
||||
|
||||
sma :: Int -> [Double] -> Double |
||||
sma period values = if period > 0 && (not . null) actualValues |
||||
then sum actualValues / fromIntegral (length actualValues) |
||||
else 0 |
||||
where |
||||
actualValues = take period values |
||||
|
||||
ema :: Int -> [Double] -> Double |
||||
ema period values = if period > 0 |
||||
then foldl (\x y -> y * alpha + x * (1 - alpha)) (sma period (drop (2 * period) values)) $ reverse $ take (2 * period) values |
||||
else 0 |
||||
where |
||||
alpha = 2.0 / (fromIntegral period + 1.0) |
||||
|
||||
emaWithAlpha :: Double -> [Double] -> Double |
||||
emaWithAlpha alpha values = foldl (\x y -> x * (1 - alpha) + y * alpha) 0 $ reverse values |
||||
|
||||
intradayBarNumber :: [Bar] -> Int |
||||
intradayBarNumber bars = case headMay bars of |
||||
Just bar -> intradayBarNumber' bar bars - 1 |
||||
Nothing -> 0 |
||||
where |
||||
intradayBarNumber' :: Bar -> [Bar] -> Int |
||||
intradayBarNumber' bar bars' = case headMay bars' of |
||||
Just bar' -> if dayOf bar /= dayOf bar' |
||||
then 0 |
||||
else 1 + intradayBarNumber' bar (tail bars') |
||||
Nothing -> 0 |
||||
|
||||
dayOf = utctDay . barTimestamp |
||||
|
||||
hVolumeAt :: Price -> Int -> [Bar] -> Double |
||||
hVolumeAt price period bars = |
||||
sum $ fmap (fromInteger . barVolume) $ L.filter (\x -> barHigh x >= price && barLow x <= price) $ take period bars |
||||
|
||||
getMaxHVol :: Price -> Price -> Int -> Int -> [Bar] -> Maybe Price |
||||
getMaxHVol start step steps period bars = fmap fst $ minimumByMay (\x y -> snd x `compare` snd y) $ (\price -> (price, hVolumeAt price period bars)) <$> range step start (start + fromIntegral steps * step) |
||||
where |
||||
range step' start' end = takeWhile (<= end) $ iterate (+ step') start' |
||||
|
||||
bbandUpper :: Int -> Double -> [Double] -> Double |
||||
bbandUpper period devs values = sma period values + devs * sigma |
||||
where |
||||
sigma = stddev $ take period values |
||||
stddev vs |
||||
| length vs > 1 = sqrt ((sum (map (\x -> (x - mean vs) * (x - mean vs)) vs)) / (fromIntegral $ length vs - 1)) |
||||
| otherwise = 0 |
||||
mean = sma period |
||||
|
||||
percentRank :: Int -> [Double] -> Double |
||||
percentRank period values@(v:vs) = fromIntegral (length (filter (\x -> x < v) $ take period values)) / fromIntegral (length (take period values)) |
||||
percentRank period [] = 0 |
||||
|
||||
@ -0,0 +1,118 @@
@@ -0,0 +1,118 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE TypeSynonymInstances #-} |
||||
{-# LANGUAGE FlexibleInstances #-} |
||||
{-# LANGUAGE TemplateHaskell #-} |
||||
{-# LANGUAGE BangPatterns #-} |
||||
{-# LANGUAGE TypeApplications #-} |
||||
{-# LANGUAGE MultiParamTypeClasses #-} |
||||
{-# LANGUAGE FunctionalDependencies #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module ATrade.RoboCom.Monad ( |
||||
RState, |
||||
RConfig, |
||||
RActions, |
||||
REnv, |
||||
StrategyEnvironment(..), |
||||
StrategyElement, |
||||
runStrategyElement, |
||||
EventCallback, |
||||
Event(..), |
||||
StrategyMonad, |
||||
StrategyAction(..), |
||||
tellAction, |
||||
MonadRobot(..), |
||||
also, |
||||
st |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
import ATrade.RoboCom.Types |
||||
|
||||
import Ether |
||||
|
||||
import Data.Time.Clock |
||||
import Data.Aeson.Types |
||||
import qualified Data.Text as T |
||||
import Text.Printf.TH |
||||
|
||||
|
||||
class (Monad m) => MonadRobot m c s | m -> c, m -> s where |
||||
submitOrder :: Order -> m () |
||||
cancelOrder :: OrderId -> m () |
||||
appendToLog :: T.Text -> m () |
||||
setupTimer :: UTCTime -> m () |
||||
enqueueIOAction :: Int -> IO Value -> m () |
||||
getConfig :: m c |
||||
getState :: m s |
||||
setState :: s -> m () |
||||
modifyState :: (s -> s) -> m () |
||||
modifyState f = do |
||||
oldState <- getState |
||||
setState (f oldState) |
||||
getEnvironment :: m StrategyEnvironment |
||||
|
||||
data RState |
||||
data RConfig |
||||
data RActions |
||||
data REnv |
||||
|
||||
type StrategyMonad c s = WriterT RActions [StrategyAction] (StateT RState s (ReaderT REnv StrategyEnvironment (Reader RConfig c))) |
||||
type StrategyElement c s r = (StrategyMonad c s) r |
||||
|
||||
runStrategyElement :: c -> s -> StrategyEnvironment -> StrategyElement c s r -> (s, [StrategyAction], r) |
||||
runStrategyElement conf sta env action = (newState, actions, retValue) |
||||
where |
||||
((retValue, actions), newState) = runReader @RConfig (runReaderT @REnv (runStateT @RState (runWriterT @RActions action) sta) env) conf |
||||
|
||||
type EventCallback c s = forall m . MonadRobot m c s => Event -> m () |
||||
|
||||
data Event = NewBar Bar |
||||
| NewTick Tick |
||||
| OrderSubmitted Order |
||||
| OrderUpdate OrderId OrderState |
||||
| NewTrade Trade |
||||
| TimerFired UTCTime |
||||
| Shutdown |
||||
| ActionCompleted Int Value |
||||
deriving (Show, Eq) |
||||
|
||||
data StrategyAction = ActionOrder Order |
||||
| ActionCancelOrder OrderId |
||||
| ActionLog T.Text |
||||
| ActionSetupTimer UTCTime |
||||
| 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 |
||||
seLastTimestamp :: !UTCTime |
||||
} deriving (Eq) |
||||
|
||||
instance Show StrategyAction where |
||||
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 |
||||
|
||||
tellAction :: StrategyAction -> StrategyElement c s () |
||||
tellAction a = tell @RActions [a] |
||||
|
||||
instance MonadRobot (StrategyMonad c s) c s where |
||||
submitOrder order = tellAction $ ActionOrder order |
||||
cancelOrder oId = tellAction $ ActionCancelOrder oId |
||||
appendToLog = tellAction . ActionLog |
||||
setupTimer = tellAction . ActionSetupTimer |
||||
enqueueIOAction actionId action = tellAction $ ActionIO actionId action |
||||
getConfig = ask @RConfig |
||||
getState = get @RState |
||||
setState = put @RState |
||||
getEnvironment = ask @REnv |
||||
|
||||
also :: EventCallback c s -> EventCallback c s -> EventCallback c s |
||||
also cb1 cb2 = (\event -> cb1 event >> cb2 event) |
||||
|
||||
@ -0,0 +1,603 @@
@@ -0,0 +1,603 @@
|
||||
{-# LANGUAGE DeriveGeneric #-} |
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE MultiWayIf #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE TypeApplications #-} |
||||
{-# LANGUAGE QuasiQuotes #-} |
||||
|
||||
{-| |
||||
- Module : ATrade.RoboCom.Combinators |
||||
- Description : Reusable behavioural components of strategies |
||||
- Copyright : (c) Denis Tereshkin 2016 |
||||
- License : Proprietary |
||||
- Maintainer : denis@kasan.ws |
||||
- Stability : experimental |
||||
- Portability : POSIX |
||||
- |
||||
- A lot of behaviour is common for most of the strategies. This module contains those common blocks which can be composed to avoid boilerplate in main strategy code. |
||||
-} |
||||
|
||||
module ATrade.RoboCom.Positions |
||||
( |
||||
StateHasPositions(..), |
||||
ParamsHasMainTicker(..), |
||||
PositionState(..), |
||||
Position(..), |
||||
posIsOpen, |
||||
posIsDead, |
||||
posIsLong, |
||||
posIsShort, |
||||
posOrderId, |
||||
posEqByIds, |
||||
modifyPositions, |
||||
defaultHandler, |
||||
modifyPosition, |
||||
getCurrentTicker, |
||||
getCurrentTickerSeries, |
||||
getLastActivePosition, |
||||
getAllActivePositions, |
||||
getAllActiveAndPendingPositions, |
||||
onNewBarEvent, |
||||
onNewTickEvent, |
||||
onNewTickEventWithDatatype, |
||||
onTimerFiredEvent, |
||||
onOrderSubmittedEvent, |
||||
onOrderUpdateEvent, |
||||
onTradeEvent, |
||||
onActionCompletedEvent, |
||||
enterAtMarket, |
||||
enterAtMarketWithParams, |
||||
enterAtLimit, |
||||
enterAtLimitWithVolume, |
||||
enterAtLimitWithParams, |
||||
enterAtLimitForTicker, |
||||
enterAtLimitForTickerWithVolume, |
||||
enterAtLimitForTickerWithParams, |
||||
enterLongAtMarket, |
||||
enterShortAtMarket, |
||||
enterLongAtLimit, |
||||
enterShortAtLimit, |
||||
enterLongAtLimitForTicker, |
||||
enterShortAtLimitForTicker, |
||||
exitAtMarket, |
||||
exitAtLimit, |
||||
doNothing, |
||||
setStopLoss, |
||||
setTakeProfit, |
||||
setStopLossAndTakeProfit |
||||
) where |
||||
|
||||
import GHC.Generics |
||||
|
||||
import ATrade.Types |
||||
import ATrade.RoboCom.Monad |
||||
import ATrade.RoboCom.Types |
||||
|
||||
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 |
||||
|
||||
data PositionState = PositionWaitingOpenSubmission Order |
||||
| PositionWaitingOpen |
||||
| PositionOpen |
||||
| PositionWaitingPendingCancellation |
||||
| PositionWaitingCloseSubmission Order |
||||
| PositionWaitingClose |
||||
| PositionClosed |
||||
| PositionCancelled |
||||
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, |
||||
posSubmissionDeadline :: Maybe UTCTime, |
||||
posExecutionDeadline :: Maybe UTCTime, |
||||
posEntryTime :: Maybe UTCTime, |
||||
posExitTime :: Maybe UTCTime |
||||
} deriving (Show, Eq, Generic) |
||||
|
||||
posEqByIds :: Position -> Position -> Bool |
||||
posEqByIds p1 p2 = posId p1 == posId p2 |
||||
|
||||
posIsOpen :: Position -> Bool |
||||
posIsOpen pos = posState pos == PositionOpen |
||||
|
||||
posIsDead :: Position -> Bool |
||||
posIsDead pos = posState pos == PositionClosed || posState pos == PositionCancelled |
||||
|
||||
instance FromJSON Position |
||||
instance FromJSON PositionState |
||||
instance ToJSON Position |
||||
instance ToJSON PositionState |
||||
|
||||
posIsLong :: Position -> Bool |
||||
posIsLong pos = 0 < posBalance pos |
||||
|
||||
posIsShort :: Position -> Bool |
||||
posIsShort pos = 0 > posBalance pos |
||||
|
||||
posOrderId :: Position -> Maybe Integer |
||||
posOrderId pos = orderId <$> posCurrentOrder pos |
||||
|
||||
class StateHasPositions a where |
||||
getPositions :: a -> [Position] |
||||
setPositions :: a -> [Position] -> a |
||||
|
||||
-- | Helper function, modifies position list. |
||||
modifyPositions :: (StateHasPositions s, MonadRobot m c s) => ([Position] -> [Position]) -> m () |
||||
modifyPositions f = do |
||||
pos <- getPositions <$> getState |
||||
modifyState (\s -> setPositions s (f pos)) |
||||
|
||||
class ParamsHasMainTicker a where |
||||
mainTicker :: a -> TickerId |
||||
|
||||
-- | Helper function. Finds first element in list which satisfies predicate 'p' and if found, applies 'm' to it, leaving other elements inact. |
||||
findAndModify :: (a -> Bool) -> (a -> a) -> [a] -> [a] |
||||
findAndModify p m (x:xs) = if p x |
||||
then m x : xs |
||||
else x : findAndModify p m xs |
||||
|
||||
findAndModify _ _ [] = [] |
||||
|
||||
handlePositions :: (StateHasPositions s) => EventCallback c s |
||||
handlePositions event = do |
||||
positions <- getPositions <$> getState |
||||
positions' <- mapM (dispatchPosition event) positions |
||||
modifyState (`setPositions` positions') |
||||
|
||||
orderCorrespondsTo :: Order -> Order -> Bool |
||||
orderCorrespondsTo o1 o2 = |
||||
orderAccountId o1 == orderAccountId o2 && |
||||
orderSecurity o1 == orderSecurity o2 && |
||||
orderQuantity o1 == orderQuantity o2 && |
||||
orderOperation o1 == orderOperation o2 && |
||||
orderPrice o1 == orderPrice o2 |
||||
|
||||
orderDeadline :: Maybe UTCTime -> UTCTime -> Bool |
||||
orderDeadline maybeDeadline lastTs = |
||||
case maybeDeadline of |
||||
Just deadline -> lastTs >= deadline |
||||
Nothing -> False |
||||
|
||||
|
||||
dispatchPosition :: (StateHasPositions s, MonadRobot m c s) => Event -> Position -> m Position |
||||
dispatchPosition event pos = case posState pos of |
||||
PositionWaitingOpenSubmission pendingOrder -> handlePositionWaitingOpenSubmission pendingOrder |
||||
PositionWaitingOpen -> handlePositionWaitingOpen |
||||
PositionOpen -> handlePositionOpen |
||||
PositionWaitingPendingCancellation -> handlePositionWaitingPendingCancellation |
||||
PositionWaitingCloseSubmission pendingOrder -> handlePositionWaitingCloseSubmission pendingOrder |
||||
PositionWaitingClose -> handlePositionWaitingClose |
||||
PositionClosed -> handlePositionClosed pos |
||||
PositionCancelled -> handlePositionCancelled pos |
||||
where |
||||
handlePositionWaitingOpenSubmission pendingOrder = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
if orderDeadline (posSubmissionDeadline pos) lastTs |
||||
then return $ pos { posState = PositionCancelled } -- TODO call TimeoutHandler if present |
||||
else case event of |
||||
OrderSubmitted order -> |
||||
return $ if order `orderCorrespondsTo` pendingOrder |
||||
then pos { posCurrentOrder = Just order, |
||||
posState = PositionWaitingOpen, |
||||
posSubmissionDeadline = Nothing } |
||||
else pos |
||||
_ -> return pos |
||||
|
||||
handlePositionWaitingOpen = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
case posCurrentOrder pos of |
||||
Just order -> if orderDeadline (posExecutionDeadline pos) lastTs |
||||
then do -- TODO call TimeoutHandler |
||||
appendToLog "In PositionWaitingOpen: execution timeout" |
||||
cancelOrder $ orderId order |
||||
return $ pos { posState = PositionWaitingPendingCancellation, posNextState = Just PositionCancelled } |
||||
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) |
||||
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 |
||||
return pos { posState = PositionOpen, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = balanceForOrder order, posEntryTime = Just lastTs} |
||||
Rejected -> do |
||||
appendToLog $ [st|Order rejected: %?|] order |
||||
return pos { posState = PositionCancelled, posCurrentOrder = Nothing, posExecutionDeadline = Nothing, posBalance = 0, posEntryTime = Nothing } |
||||
_ -> do |
||||
appendToLog $ [st|In PositionWaitingOpen: order state update: %?|] newstate |
||||
return pos |
||||
else do |
||||
appendToLog $ [st|Invalid order id: %?/%?|] oid (orderId order) |
||||
return pos |
||||
NewTrade trade -> do |
||||
appendToLog $ [st|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 |
||||
return pos |
||||
|
||||
handlePositionOpen = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
if |
||||
| orderDeadline (posSubmissionDeadline pos) lastTs -> do |
||||
appendToLog $ [st|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) |
||||
return pos { posExecutionDeadline = Nothing } |
||||
| otherwise -> case event of |
||||
NewTick tick -> if |
||||
| datatype tick == LastTradePrice && stopLoss tick -> case posStopLimitPrice pos of |
||||
Nothing -> exitAtMarket pos "stop" |
||||
Just lim -> exitAtLimit 86400 lim pos "stop" |
||||
| datatype tick == LastTradePrice && takeProfit tick -> exitAtMarket pos "take_profit" |
||||
| otherwise -> return pos |
||||
NewTrade trade -> case posCurrentOrder pos of |
||||
Just order -> 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 |
||||
Nothing -> return pos |
||||
_ -> return pos |
||||
|
||||
handlePositionWaitingPendingCancellation = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
if not $ orderDeadline (posSubmissionDeadline pos) lastTs |
||||
then case (event, posCurrentOrder pos, posNextState pos) of |
||||
(OrderUpdate _ newstate, Just _, Just (PositionWaitingCloseSubmission nextOrder)) -> |
||||
if newstate == Cancelled |
||||
then do |
||||
submitOrder nextOrder |
||||
return pos { posState = PositionWaitingCloseSubmission nextOrder, posSubmissionDeadline = Just (10 `addUTCTime` lastTs), posExecutionDeadline = Nothing } |
||||
else return pos |
||||
(OrderUpdate _ newstate, Just _, Just PositionCancelled) -> |
||||
if newstate == Cancelled |
||||
then return pos { posState = PositionCancelled, posSubmissionDeadline = Nothing, posExecutionDeadline = Nothing } |
||||
else return pos |
||||
_ -> return pos |
||||
else do |
||||
appendToLog "Deadline when cancelling pending order" |
||||
return pos { posState = PositionCancelled } |
||||
|
||||
handlePositionWaitingCloseSubmission pendingOrder = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
if orderDeadline (posSubmissionDeadline pos) lastTs |
||||
then do |
||||
case posCurrentOrder pos of |
||||
Just order -> cancelOrder (orderId order) |
||||
Nothing -> doNothing |
||||
return $ pos { posCurrentOrder = Nothing, posState = PositionOpen, posSubmissionDeadline = Nothing } -- TODO call TimeoutHandler if present |
||||
else case event of |
||||
OrderSubmitted order -> |
||||
return $ if order `orderCorrespondsTo` pendingOrder |
||||
then pos { posCurrentOrder = Just order, |
||||
posState = PositionWaitingClose, |
||||
posSubmissionDeadline = Nothing } |
||||
else pos |
||||
_ -> return pos |
||||
|
||||
handlePositionWaitingClose = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
if orderDeadline (posExecutionDeadline pos) lastTs |
||||
then do |
||||
case posCurrentOrder pos of |
||||
Just order -> cancelOrder (orderId order) |
||||
_ -> 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) -> |
||||
return $ if orderId order == oid && newstate == Executed |
||||
then pos { posCurrentOrder = Just order, |
||||
posState = PositionClosed, |
||||
posBalance = 0, |
||||
posSubmissionDeadline = Nothing } |
||||
else pos |
||||
_ -> return pos |
||||
|
||||
handlePositionClosed = return |
||||
handlePositionCancelled = return |
||||
|
||||
stopLoss tick = |
||||
if posTicker pos == security tick |
||||
then case posStopPrice pos of |
||||
Just stop -> if posIsLong pos then value tick <= stop else value tick >= stop |
||||
Nothing -> False |
||||
else False |
||||
|
||||
takeProfit tick = |
||||
if posTicker pos == security tick |
||||
then case posTakeProfitPrice 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 |
||||
newPosition order account tickerId operation quantity submissionDeadline = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
let position = Position { |
||||
posId = [st|%?/%?/%?/%?/%?|] account tickerId operation quantity lastTs, |
||||
posAccount = account, |
||||
posTicker = tickerId, |
||||
posBalance = 0, |
||||
posState = PositionWaitingOpenSubmission order, |
||||
posNextState = Just PositionOpen, |
||||
posStopPrice = Nothing, |
||||
posStopLimitPrice = Nothing, |
||||
posTakeProfitPrice = Nothing, |
||||
posCurrentOrder = Nothing, |
||||
posSubmissionDeadline = Just $ submissionDeadline `addUTCTime` lastTs, |
||||
posExecutionDeadline = Nothing, |
||||
posEntryTime = Nothing, |
||||
posExitTime = Nothing |
||||
} |
||||
modifyPositions (\p -> position : p) |
||||
positions <- getPositions <$> getState |
||||
appendToLog $ [st|All positions: %?|] positions |
||||
return position |
||||
|
||||
reapDeadPositions :: (StateHasPositions s) => EventCallback c s |
||||
reapDeadPositions _ = do |
||||
ts <- seLastTimestamp <$> getEnvironment |
||||
when (floor (utctDayTime ts) `mod` 300 == 0) $ modifyPositions (L.filter (not . posIsDead)) |
||||
|
||||
defaultHandler :: (StateHasPositions s) => EventCallback c s |
||||
defaultHandler = reapDeadPositions `also` handlePositions |
||||
|
||||
-- | Searches given position and alters it using given function. |
||||
modifyPosition :: (StateHasPositions s, MonadRobot m c s) => (Position -> Position) -> Position -> m Position |
||||
modifyPosition f oldpos = do |
||||
positions <- getPositions <$> getState |
||||
case L.find (posEqByIds oldpos) positions of |
||||
Just _ -> do |
||||
modifyState (`setPositions` findAndModify (posEqByIds oldpos) f positions) |
||||
return $ f oldpos |
||||
Nothing -> return oldpos |
||||
|
||||
getCurrentTicker :: (ParamsHasMainTicker c, MonadRobot m c s) => m [Bar] |
||||
getCurrentTicker = do |
||||
bars <- seBars <$> getEnvironment |
||||
maybeBars <- flip M.lookup bars . mainTicker <$> getConfig |
||||
case maybeBars of |
||||
Just b -> return $ bsBars b |
||||
_ -> return [] |
||||
|
||||
getCurrentTickerSeries :: (ParamsHasMainTicker c, MonadRobot m c s) => m (Maybe BarSeries) |
||||
getCurrentTickerSeries = do |
||||
bars <- seBars <$> getEnvironment |
||||
flip M.lookup bars . mainTicker <$> getConfig |
||||
|
||||
getLastActivePosition :: (StateHasPositions s, MonadRobot m c s) => m (Maybe Position) |
||||
getLastActivePosition = L.find (\pos -> posState pos == PositionOpen) . getPositions <$> getState |
||||
|
||||
getAllActivePositions :: (StateHasPositions s, MonadRobot m c s) => m [Position] |
||||
getAllActivePositions = L.filter (\pos -> posState pos == PositionOpen) . getPositions <$> getState |
||||
|
||||
getAllActiveAndPendingPositions :: (StateHasPositions s, MonadRobot m c s) => m [Position] |
||||
getAllActiveAndPendingPositions = L.filter |
||||
(\pos -> |
||||
posState pos == PositionOpen || |
||||
posState pos == PositionWaitingOpen || |
||||
isPositionWaitingOpenSubmission pos) . getPositions <$> getState |
||||
where |
||||
isPositionWaitingOpenSubmission pos = case posState pos of |
||||
PositionWaitingOpenSubmission _ -> True |
||||
_ -> False |
||||
|
||||
onNewBarEvent :: (MonadRobot m c s) => Event -> (Bar -> m ()) -> m () |
||||
onNewBarEvent event f = case event of |
||||
NewBar bar -> f bar |
||||
_ -> doNothing |
||||
|
||||
onNewTickEvent :: (MonadRobot m c s) => Event -> (Tick -> m ()) -> m () |
||||
onNewTickEvent event f = case event of |
||||
NewTick tick -> f tick |
||||
_ -> 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 |
||||
|
||||
onTimerFiredEvent :: (MonadRobot m c s) => Event -> (UTCTime -> m ()) -> m () |
||||
onTimerFiredEvent event f = case event of |
||||
TimerFired timer -> f timer |
||||
_ -> doNothing |
||||
|
||||
|
||||
onOrderSubmittedEvent :: (MonadRobot m c s) => Event -> (Order -> m ()) -> m () |
||||
onOrderSubmittedEvent event f = case event of |
||||
OrderSubmitted order -> f order |
||||
_ -> doNothing |
||||
|
||||
onOrderUpdateEvent :: (MonadRobot m c s) => Event -> (OrderId -> OrderState -> m ()) -> m () |
||||
onOrderUpdateEvent event f = case event of |
||||
OrderUpdate oid newstate -> f oid newstate |
||||
_ -> doNothing |
||||
|
||||
onTradeEvent :: (MonadRobot m c s) => Event -> (Trade -> m ()) -> m () |
||||
onTradeEvent event f = case event of |
||||
NewTrade trade -> f trade |
||||
_ -> doNothing |
||||
|
||||
onActionCompletedEvent :: (MonadRobot m c s) => Event -> (Int -> Value -> m ()) -> m () |
||||
onActionCompletedEvent event f = case event of |
||||
ActionCompleted tag v -> f tag v |
||||
_ -> doNothing |
||||
|
||||
enterAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Operation -> m Position |
||||
enterAtMarket signalName operation = do |
||||
env <- getEnvironment |
||||
enterAtMarketWithParams (seAccount env) (seVolume env) (SignalId (seInstanceId env) signalName "") operation |
||||
|
||||
enterAtMarketWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> Int -> SignalId -> Operation -> m Position |
||||
enterAtMarketWithParams account quantity signalId operation = do |
||||
tickerId <- mainTicker <$> getConfig |
||||
submitOrder $ order tickerId |
||||
newPosition (order tickerId) account tickerId operation quantity 20 |
||||
where |
||||
order tickerId = mkOrder { |
||||
orderAccountId = account, |
||||
orderSecurity = tickerId, |
||||
orderQuantity = toInteger quantity, |
||||
orderPrice = Market, |
||||
orderOperation = operation, |
||||
orderSignalId = signalId |
||||
} |
||||
|
||||
enterAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Operation -> m Position |
||||
enterAtLimit timeToCancel signalName price operation = do |
||||
env <- getEnvironment |
||||
enterAtLimitWithParams timeToCancel (seAccount env) (seVolume env) (SignalId (seInstanceId env) signalName "") price operation |
||||
|
||||
enterAtLimitWithVolume :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position |
||||
enterAtLimitWithVolume timeToCancel signalName price vol operation = do |
||||
acc <- seAccount <$> getEnvironment |
||||
inst <- seInstanceId <$> getEnvironment |
||||
enterAtLimitWithParams timeToCancel acc vol (SignalId inst signalName "") price operation |
||||
|
||||
enterAtLimitWithParams :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> T.Text -> Int -> SignalId -> Price -> Operation -> m Position |
||||
enterAtLimitWithParams timeToCancel account quantity signalId price operation = do |
||||
tickerId <- mainTicker <$> getConfig |
||||
enterAtLimitForTickerWithParams tickerId timeToCancel account quantity signalId price operation |
||||
|
||||
enterAtLimitForTickerWithVolume :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Price -> Int -> Operation -> m Position |
||||
enterAtLimitForTickerWithVolume tickerId timeToCancel signalName price vol operation = do |
||||
acc <- seAccount <$> getEnvironment |
||||
inst <- seInstanceId <$> getEnvironment |
||||
enterAtLimitForTickerWithParams tickerId timeToCancel acc vol (SignalId inst signalName "") price operation |
||||
|
||||
enterAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> T.Text -> Price -> Operation -> m Position |
||||
enterAtLimitForTicker tickerId timeToCancel signalName price operation = do |
||||
acc <- seAccount <$> getEnvironment |
||||
inst <- seInstanceId <$> getEnvironment |
||||
vol <- seVolume <$> getEnvironment |
||||
enterAtLimitForTickerWithParams tickerId timeToCancel acc vol (SignalId inst signalName "") price operation |
||||
|
||||
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 |
||||
appendToLog $ [st|enterAtLimit: %?, deadline: %?|] tickerId (timeToCancel `addUTCTime` lastTs) |
||||
newPosition order account tickerId operation quantity 20 >>= |
||||
modifyPosition (\p -> p { posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) |
||||
where |
||||
order = mkOrder { |
||||
orderAccountId = account, |
||||
orderSecurity = tickerId, |
||||
orderQuantity = toInteger quantity, |
||||
orderPrice = Limit price, |
||||
orderOperation = operation, |
||||
orderSignalId = signalId |
||||
} |
||||
|
||||
enterLongAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position |
||||
enterLongAtMarket signalName = enterAtMarket signalName Buy |
||||
|
||||
enterShortAtMarket :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => T.Text -> m Position |
||||
enterShortAtMarket signalName = enterAtMarket signalName Sell |
||||
|
||||
enterLongAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position |
||||
enterLongAtLimit timeToCancel price signalName = enterAtLimit timeToCancel signalName price Buy |
||||
|
||||
enterLongAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position |
||||
enterLongAtLimitForTicker tickerId timeToCancel price signalName = enterAtLimitForTicker tickerId timeToCancel signalName price Buy |
||||
|
||||
enterShortAtLimit :: (StateHasPositions s, ParamsHasMainTicker c, MonadRobot m c s) => NominalDiffTime -> Price -> T.Text -> m Position |
||||
enterShortAtLimit timeToCancel price signalName = enterAtLimit timeToCancel signalName price Sell |
||||
|
||||
enterShortAtLimitForTicker :: (StateHasPositions s, MonadRobot m c s) => TickerId -> NominalDiffTime -> Price -> T.Text -> m Position |
||||
enterShortAtLimitForTicker tickerId timeToCancel price signalName = enterAtLimitForTicker tickerId timeToCancel signalName price Sell |
||||
|
||||
exitAtMarket :: (StateHasPositions s, MonadRobot m c s) => Position -> T.Text -> m Position |
||||
exitAtMarket position signalName = do |
||||
inst <- seInstanceId <$> getEnvironment |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
case posCurrentOrder position of |
||||
Just order -> do |
||||
cancelOrder (orderId order) |
||||
modifyPosition (\pos -> |
||||
pos { posState = PositionWaitingPendingCancellation, |
||||
posNextState = Just $ PositionWaitingCloseSubmission (closeOrder inst), |
||||
posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs, |
||||
posExecutionDeadline = Nothing }) position |
||||
|
||||
Nothing -> do |
||||
submitOrder (closeOrder inst) |
||||
modifyPosition (\pos -> |
||||
pos { posCurrentOrder = Nothing, |
||||
posState = PositionWaitingCloseSubmission (closeOrder inst), |
||||
posNextState = Just PositionClosed, |
||||
posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs, |
||||
posExecutionDeadline = Nothing }) position |
||||
where |
||||
closeOrder inst = mkOrder { |
||||
orderAccountId = posAccount position, |
||||
orderSecurity = posTicker position, |
||||
orderQuantity = (abs . posBalance) position, |
||||
orderPrice = Market, |
||||
orderOperation = if posBalance position > 0 then Sell else Buy, |
||||
orderSignalId = (SignalId inst signalName "") |
||||
} |
||||
|
||||
exitAtLimit :: (StateHasPositions s, MonadRobot m c s) => NominalDiffTime -> Price -> Position -> T.Text -> m Position |
||||
exitAtLimit timeToCancel price position signalName = do |
||||
lastTs <- seLastTimestamp <$> getEnvironment |
||||
inst <- seInstanceId <$> getEnvironment |
||||
case posCurrentOrder position of |
||||
Just order -> cancelOrder (orderId order) |
||||
Nothing -> doNothing |
||||
submitOrder (closeOrder inst) |
||||
appendToLog $ [st|exitAtLimit: %?, deadline: %?|] (posTicker position) (timeToCancel `addUTCTime` lastTs) |
||||
modifyPosition (\pos -> |
||||
pos { posCurrentOrder = Nothing, |
||||
posState = PositionWaitingCloseSubmission (closeOrder inst), |
||||
posNextState = Just PositionClosed, |
||||
posSubmissionDeadline = Just $ 10 `addUTCTime` lastTs, |
||||
posExecutionDeadline = Just $ timeToCancel `addUTCTime` lastTs }) position |
||||
where |
||||
closeOrder inst = mkOrder { |
||||
orderAccountId = posAccount position, |
||||
orderSecurity = posTicker position, |
||||
orderQuantity = (abs . posBalance) position, |
||||
orderPrice = Limit price, |
||||
orderOperation = if posBalance position > 0 then Sell else Buy, |
||||
orderSignalId = SignalId inst signalName "" |
||||
} |
||||
|
||||
doNothing :: (MonadRobot m c s) => m () |
||||
doNothing = return () |
||||
|
||||
setStopLoss :: Price -> Position -> Position |
||||
setStopLoss sl pos = pos { posStopPrice = Just sl } |
||||
|
||||
setLimitStopLoss :: Price -> Price -> Position -> Position |
||||
setLimitStopLoss sl lim pos = pos { posStopPrice = Just sl, posStopLimitPrice = Just lim } |
||||
|
||||
setTakeProfit :: Price -> Position -> Position |
||||
setTakeProfit tp pos = pos { posTakeProfitPrice = Just tp } |
||||
|
||||
setStopLossAndTakeProfit :: Price -> Price -> Position -> Position |
||||
setStopLossAndTakeProfit sl tp = setStopLoss sl . setTakeProfit tp |
||||
|
||||
@ -0,0 +1,67 @@
@@ -0,0 +1,67 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE TypeSynonymInstances #-} |
||||
{-# LANGUAGE FlexibleInstances #-} |
||||
{-# LANGUAGE TemplateHaskell #-} |
||||
|
||||
module ATrade.RoboCom.Types ( |
||||
Bar(..), |
||||
BarSeries(..), |
||||
Timeframe(..), |
||||
tfSeconds, |
||||
Ticker(..), |
||||
Bars |
||||
) where |
||||
|
||||
import qualified Data.Text as T |
||||
import qualified Data.Text.Lazy as TL |
||||
import qualified Data.Map.Strict as M |
||||
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) |
||||
|
||||
newtype Timeframe = |
||||
Timeframe Integer deriving (Show, Eq) |
||||
|
||||
tfSeconds :: (Num a) => Timeframe -> a |
||||
tfSeconds (Timeframe s) = fromInteger s |
||||
|
||||
data BarSeries = |
||||
BarSeries { |
||||
bsTickerId :: TickerId, |
||||
bsTimeframe :: Timeframe, |
||||
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"). |
||||
-- 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' |
||||
} deriving (Show) |
||||
|
||||
instance FromJSON Ticker where |
||||
parseJSON = withObject "object" (\obj -> do |
||||
nm <- obj .: "name" |
||||
als <- obj .: "aliases" |
||||
als' <- parseAliases als |
||||
tf <- obj .: "timeframe" |
||||
return $ Ticker nm als' tf) |
||||
where |
||||
parseAliases :: Value -> Parser [(String, String)] |
||||
parseAliases = withObject "object1" (mapM parseAlias . HM.toList) |
||||
parseAlias :: (T.Text, Value) -> Parser (String, String) |
||||
parseAlias (k, v) = withText "string1" (\s -> return (T.unpack k, T.unpack s)) v |
||||
|
||||
instance ToJSON Ticker where |
||||
toJSON t = object [ "name" .= code t, |
||||
"timeframe" .= timeframeSeconds t, |
||||
"aliases" .= Object (HM.fromList $ fmap (\(x, y) -> (T.pack x, String $ T.pack y)) $ aliases t) ] |
||||
|
||||
type Bars = M.Map TickerId BarSeries |
||||
|
||||
@ -0,0 +1,76 @@
@@ -0,0 +1,76 @@
|
||||
{-# LANGUAGE TypeSynonymInstances #-} |
||||
{-# LANGUAGE FlexibleInstances #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
|
||||
module ATrade.RoboCom.Utils ( |
||||
barStartTime, |
||||
barEndTime, |
||||
rescaleToDaily, |
||||
barNumber, |
||||
getHMS, |
||||
getHMS', |
||||
fromHMS', |
||||
parseTime |
||||
) where |
||||
|
||||
import ATrade.Types |
||||
|
||||
import Data.Time.Clock |
||||
import Data.Time.Calendar |
||||
import qualified Data.Text as T |
||||
import Data.Text.Lazy.Builder |
||||
|
||||
import Text.Read hiding (String) |
||||
|
||||
rescaleToDaily :: [Bar] -> [Bar] |
||||
rescaleToDaily (firstBar:restBars) = rescaleToDaily' restBars firstBar |
||||
where |
||||
rescaleToDaily' (b:bars) currentBar = |
||||
if (utctDay . barTimestamp) b == (utctDay . barTimestamp) currentBar |
||||
then rescaleToDaily' bars $ currentBar { barOpen = barOpen b, |
||||
barHigh = max (barHigh b) (barHigh currentBar), |
||||
barLow = min (barLow b) (barLow currentBar), |
||||
barVolume = barVolume currentBar + barVolume b} |
||||
else currentBar : rescaleToDaily' bars b |
||||
rescaleToDaily' [] currentBar = [currentBar] |
||||
|
||||
rescaleToDaily [] = [] |
||||
|
||||
barEndTime :: Bar -> Integer -> UTCTime |
||||
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 |
||||
|
||||
barNumber :: UTCTime -> Integer -> Integer |
||||
barNumber ts barlen = floor (diffUTCTime ts epoch) `div` barlen |
||||
|
||||
epoch :: UTCTime |
||||
epoch = UTCTime (fromGregorian 1970 1 1) 0 |
||||
|
||||
-- | Helper function, converts 'UTCTime' to 3-tuple: (hours, minutes, seconds). Date part is discarded. |
||||
getHMS :: UTCTime -> (Int, Int, Int) |
||||
getHMS (UTCTime _ diff) = (intsec `div` 3600, (intsec `mod` 3600) `div` 60, intsec `mod` 60) |
||||
where |
||||
intsec = floor diff |
||||
|
||||
-- | Helper function, converts 'UTCTime' to integer of the form "HHMMSS" |
||||
getHMS' :: UTCTime -> Int |
||||
getHMS' t = h * 10000 + m * 100 + s |
||||
where |
||||
(h, m, s) = getHMS t |
||||
|
||||
fromHMS' :: Int -> DiffTime |
||||
fromHMS' hms = fromIntegral $ h * 3600 + m * 60 + s |
||||
where |
||||
h = hms `div` 10000 |
||||
m = (hms `mod` 10000) `div` 100 |
||||
s = (hms `mod` 100) |
||||
|
||||
parseTime :: T.Text -> Maybe DiffTime |
||||
parseTime x = case readMaybe (T.unpack x) of |
||||
Just t -> let h = t `div` 10000 |
||||
m = (t `mod` 10000) `div` 100 |
||||
s = t `mod` 100 |
||||
in Just $ fromInteger $ h * 3600 + m * 60 + s |
||||
Nothing -> Nothing |
||||
@ -0,0 +1,76 @@
@@ -0,0 +1,76 @@
|
||||
# This file was automatically generated by 'stack init' |
||||
# |
||||
# Some commonly used options have been documented as comments in this file. |
||||
# For advanced use and comprehensive documentation of the format, please see: |
||||
# https://docs.haskellstack.org/en/stable/yaml_configuration/ |
||||
|
||||
# Resolver to choose a 'specific' stackage snapshot or a compiler version. |
||||
# A snapshot resolver dictates the compiler version and the set of packages |
||||
# to be used for project dependencies. For example: |
||||
# |
||||
# resolver: lts-3.5 |
||||
# resolver: nightly-2015-09-21 |
||||
# resolver: ghc-7.10.2 |
||||
# resolver: ghcjs-0.1.0_ghc-7.10.2 |
||||
# |
||||
# The location of a snapshot can be provided as a file or url. Stack assumes |
||||
# a snapshot provided as a file might change, whereas a url resource does not. |
||||
# |
||||
# resolver: ./custom-snapshot.yaml |
||||
# resolver: https://example.com/snapshots/2018-01-01.yaml |
||||
resolver: lts-12.9 |
||||
|
||||
# User packages to be built. |
||||
# Various formats can be used as shown in the example below. |
||||
# |
||||
# packages: |
||||
# - some-directory |
||||
# - https://example.com/foo/bar/baz-0.0.2.tar.gz |
||||
# - location: |
||||
# git: https://github.com/commercialhaskell/stack.git |
||||
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a |
||||
# subdirs: |
||||
# - auto-update |
||||
# - wai |
||||
packages: |
||||
- . |
||||
- ../libatrade |
||||
- ../zeromq4-haskell-zap |
||||
# Dependency packages to be pulled from upstream that are not in the resolver |
||||
# using the same syntax as the packages field. |
||||
# (e.g., acme-missiles-0.3) |
||||
extra-deps: |
||||
- datetime-0.3.1 |
||||
- parsec-numbers-0.1.0 |
||||
- list-extras-0.4.1.4 |
||||
- snowball-1.0.0.1 |
||||
- binary-ieee754-0.1.0.0 |
||||
- th-printf-0.5.1 |
||||
- 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: {} |
||||
|
||||
# Extra package databases containing global packages |
||||
# extra-package-dbs: [] |
||||
|
||||
# Control whether we use the GHC we find on the path |
||||
# system-ghc: true |
||||
# |
||||
# Require a specific version of stack, using version ranges |
||||
# require-stack-version: -any # Default |
||||
# require-stack-version: ">=1.7" |
||||
# |
||||
# Override the architecture used by stack, especially useful on Windows |
||||
# arch: i386 |
||||
# arch: x86_64 |
||||
# |
||||
# Extra directories used by stack for building |
||||
# extra-include-dirs: [/path/to/dir] |
||||
# extra-lib-dirs: [/path/to/dir] |
||||
# |
||||
# Allow a newer minor version of GHC than the snapshot specifies |
||||
# compiler-check: newer-minor |
||||
@ -0,0 +1,10 @@
@@ -0,0 +1,10 @@
|
||||
import qualified Test.RoboCom.Indicators |
||||
import qualified Test.RoboCom.Utils |
||||
|
||||
import Test.Tasty |
||||
|
||||
main :: IO () |
||||
main = defaultMain $ testGroup "Tests" [unitTests] |
||||
|
||||
unitTests :: TestTree |
||||
unitTests = testGroup "Properties" [Test.RoboCom.Indicators.unitTests, Test.RoboCom.Utils.unitTests] |
||||
@ -0,0 +1,201 @@
@@ -0,0 +1,201 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
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 qualified Data.Text as T |
||||
import ATrade.Types |
||||
import Data.Time.Clock |
||||
import Data.Time.Calendar |
||||
|
||||
import ATrade.RoboCom.Indicators |
||||
|
||||
unitTests = testGroup "RoboCom.Indicators" [ |
||||
testEma, |
||||
testRsi, |
||||
testRsi2, |
||||
testAtr, |
||||
testCci, |
||||
testBbandUpper, |
||||
testPercentRank |
||||
] |
||||
|
||||
newbar b = Bar { barSecurity = T.pack "", barTimestamp = UTCTime (fromGregorian 1970 1 1) 0, barOpen = 0, barHigh = 0, barLow = 0, barClose = b, barVolume = 0} |
||||
assertEqualWithEpsilon eps one two = assertBool ("|" ++ show one ++ " - " ++ show two ++ "| < " ++ show eps) $ abs (one - two) < eps |
||||
|
||||
testEma = testCase "EMA calculation" $ assertEqualWithEpsilon 1 (ema 4 bars) 1256.19 |
||||
where |
||||
bars = reverse [1243.0, 1226.3, 1231.5, 1249, 1257.4, 1246.2, 1242.5, 1245.1, 1256.1, 1248.5, 1245, 1267.1] |
||||
|
||||
testRsi = testCase "RSI calculation" $ assertEqualWithEpsilon 0.1 (rsi 2 bars) 96.94 |
||||
where |
||||
bars = reverse [1, 3, 5, 7, 4, 2, 7, 4, 2, 12, 13, 11, 15, 32] |
||||
|
||||
testRsi2 = testCase "RSI calculation" $ assertEqualWithEpsilon 1 (rsi 6 bars) 18.11 |
||||
where |
||||
bars = reverse [1156.2, 1158.8, 1158.3, 1160.3, 1160.9, 1159.8, 1163.0, 1156.3, 1156.0, 1155.3, 1153.8, |
||||
1156.2, 1154.1, 1155.9, 1158.1, 1155.8, 1155.9, 1154.5, 1149.8, 1146.5, 1152.1, 1154.0, 1150.2, 1139.5, 1132.6] |
||||
|
||||
testAtr = testCase "ATR calculation" $ assertEqualWithEpsilon 0.1 (atr 14 bars) 1.32 |
||||
where |
||||
bars = reverse [bar 48.70 47.79 48.16, |
||||
bar 48.72 48.14 48.61, |
||||
bar 48.90 48.39 48.75, |
||||
bar 48.87 48.37 48.63, |
||||
bar 48.82 48.24 48.74, |
||||
bar 49.05 48.64 49.03, |
||||
bar 49.20 48.94 49.07, |
||||
bar 49.35 48.86 49.32, |
||||
bar 49.92 49.50 49.91, |
||||
bar 50.19 49.87 50.13, |
||||
bar 50.12 49.20 49.53, |
||||
bar 49.66 48.90 49.50, |
||||
bar 49.88 49.43 49.75, |
||||
bar 50.19 49.73 50.03, |
||||
bar 50.36 49.26 50.31, |
||||
bar 50.57 50.09 50.52, |
||||
bar 50.65 50.30 50.41, |
||||
bar 50.43 49.21 49.34, |
||||
bar 49.63 48.98 49.37, |
||||
bar 50.33 49.61 50.23, |
||||
bar 50.29 49.20 49.24, |
||||
bar 50.17 49.43 49.93, |
||||
bar 49.32 48.08 48.43, |
||||
bar 48.50 47.64 48.18, |
||||
bar 48.32 41.55 46.57, |
||||
bar 46.80 44.28 45.41, |
||||
bar 47.80 47.31 47.77, |
||||
bar 48.39 47.20 47.72, |
||||
bar 48.66 47.90 48.62, |
||||
bar 48.79 47.73 47.85 ] |
||||
bar h l c = Bar { barSecurity = "", barTimestamp = UTCTime (fromGregorian 1970 1 1) 0, barOpen = 0, barHigh = h, barLow = l, barClose = c, barVolume = 0} |
||||
|
||||
testCci = testCase "CCI calculation" $ do |
||||
assertEqualWithEpsilon 0.1 (cci 12 bars) 212.39 |
||||
where |
||||
bars = reverse [ |
||||
bar 195.2900000 194.3900000 195.1200000, |
||||
bar 195.2100000 194.7200000 195.0600000, |
||||
bar 195.8800000 195.0000000 195.7600000, |
||||
bar 196.3000000 195.6600000 196.0600000, |
||||
bar 196.4900000 195.8400000 196.0000000, |
||||
bar 196.6000000 195.9700000 196.5500000, |
||||
bar 197.0500000 196.5400000 196.7000000, |
||||
bar 196.8200000 196.3000000 196.4700000, |
||||
bar 196.4800000 196.0500000 196.2000000, |
||||
bar 196.3700000 195.8900000 196.1500000, |
||||
bar 196.8500000 196.0600000 196.5500000, |
||||
bar 196.7100000 196.2000000 196.7100000, |
||||
bar 196.9900000 196.4600000 196.5100000, |
||||
bar 196.5900000 195.8400000 195.9700000, |
||||
bar 196.2800000 195.4500000 195.6700000, |
||||
bar 195.6300000 194.0000000 194.0000000, |
||||
bar 194.6500000 193.3300000 194.4500000, |
||||
bar 194.5100000 194.0000000 194.0500000, |
||||
bar 193.7700000 192.3800000 193.0900000, |
||||
bar 193.5000000 192.5600000 192.9700000, |
||||
bar 193.9500000 192.7600000 193.8400000, |
||||
bar 194.5000000 193.7600000 194.2600000, |
||||
bar 194.8700000 193.8800000 194.6800000, |
||||
bar 194.7800000 194.1100000 194.4900000, |
||||
bar 194.7300000 194.1300000 194.2700000, |
||||
bar 194.8300000 194.1200000 194.6700000, |
||||
bar 195.1200000 193.8800000 193.8900000, |
||||
bar 194.2800000 193.7700000 194.0200000, |
||||
bar 194.1600000 193.8000000 194.0300000, |
||||
bar 194.0100000 193.4500000 193.8000000, |
||||
bar 193.9900000 193.6500000 193.9100000, |
||||
bar 194.9000000 193.5700000 194.1600000, |
||||
bar 194.2000000 193.1500000 193.4500000, |
||||
bar 193.8900000 193.1800000 193.4700000, |
||||
bar 194.1000000 193.1000000 193.1300000, |
||||
bar 193.8500000 193.1000000 193.8500000, |
||||
bar 194.9200000 194.1500000 194.1700000, |
||||
bar 194.7000000 193.9500000 194.6100000, |
||||
bar 195.2000000 194.5000000 194.5200000, |
||||
bar 195.6800000 194.5200000 195.5200000, |
||||
bar 195.7500000 195.0700000 195.2700000, |
||||
bar 195.4000000 194.7100000 194.9000000, |
||||
bar 195.1600000 193.9400000 194.0600000, |
||||
bar 194.1900000 193.3300000 193.3800000, |
||||
bar 193.8200000 193.2000000 193.7200000, |
||||
bar 193.6900000 193.2500000 193.6600000, |
||||
bar 194.1700000 193.3700000 194.0800000, |
||||
bar 194.4300000 193.7600000 194.1900000, |
||||
bar 194.4200000 194.0100000 194.3100000, |
||||
bar 194.3600000 193.8300000 194.2900000, |
||||
bar 194.3500000 193.5100000 193.9400000, |
||||
bar 194.2500000 193.7500000 194.1200000, |
||||
bar 194.1700000 193.8000000 193.8400000, |
||||
bar 194.2700000 193.8000000 193.8000000, |
||||
bar 197.1400000 195.5600000 196.6100000, |
||||
bar 197.0400000 196.5500000 197.0000000, |
||||
bar 198.6900000 196.8500000 198.6800000, |
||||
bar 199.4700000 198.5600000 199.4300000, |
||||
bar 201.7100000 199.4300000 199.8900000, |
||||
bar 200.1500000 199.1100000 200.1300000, |
||||
bar 200.7300000 199.1200000 199.7100000, |
||||
bar 200.5000000 199.6000000 200.3800000, |
||||
bar 201.9500000 200.2500000 201.9500000, |
||||
bar 204.0000000 201.8900000 203.2000000, |
||||
bar 203.9900000 203.0700000 203.5800000, |
||||
bar 206.7000000 203.5000000 205.6500000, |
||||
bar 206.5000000 204.8900000 206.5000000, |
||||
bar 206.5000000 204.5500000 206.0000000, |
||||
bar 206.1000000 203.2500000 203.6600000, |
||||
bar 205.4400000 203.5000000 205.1200000, |
||||
bar 205.9100000 203.7000000 204.2800000, |
||||
bar 205.9600000 204.1300000 205.9600000, |
||||
bar 208.0000000 204.0600000 206.8300000, |
||||
bar 207.5600000 206.5300000 207.2300000, |
||||
bar 209.3500000 207.1000000 208.9700000, |
||||
bar 209.8000000 208.8200000 209.7000000, |
||||
bar 209.9700000 209.0500000 209.4200000, |
||||
bar 209.7300000 209.2800000 209.6600000, |
||||
bar 211.7700000 209.6600000 211.2300000, |
||||
bar 211.3000000 210.0000000 210.4900000, |
||||
bar 211.1000000 210.4500000 211.0000000, |
||||
bar 211.0000000 209.6200000 210.0100000, |
||||
bar 210.2300000 209.6600000 210.1000000, |
||||
bar 210.5600000 209.1600000 209.5000000, |
||||
bar 209.9100000 209.0900000 209.7100000, |
||||
bar 210.1900000 209.2900000 210.0500000, |
||||
bar 210.3000000 209.8000000 209.8600000, |
||||
bar 210.0200000 208.8900000 209.3100000, |
||||
bar 210.0800000 209.2100000 209.9700000, |
||||
bar 209.9500000 209.0900000 209.0900000, |
||||
bar 210.9600000 209.1200000 210.1900000, |
||||
bar 210.6500000 209.4000000 210.3700000, |
||||
bar 212.2600000 210.3000000 210.9800000, |
||||
bar 211.4500000 210.0000000 210.4800000, |
||||
bar 210.6900000 209.7300000 210.0300000, |
||||
bar 210.3200000 209.8400000 210.0700000, |
||||
bar 210.4000000 210.0000000 210.3200000, |
||||
bar 210.4000000 210.2000000 210.3300000, |
||||
bar 211.0000000 210.2800000 210.4200000, |
||||
bar 210.5000000 210.0100000 210.3400000, |
||||
bar 210.6000000 210.0700000 210.5400000, |
||||
bar 211.1200000 210.3200000 211.0400000, |
||||
bar 211.1700000 210.7300000 211.0200000, |
||||
bar 211.1500000 210.7500000 210.7600000, |
||||
bar 217.8000000 210.8000000 216.3500000, |
||||
bar 219.2000000 215.8200000 219.0400000, |
||||
bar 220.8400000 218.2600000 220.4400000, |
||||
bar 221.5000000 220.0500000 220.0500000 |
||||
] |
||||
bar h l c = Bar { barSecurity = "", barTimestamp = UTCTime (fromGregorian 1970 1 1) 0, barOpen = 0, barHigh = h, barLow = l, barClose = c, barVolume = 0} |
||||
|
||||
testBbandUpper = testCase "Bollinger bands (upper) calculation" $ assertEqualWithEpsilon 0.1 (bbandUpper 5 1.5 bars) 1764.12 |
||||
where |
||||
bars = reverse [1750.0, 1749.99, 1761.0, 1771.0, 1758.94, 1759.36, 1758.55, 1760.0, 1751.0, 1756.80, 1748.15, 1722.90, 1726] |
||||
|
||||
testPercentRank = testCase "PercentRank calculation" $ assertEqualWithEpsilon 0.01 (percentRank 10 bars) 0.9 |
||||
where |
||||
bars = reverse [0, 1, 2, 3, 4, 5, 6, 7, 8, 9] |
||||
@ -0,0 +1,158 @@
@@ -0,0 +1,158 @@
|
||||
{-# LANGUAGE OverloadedStrings #-} |
||||
|
||||
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 qualified Data.Text as T |
||||
import ATrade.Types |
||||
import Data.Time.Clock |
||||
import Data.Time.Calendar |
||||
|
||||
import ATrade.RoboCom.Utils |
||||
|
||||
unitTests = testGroup "RoboCom.Indicators" [ |
||||
testRescaleToDaily, |
||||
testRescaleToDaily2 |
||||
] |
||||
|
||||
testRescaleToDaily = testCase "Rescale to daily" $ assertEqual "Incorrect rescale" dailyBars $ rescaleToDaily min15Bars |
||||
where |
||||
dailyBars = reverse [ yesterdayBar, todayBar ] |
||||
min15Bars = reverse [ |
||||
Bar { |
||||
barSecurity = "foo", |
||||
barTimestamp = UTCTime (fromGregorian 2017 2 28) (18 * 3600), |
||||
barOpen = 10, |
||||
barHigh = 12, |
||||
barLow = 9, |
||||
barClose = 11, |
||||
barVolume = 100 |
||||
}, |
||||
Bar { |
||||
barSecurity = "foo", |
||||
barTimestamp = UTCTime (fromGregorian 2017 2 28) (18 * 3600 + 15 * 60), |
||||
barOpen = 10.95, |
||||
barHigh = 12, |
||||
barLow = 9, |
||||
barClose = 11.3, |
||||
barVolume = 200 |
||||
}, |
||||
Bar { |
||||
barSecurity = "foo", |
||||
barTimestamp = UTCTime (fromGregorian 2017 3 1) (10 * 3600 + 0.1), |
||||
barOpen = 15, |
||||
barHigh = 15, |
||||
barLow = 14, |
||||
barClose = 14.2, |
||||
barVolume = 40 |
||||
} ] |
||||
yesterdayBar = Bar { |
||||
barSecurity = "foo", |
||||
barTimestamp = UTCTime (fromGregorian 2017 2 28) (18 * 3600 + 15 * 60), |
||||
barOpen = 10, |
||||
barHigh = 12, |
||||
barLow = 9, |
||||
barClose = 11.3, |
||||
barVolume = 300 |
||||
} |
||||
|
||||
todayBar = Bar { |
||||
barSecurity = "foo", |
||||
barTimestamp = UTCTime (fromGregorian 2017 3 1) (10 * 3600 + 0.1), |
||||
barOpen = 15, |
||||
barHigh = 15, |
||||
barLow = 14, |
||||
barClose = 14.2, |
||||
barVolume = 40 |
||||
} |
||||
|
||||
testRescaleToDaily2 = testCase "Rescale to daily 2" $ assertEqual "Incorrect rescale" dailyBars $ rescaleToDaily min30Bars |
||||
where |
||||
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, |
||||
ibar 4 17 3.6800000 3.6865000 3.5950000 3.6855000 117477000 ] |
||||
min30Bars = reverse [ |
||||
ibar 1 0 3.6065000 3.6065000 3.5670000 3.5985000 2058000, |
||||
ibar 1 1 3.5995000 3.6275000 3.5990000 3.6200000 2208000, |
||||
ibar 1 2 3.6200000 3.6300000 3.6130000 3.6300000 3132000, |
||||
ibar 1 3 3.6290000 3.6300000 3.6215000 3.6285000 1296000, |
||||
ibar 1 4 3.6280000 3.6365000 3.6205000 3.6365000 1956000, |
||||
ibar 1 5 3.6350000 3.6500000 3.6350000 3.6470000 4126000, |
||||
ibar 1 6 3.6460000 3.6560000 3.6440000 3.6555000 3656000, |
||||
ibar 1 7 3.6555000 3.6570000 3.6485000 3.6560000 2076000, |
||||
ibar 1 8 3.6565000 3.6590000 3.6530000 3.6590000 1891000, |
||||
ibar 1 9 3.6585000 3.6695000 3.6580000 3.6695000 1951000, |
||||
ibar 1 10 3.6680000 3.6700000 3.6620000 3.6690000 2220000, |
||||
ibar 1 11 3.6690000 3.6695000 3.6470000 3.6485000 5865000, |
||||
ibar 1 12 3.6485000 3.6600000 3.6485000 3.6585000 2692000, |
||||
ibar 1 13 3.6585000 3.6670000 3.6565000 3.6650000 1348000, |
||||
ibar 1 14 3.6645000 3.6695000 3.6625000 3.6675000 1259000, |
||||
ibar 1 15 3.6675000 3.6695000 3.6490000 3.6520000 2554000, |
||||
ibar 1 16 3.6525000 3.6660000 3.6375000 3.6655000 4529000, |
||||
ibar 1 17 3.6655000 3.6740000 3.6595000 3.6740000 2581000, |
||||
ibar 2 0 3.6760000 3.6790000 3.6450000 3.6455000 3248000, |
||||
ibar 2 1 3.6450000 3.6510000 3.6400000 3.6510000 1357000, |
||||
ibar 2 2 3.6505000 3.6530000 3.6400000 3.6400000 1458000, |
||||
ibar 2 3 3.6410000 3.6435000 3.6350000 3.6365000 1667000, |
||||
ibar 2 4 3.6365000 3.6425000 3.6350000 3.6405000 1889000, |
||||
ibar 2 5 3.6395000 3.6440000 3.6390000 3.6410000 579000, |
||||
ibar 2 6 3.6425000 3.6445000 3.6400000 3.6420000 414000, |
||||
ibar 2 7 3.6420000 3.6420000 3.6380000 3.6385000 301000, |
||||
ibar 2 8 3.6385000 3.6430000 3.6360000 3.6415000 402000, |
||||
ibar 2 9 3.6425000 3.6500000 3.6405000 3.6500000 1855000, |
||||
ibar 2 10 3.6500000 3.6500000 3.6390000 3.6440000 1286000, |
||||
ibar 2 11 3.6435000 3.6465000 3.6400000 3.6410000 1260000, |
||||
ibar 2 12 3.6410000 3.6840000 3.6410000 3.6795000 5554000, |
||||
ibar 2 13 3.6800000 3.6825000 3.6700000 3.6790000 1980000, |
||||
ibar 2 14 3.6790000 3.6825000 3.6720000 3.6795000 1782000, |
||||
ibar 2 15 3.6775000 3.6795000 3.6720000 3.6720000 693000, |
||||
ibar 2 16 3.6720000 3.6825000 3.6710000 3.6810000 2432000, |
||||
ibar 2 17 3.6810000 3.6980000 3.6800000 3.6980000 4486000, |
||||
ibar 3 0 3.7000000 3.7050000 3.6810000 3.6845000 2517000, |
||||
ibar 3 1 3.6860000 3.7090000 3.6840000 3.7025000 3201000, |
||||
ibar 3 2 3.7035000 3.7040000 3.6945000 3.6975000 947000, |
||||
ibar 3 3 3.6975000 3.7000000 3.6870000 3.6910000 1272000, |
||||
ibar 3 4 3.6885000 3.6965000 3.6805000 3.6920000 2710000, |
||||
ibar 3 5 3.6885000 3.6985000 3.6885000 3.6935000 932000, |
||||
ibar 3 6 3.6920000 3.6930000 3.6630000 3.6690000 4562000, |
||||
ibar 3 7 3.6690000 3.6740000 3.6640000 3.6670000 663000, |
||||
ibar 3 8 3.6670000 3.6715000 3.6600000 3.6690000 2189000, |
||||
ibar 3 9 3.6700000 3.6745000 3.6605000 3.6725000 880000, |
||||
ibar 3 10 3.6725000 3.6775000 3.6695000 3.6740000 1544000, |
||||
ibar 3 11 3.6755000 3.6790000 3.6640000 3.6660000 1264000, |
||||
ibar 3 12 3.6655000 3.6710000 3.6655000 3.6680000 484000, |
||||
ibar 3 13 3.6680000 3.6780000 3.6680000 3.6740000 1178000, |
||||
ibar 3 14 3.6735000 3.6800000 3.6735000 3.6770000 919000, |
||||
ibar 3 15 3.6785000 3.6830000 3.6600000 3.6655000 3961000, |
||||
ibar 3 16 3.6655000 3.6805000 3.6545000 3.6795000 4080000, |
||||
ibar 3 17 3.6795000 3.6840000 3.6685000 3.6800000 2424000, |
||||
ibar 4 0 3.6800000 3.6865000 3.6610000 3.6665000 1406000, |
||||
ibar 4 1 3.6635000 3.6770000 3.6550000 3.6660000 1184000, |
||||
ibar 4 2 3.6650000 3.6800000 3.6600000 3.6685000 3210000, |
||||
ibar 4 3 3.6685000 3.6710000 3.6610000 3.6610000 1525000, |
||||
ibar 4 4 3.6610000 3.6720000 3.6600000 3.6650000 2849000, |
||||
ibar 4 5 3.6615000 3.6650000 3.6535000 3.6540000 2027000, |
||||
ibar 4 6 3.6535000 3.6670000 3.6420000 3.6500000 3892000, |
||||
ibar 4 7 3.6465000 3.6600000 3.6350000 3.6520000 4267000, |
||||
ibar 4 8 3.6515000 3.6720000 3.6500000 3.6535000 5878000, |
||||
ibar 4 9 3.6535000 3.6640000 3.6435000 3.6435000 3047000, |
||||
ibar 4 10 3.6435000 3.6490000 3.6395000 3.6395000 2217000, |
||||
ibar 4 11 3.6395000 3.6395000 3.6105000 3.6255000 4354000, |
||||
ibar 4 12 3.6260000 3.6400000 3.5950000 3.6135000 6811000, |
||||
ibar 4 13 3.6145000 3.6600000 3.6140000 3.6550000 5101000, |
||||
ibar 4 14 3.6550000 3.6600000 3.6380000 3.6570000 2624000, |
||||
ibar 4 15 3.6570000 3.6595000 3.6305000 3.6400000 4906000, |
||||
ibar 4 16 3.6400000 3.6435000 3.6195000 3.6400000 8638000, |
||||
ibar 4 17 3.6435000 3.6855000 3.6275000 3.6855000 53541000 ] |
||||
|
||||
ibar d ibn o h l c v = Bar { barSecurity = "", barTimestamp = UTCTime (fromGregorian 2017 2 d) (10 * 3600 + ibn * 30 * 60), barOpen = o, barHigh = h, barLow = l, barClose = c, barVolume = v} |
||||
|
||||
Loading…
Reference in new issue