From 32a75e8c4728ff832921e10270daa65115f5cd25 Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Mon, 24 Jun 2019 16:18:32 +0700 Subject: [PATCH] Switched from quickcheck to hedgehog --- robocom-zero.cabal | 5 +-- test/Test/BarAggregator.hs | 79 ++++++++++++++++++++++++--------- test/Test/RoboCom/Indicators.hs | 2 - test/Test/RoboCom/Positions.hs | 22 +++++---- test/Test/RoboCom/Utils.hs | 4 +- 5 files changed, 71 insertions(+), 41 deletions(-) diff --git a/robocom-zero.cabal b/robocom-zero.cabal index 83a275b..1b56a6a 100644 --- a/robocom-zero.cabal +++ b/robocom-zero.cabal @@ -79,11 +79,11 @@ test-suite robots-test , libatrade , time , text + , hedgehog , tasty , tasty-hunit , tasty-golden - , tasty-smallcheck - , tasty-quickcheck + , tasty-hedgehog , tasty-hspec , quickcheck-text , quickcheck-instances @@ -95,7 +95,6 @@ test-suite robots-test , Test.RoboCom.Positions , Test.RoboCom.Utils , Test.BarAggregator - , ArbitraryInstances source-repository head type: git diff --git a/test/Test/BarAggregator.hs b/test/Test/BarAggregator.hs index d9269d0..0e8edde 100644 --- a/test/Test/BarAggregator.hs +++ b/test/Test/BarAggregator.hs @@ -10,18 +10,19 @@ import ATrade.BarAggregator import ATrade.RoboCom.Types import ATrade.Types import Data.List -import qualified Data.Map.Strict as M -import qualified Data.Text as T +import qualified Data.Map.Strict as M +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock import Safe +import Hedgehog as HH +import qualified Hedgehog.Gen as Gen +import qualified Hedgehog.Range as Range + import Test.Tasty +import Test.Tasty.Hedgehog import Test.Tasty.HUnit -import Test.Tasty.QuickCheck as QC -import Test.Tasty.SmallCheck as SC - -import ArbitraryInstances unitTests = testGroup "BarAggregator" [ @@ -36,7 +37,8 @@ unitTests = testGroup "BarAggregator" [ ] properties = testGroup "BarAggregator" [ - prop_allTicksInOneBar + prop_allTicksInOneBar, + prop_ticksInTwoBars ] testUnknownBarSeries :: TestTree @@ -193,26 +195,61 @@ testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar a barVolume = v } prop_allTicksInOneBar :: TestTree -prop_allTicksInOneBar = QC.testProperty "All ticks in one bar" $ QC.forAll (QC.choose (1, 86400)) $ \timeframe -> - QC.forAll (QC.listOf1 (genTick "TEST_TICKER" baseTime timeframe)) $ \ticks -> - let ticks' = sortOn timestamp ticks in - let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" timeframe) in - null newbars && - ((barHigh <$> currentBar "TEST_TICKER" agg) == Just (maximum $ value <$> ticks)) && - ((barLow <$> currentBar "TEST_TICKER" agg) == Just (minimum $ value <$> ticks)) && - ((barOpen <$> currentBar "TEST_TICKER" agg) == (value <$> headMay ticks')) && - ((barClose <$> currentBar "TEST_TICKER" agg) == (value <$> lastMay ticks')) && - ((barVolume <$> currentBar "TEST_TICKER" agg) == Just (sum $ volume <$> ticks)) +prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do + tf <- forAll $ Gen.integral (Range.constant 1 86400) + ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf) + let ticks' = sortOn timestamp ticks + let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf) + (barHigh <$> currentBar "TEST_TICKER" agg) === Just (maximum $ value <$> ticks) + (barLow <$> currentBar "TEST_TICKER" agg) === Just (minimum $ value <$> ticks) + (barOpen <$> currentBar "TEST_TICKER" agg) === (value <$> headMay ticks') + (barClose <$> currentBar "TEST_TICKER" agg) === (value <$> lastMay ticks') + (barVolume <$> currentBar "TEST_TICKER" agg) === Just (sum $ volume <$> ticks) + HH.assert $ null newbars + where genTick :: T.Text -> UTCTime -> Integer -> Gen Tick genTick tickerId base tf = do - difftime <- fromRational . toRational . picosecondsToDiffTime <$> choose (0, truncate 1e12 * tf) - val <- arbitrary - vol <- arbitrary `suchThat` (> 0) - return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol + difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * tf)) + val <- fromDouble <$> Gen.double (Range.exponentialFloat 0.00001 100) + vol <- Gen.integral (Range.exponential 1 100) + return $ Tick tickerId LastTradePrice (difftime `addUTCTime` base) val vol mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(0, 86400)] currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg)) baseTime = UTCTime (fromGregorian 1970 1 1) 0 +prop_ticksInTwoBars :: TestTree +prop_ticksInTwoBars = testProperty "Ticks in one bar, then in next bar" $ property $ do + tf <- forAll $ Gen.integral (Range.constant 1 86400) + ticks1 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" (baseTime 0) tf) + ticks2 <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" (baseTime $ secondsToDiffTime tf) tf) + let ticks1' = sortOn timestamp ticks1 + let ticks2' = sortOn timestamp ticks2 + let (_, agg) = handleTicks ticks1' (mkAggregator "TEST_TICKER" tf) + let ([newbar], agg') = handleTicks ticks2' agg + barSecurity newbar === "TEST_TICKER" + (barHigh newbar) === (maximum $ value <$> ticks1) + (barLow newbar) === (minimum $ value <$> ticks1) + (barOpen newbar) === (value . head $ ticks1') + (barClose newbar) === (value . last $ ticks1') + (barVolume newbar) === (sum $ volume <$> ticks1) + (barHigh <$> currentBar "TEST_TICKER" agg') === Just (maximum $ value <$> ticks2) + (barLow <$> currentBar "TEST_TICKER" agg') === Just (minimum $ value <$> ticks2) + (barOpen <$> currentBar "TEST_TICKER" agg') === (value <$> headMay ticks2') + (barClose <$> currentBar "TEST_TICKER" agg') === (value <$> lastMay ticks2') + (barVolume <$> currentBar "TEST_TICKER" agg') === Just (sum $ volume <$> ticks2) + + where + genTick :: T.Text -> UTCTime -> Integer -> Gen Tick + genTick tickerId base tf = do + difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * tf)) + val <- fromDouble <$> Gen.double (Range.exponentialFloat 0.00001 100) + vol <- Gen.integral (Range.exponential 1 100) + return $ Tick tickerId LastTradePrice (difftime `addUTCTime` base) val vol + mkAggregator tickerId tf = mkAggregatorFromBars (M.singleton tickerId (BarSeries tickerId (Timeframe tf) [])) [(0, 86400)] + + currentBar tickerId agg = headMay =<< (bsBars <$> M.lookup tickerId (bars agg)) + baseTime offset = UTCTime (fromGregorian 1970 1 1) offset + diff --git a/test/Test/RoboCom/Indicators.hs b/test/Test/RoboCom/Indicators.hs index 5ba2d86..5f7c2c7 100644 --- a/test/Test/RoboCom/Indicators.hs +++ b/test/Test/RoboCom/Indicators.hs @@ -7,8 +7,6 @@ module Test.RoboCom.Indicators import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck as QC -import Test.Tasty.SmallCheck as SC import ATrade.Types import qualified Data.Text as T diff --git a/test/Test/RoboCom/Positions.hs b/test/Test/RoboCom/Positions.hs index afd4b3e..cad9821 100644 --- a/test/Test/RoboCom/Positions.hs +++ b/test/Test/RoboCom/Positions.hs @@ -8,24 +8,22 @@ module Test.RoboCom.Positions import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck as QC -import Test.Tasty.SmallCheck as SC import ATrade.Types -import qualified Data.Text as T -import qualified Data.Map.Strict as M +import qualified Data.List as L +import qualified Data.Map.Strict as M +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock -import qualified Data.List as L import ATrade.RoboCom.Monad import ATrade.RoboCom.Positions -import ATrade.RoboCom.Types +import ATrade.RoboCom.Types data TestState = TestState { positions :: [Position], - testInt :: Int + testInt :: Int } defaultState = TestState { @@ -56,7 +54,7 @@ unitTests = testGroup "RoboCom.Positions" [ testEnterAtMarketSendsAction, testDefaultHandlerSubmissionDeadline, testDefaultHandlerAfterSubmissionPositionIsWaitingOpen, - testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 + testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 ] testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do @@ -76,7 +74,7 @@ testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingO element = enterAtMarket "long" Buy isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True - isPositionWaitingOpenSubmission _ = False + isPositionWaitingOpenSubmission _ = False testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element @@ -94,8 +92,8 @@ testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" element = enterAtMarket "long" Buy isActionOrder (ActionOrder _) = True - isActionOrder _ = False - + isActionOrder _ = False + testDefaultHandlerSubmissionDeadline = testCase "defaultHandler after submission deadline marks position as cancelled" $ do let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element let (newState', actions', _) = runStrategyElement TestConfig newState defaultStrategyEnvironment { seLastTimestamp = afterDeadline } $ defaultHandler (NewTick tick) @@ -164,4 +162,4 @@ testDefaultHandlerPositionWaitingOpenOrderOpenExecuted1 = testCase "defaultHandl tradeSignalId = SignalId "test_instance" "long" "" } - + diff --git a/test/Test/RoboCom/Utils.hs b/test/Test/RoboCom/Utils.hs index 7ef7a52..1581c75 100644 --- a/test/Test/RoboCom/Utils.hs +++ b/test/Test/RoboCom/Utils.hs @@ -7,11 +7,9 @@ module Test.RoboCom.Utils import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck as QC -import Test.Tasty.SmallCheck as SC import ATrade.Types -import qualified Data.Text as T +import qualified Data.Text as T import Data.Time.Calendar import Data.Time.Clock