You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
183 lines
7.6 KiB
183 lines
7.6 KiB
{-# LANGUAGE OverloadedStrings #-} |
|
|
|
module Test.BarAggregator |
|
( |
|
unitTests |
|
) where |
|
|
|
import ATrade.BarAggregator |
|
import ATrade.RoboCom.Types |
|
import ATrade.Types |
|
import qualified Data.Map.Strict as M |
|
import qualified Data.Text as T |
|
import Data.Time.Calendar |
|
import Data.Time.Clock |
|
|
|
import Test.Tasty |
|
import Test.Tasty.HUnit |
|
import Test.Tasty.QuickCheck as QC |
|
import Test.Tasty.SmallCheck as SC |
|
|
|
unitTests = testGroup "BarAggregator" [ |
|
testUnknownBarSeries |
|
, testOneTick |
|
, testTwoTicksInSameBar |
|
, testTwoTicksInDifferentBars |
|
, testOneBar |
|
, testTwoBarsInSameBar |
|
, testTwoBarsInSameBarLastBar |
|
, testNextBarAfterBarClose |
|
] |
|
|
|
testUnknownBarSeries :: TestTree |
|
testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do |
|
let agg = BarAggregator M.empty M.empty [(0, 86400)] |
|
let (mbar, newagg) = handleTick tick agg |
|
mbar @?= Nothing |
|
(bars newagg) @?= M.empty |
|
where |
|
testTimestamp = (UTCTime (fromGregorian 1970 1 1) 100) |
|
tick = Tick { |
|
security = "TEST_TICKER", |
|
datatype = LastTradePrice, |
|
timestamp = testTimestamp, |
|
value = fromDouble 12.00, |
|
volume = 1 } |
|
|
|
testOneTick :: TestTree |
|
testOneTick = testCase "One tick" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 60) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleTick tick agg |
|
mbar @?= Nothing |
|
(bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg)) @?= Just [Bar "TEST_TICKER" testTimestamp 12.00 12.00 12.00 12.00 1] |
|
where |
|
testTimestamp = (UTCTime (fromGregorian 1970 1 1) 60) |
|
tick = Tick { |
|
security = "TEST_TICKER", |
|
datatype = LastTradePrice, |
|
timestamp = testTimestamp, |
|
value = fromDouble 12.00, |
|
volume = 1 } |
|
|
|
testTwoTicksInSameBar :: TestTree |
|
testTwoTicksInSameBar = testCase "Two ticks - same bar" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 60) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg |
|
mbar @?= Nothing |
|
let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg |
|
mbar' @?= Nothing |
|
(bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 12.00 14.00 12.00 14.00 2] |
|
where |
|
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58) |
|
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 59) |
|
tick ts val = Tick { |
|
security = "TEST_TICKER", |
|
datatype = LastTradePrice, |
|
timestamp = ts, |
|
value = fromDouble val, |
|
volume = 1 } |
|
|
|
testTwoTicksInDifferentBars :: TestTree |
|
testTwoTicksInDifferentBars = testCase "Two ticks - different bar" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 60) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleTick (tick testTimestamp1 12.00) agg |
|
mbar @?= Nothing |
|
let (mbar', newagg') = handleTick (tick testTimestamp2 14.00) newagg |
|
mbar' @?= Just (Bar "TEST_TICKER" testTimestamp1 12.00 12.00 12.00 12.00 1) |
|
(bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 14.00 14.00 14.00 14.00 1, Bar "TEST_TICKER" testTimestamp1 12.00 12.00 12.00 12.00 1] |
|
where |
|
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 58) |
|
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 61) |
|
tick ts val = Tick { |
|
security = "TEST_TICKER", |
|
datatype = LastTradePrice, |
|
timestamp = ts, |
|
value = fromDouble val, |
|
volume = 1 } |
|
|
|
testOneBar :: TestTree |
|
testOneBar = testCase "One bar" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 3600) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleBar bar agg |
|
mbar @?= Nothing |
|
(bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg)) @?= Just [Bar "TEST_TICKER" testTimestamp 12.00 18.00 10.00 12.00 68] |
|
where |
|
testTimestamp = (UTCTime (fromGregorian 1970 1 1) 60) |
|
bar = Bar { |
|
barSecurity = "TEST_TICKER", |
|
barTimestamp = testTimestamp, |
|
barOpen = fromDouble 12.00, |
|
barHigh = fromDouble 18.00, |
|
barLow = fromDouble 10.00, |
|
barClose = fromDouble 12.00, |
|
barVolume = 68 } |
|
|
|
|
|
testTwoBarsInSameBar :: TestTree |
|
testTwoBarsInSameBar = testCase "Two bars (smaller timeframe) - same bar" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 600) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg |
|
mbar @?= Nothing |
|
let (mbar', newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg |
|
mbar' @?= Nothing |
|
(bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just [Bar "TEST_TICKER" testTimestamp2 12.00 15.00 10.00 12.00 3] |
|
where |
|
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 60) |
|
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 120) |
|
bar ts o h l c v = Bar { |
|
barSecurity = "TEST_TICKER", |
|
barTimestamp = ts, |
|
barOpen = fromDouble o, |
|
barHigh = fromDouble h, |
|
barLow = fromDouble l, |
|
barClose = fromDouble c, |
|
barVolume = v } |
|
|
|
testTwoBarsInSameBarLastBar :: TestTree |
|
testTwoBarsInSameBarLastBar = testCase "Two bars (smaller timeframe) - same bar: last bar is exactly at the end of the bigger tf bar" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 600) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (mbar, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg |
|
mbar @?= Nothing |
|
let (mbar', newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg |
|
let expectedBar = Bar "TEST_TICKER" testTimestamp2 12.00 15.00 10.00 12.00 3 |
|
mbar' @?= Just expectedBar |
|
(head . tail <$> bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg')) @?= Just expectedBar |
|
where |
|
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 560) |
|
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 600) |
|
bar ts o h l c v = Bar { |
|
barSecurity = "TEST_TICKER", |
|
barTimestamp = ts, |
|
barOpen = fromDouble o, |
|
barHigh = fromDouble h, |
|
barLow = fromDouble l, |
|
barClose = fromDouble c, |
|
barVolume = v } |
|
|
|
testNextBarAfterBarClose :: TestTree |
|
testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar after bigger tf bar close" $ do |
|
let series = BarSeries "TEST_TICKER" (Timeframe 600) [] |
|
let agg = mkAggregatorFromBars (M.fromList [("TEST_TICKER", series)]) [(0, 86400)] |
|
let (_, newagg) = handleBar (bar testTimestamp1 12.00 13.00 10.00 11.00 1) agg |
|
let (_, newagg') = handleBar (bar testTimestamp2 12.00 15.00 11.00 12.00 2) newagg |
|
let (_, newagg'') = handleBar (bar testTimestamp3 12.00 15.00 11.00 12.00 12) newagg' |
|
let expectedBar = Bar "TEST_TICKER" testTimestamp3 12.00 15.00 11.00 12.00 12 |
|
(head <$> bsBars <$> (M.lookup "TEST_TICKER" $ bars newagg'')) @?= Just expectedBar |
|
where |
|
testTimestamp1 = (UTCTime (fromGregorian 1970 1 1) 560) |
|
testTimestamp2 = (UTCTime (fromGregorian 1970 1 1) 600) |
|
testTimestamp3 = (UTCTime (fromGregorian 1970 1 1) 660) |
|
bar ts o h l c v = Bar { |
|
barSecurity = "TEST_TICKER", |
|
barTimestamp = ts, |
|
barOpen = fromDouble o, |
|
barHigh = fromDouble h, |
|
barLow = fromDouble l, |
|
barClose = fromDouble c, |
|
barVolume = v }
|
|
|