Switched from quickcheck to hedgehog

robocom-zero.cabal

@@ -79,11 +79,11 @@ test-suite robots-test
                      , libatrade
                      , time
                      , text
+                     , hedgehog
                      , tasty
                      , tasty-hunit
                      , tasty-golden
-                     , tasty-smallcheck
+                     , tasty-hedgehog
-                     , tasty-quickcheck
                      , 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

test/Test/BarAggregator.hs

@@ -16,12 +16,13 @@ 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 ->
+prop_allTicksInOneBar = testProperty "All ticks in one bar" $ property $ do
-  QC.forAll (QC.listOf1 (genTick "TEST_TICKER" baseTime timeframe)) $ \ticks ->
+  tf <- forAll $ Gen.integral (Range.constant 1 86400)
-        let ticks' = sortOn timestamp ticks in
+  ticks <- forAll $ Gen.list (Range.linear 1 100) (genTick "TEST_TICKER" baseTime tf)
-          let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" timeframe) in
+  let ticks' = sortOn timestamp ticks
-            null newbars &&
+  let (newbars, agg) = handleTicks ticks' (mkAggregator "TEST_TICKER" tf)
-            ((barHigh <$> currentBar "TEST_TICKER" agg) == Just (maximum $ value <$> ticks)) &&
+  (barHigh <$> currentBar "TEST_TICKER" agg) === Just (maximum $ value <$> ticks)
-            ((barLow <$> currentBar "TEST_TICKER" agg) == Just (minimum $ value <$> ticks)) &&
+  (barLow <$> currentBar "TEST_TICKER" agg) === Just (minimum $ value <$> ticks)
-            ((barOpen <$> currentBar "TEST_TICKER" agg) == (value <$> headMay ticks')) &&
+  (barOpen <$> currentBar "TEST_TICKER" agg) === (value <$> headMay ticks')
-            ((barClose <$> currentBar "TEST_TICKER" agg) == (value <$> lastMay ticks')) &&
+  (barClose <$> currentBar "TEST_TICKER" agg) === (value <$> lastMay ticks')
-            ((barVolume <$> currentBar "TEST_TICKER" agg) == Just (sum $ volume <$> 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)
+      difftime <- fromRational . toRational . picosecondsToDiffTime <$> Gen.integral (Range.linear 0 (truncate 1e12 * tf))
-      val <- arbitrary
+      val <- fromDouble <$> Gen.double (Range.exponentialFloat 0.00001 100)
-      vol <- arbitrary `suchThat` (> 0)
+      vol <- Gen.integral (Range.exponential 1 100)
-      return $ Tick tickerId LastTradePrice (difftime `addUTCTime` baseTime) val vol
+      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
+

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

test/Test/RoboCom/Positions.hs

@@ -8,15 +8,13 @@ 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.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

test/Test/RoboCom/Utils.hs

@@ -7,8 +7,6 @@ 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