Initial commit

7 years ago · 813b15fc6b
27 changed files with 3523 additions and 0 deletions
--- a/.gitignore
+++ b/.gitignore
@ -0,0 +1,3 @@
 .*
 *~
 *#*.*#
--- a/30
+++ b/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.
--- a/README.md
+++ b/README.md
@ -0,0 +1 @@
 # robocom-zero
--- a/Setup.hs
+++ b/Setup.hs
@ -0,0 +1,2 @@
 import Distribution.Simple
 main = defaultMain
--- a/robocom-zero.cabal
+++ b/robocom-zero.cabal
@ -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
--- a/src/ATrade/Backtest/Execution.hs
+++ b/src/ATrade/Backtest/Execution.hs
@ -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 ()
--- a/src/ATrade/BarAggregator.hs
+++ b/src/ATrade/BarAggregator.hs
@ -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 }
--- a/src/ATrade/Driver/Backtest.hs
+++ b/src/ATrade/Driver/Backtest.hs
@ -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))
--- a/src/ATrade/Driver/Real.hs
+++ b/src/ATrade/Driver/Real.hs
@ -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
--- a/src/ATrade/Driver/Real/BrokerClientThread.hs
+++ b/src/ATrade/Driver/Real/BrokerClientThread.hs
@ -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
--- a/src/ATrade/Driver/Real/QuoteSourceThread.hs
+++ b/src/ATrade/Driver/Real/QuoteSourceThread.hs
@ -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))
--- a/src/ATrade/Driver/Real/Types.hs
+++ b/src/ATrade/Driver/Real/Types.hs
@ -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
--- a/src/ATrade/Exceptions.hs
+++ b/src/ATrade/Exceptions.hs
@ -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
--- a/src/ATrade/Forums/Smartlab.hs
+++ b/src/ATrade/Forums/Smartlab.hs
@ -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
--- a/src/ATrade/Quotes/Finam.hs
+++ b/src/ATrade/Quotes/Finam.hs
@ -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]
--- a/src/ATrade/Quotes/HAP.hs
+++ b/src/ATrade/Quotes/HAP.hs
@ -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
        }
--- a/src/ATrade/Quotes/QHP.hs
+++ b/src/ATrade/Quotes/QHP.hs
@ -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
        }
--- a/src/ATrade/Quotes/QTIS.hs
+++ b/src/ATrade/Quotes/QTIS.hs
@ -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
--- a/src/ATrade/RoboCom/Indicators.hs
+++ b/src/ATrade/RoboCom/Indicators.hs
@ -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
--- a/src/ATrade/RoboCom/Monad.hs
+++ b/src/ATrade/RoboCom/Monad.hs
@ -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)
--- a/src/ATrade/RoboCom/Positions.hs
+++ b/src/ATrade/RoboCom/Positions.hs
@ -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
--- a/src/ATrade/RoboCom/Types.hs
+++ b/src/ATrade/RoboCom/Types.hs
@ -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
--- a/src/ATrade/RoboCom/Utils.hs
+++ b/src/ATrade/RoboCom/Utils.hs
@ -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
--- a/stack.yaml
+++ b/stack.yaml
@ -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
--- a/test/Spec.hs
+++ b/test/Spec.hs
@ -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]
--- a/test/Test/RoboCom/Indicators.hs
+++ b/test/Test/RoboCom/Indicators.hs
@ -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]
--- a/test/Test/RoboCom/Utils.hs
+++ b/test/Test/RoboCom/Utils.hs
@ -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}
		`@ -0,0 +1,2 @@`
							`import Distribution.Simple`
							`main = defaultMain`