From cb6230ecd523e90e38b98b31b1efe8b79a91ca1b Mon Sep 17 00:00:00 2001 From: Denis Tereshkin Date: Wed, 19 Jun 2019 13:43:58 +0700 Subject: [PATCH] More tests for BarAggregator --- robocom-zero.cabal | 2 + src/ATrade/BarAggregator.hs | 9 +++ src/ATrade/Driver/Real.hs | 4 ++ test/ArbitraryInstances.hs | 111 ++++++++++++++++++++++++++++++++++++ test/Spec.hs | 7 ++- test/Test/BarAggregator.hs | 37 +++++++++++- 6 files changed, 168 insertions(+), 2 deletions(-) create mode 100644 test/ArbitraryInstances.hs diff --git a/robocom-zero.cabal b/robocom-zero.cabal index 161795b..83a275b 100644 --- a/robocom-zero.cabal +++ b/robocom-zero.cabal @@ -88,12 +88,14 @@ test-suite robots-test , quickcheck-text , quickcheck-instances , containers + , safe ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 other-modules: Test.RoboCom.Indicators , Test.RoboCom.Positions , Test.RoboCom.Utils , Test.BarAggregator + , ArbitraryInstances source-repository head type: git diff --git a/src/ATrade/BarAggregator.hs b/src/ATrade/BarAggregator.hs index 2daf36e..226639b 100644 --- a/src/ATrade/BarAggregator.hs +++ b/src/ATrade/BarAggregator.hs @@ -17,6 +17,7 @@ module ATrade.BarAggregator ( lLastTicks, BarAggregator(..), mkAggregatorFromBars, + handleTicks, handleTick, handleBar, hmsToDiffTime @@ -54,6 +55,14 @@ lLastTicks = lens lastTicks (\s b -> s { lastTicks = b }) hmsToDiffTime :: Int -> Int -> Int -> DiffTime hmsToDiffTime h m s = secondsToDiffTime $ toInteger $ h * 3600 + m * 60 + s +handleTicks :: [Tick] -> BarAggregator -> ([Bar], BarAggregator) +handleTicks ticks aggregator = foldl f ([], aggregator) ticks + where + f (bars', agg) tick = let (mbar, agg') = handleTick tick agg in + case mbar of + Just bar -> (bar : bars', agg') + _ -> (bars', agg') + -- | main logic of bar aggregator handleTick :: Tick -> BarAggregator -> (Maybe Bar, BarAggregator) handleTick tick = runState $ do diff --git a/src/ATrade/Driver/Real.hs b/src/ATrade/Driver/Real.hs index ebfbc8f..0da5eca 100644 --- a/src/ATrade/Driver/Real.hs +++ b/src/ATrade/Driver/Real.hs @@ -225,6 +225,7 @@ robotMain dataDownloadDelta defaultState initCallback callback = do loadStrategyTimers params = case redisSocket params of Nothing -> return [] Just sock -> do +#ifdef linux_HOST_OS conn <- checkedConnect $ defaultConnectInfo { connectPort = UnixSocket sock } res <- runRedis conn $ get (encodeUtf8 $ T.pack $ instanceId params ++ "timers") case res of @@ -240,6 +241,9 @@ robotMain dataDownloadDelta defaultState initCallback callback = do Nothing -> do warningM "main" "Unable to load state" return [] +#else + error "Not implemented" +#endif loadStrategyState params = case redisSocket params of diff --git a/test/ArbitraryInstances.hs b/test/ArbitraryInstances.hs new file mode 100644 index 0000000..e732f7d --- /dev/null +++ b/test/ArbitraryInstances.hs @@ -0,0 +1,111 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module ArbitraryInstances ( +) where + + +import Test.QuickCheck.Instances () +import Test.Tasty.QuickCheck as QC + +import ATrade.Price as P +import ATrade.Types +import qualified Data.Text as T + +import Data.Time.Calendar +import Data.Time.Clock + +notTooBig :: (Num a, Ord a) => a -> Bool +notTooBig x = abs x < 100000000 + +arbitraryTickerId = arbitrary `suchThat` (\t -> T.all (/= ':') t && t /= "") + +instance Arbitrary Tick where + arbitrary = Tick <$> + arbitraryTickerId <*> + arbitrary <*> + arbitraryTimestamp <*> + arbitrary <*> + arbitrary + +arbitraryTimestamp = do + y <- choose (1970, 2050) + m <- choose (1, 12) + d <- choose (1, 31) + + sec <- secondsToDiffTime <$> choose (0, 86399) + + return $ UTCTime (fromGregorian y m d) sec + +instance Arbitrary DataType where + arbitrary = toEnum <$> choose (1, 10) + +instance Arbitrary SignalId where + arbitrary = SignalId <$> arbitrary <*> arbitrary <*> arbitrary + +instance Arbitrary OrderPrice where + arbitrary = do + v <- choose (1, 4) :: Gen Int + if | v == 1 -> return Market + | v == 2 -> Limit <$> arbitrary `suchThat` notTooBig + | v == 3 -> Stop <$> arbitrary `suchThat` notTooBig <*> arbitrary `suchThat` notTooBig + | v == 4 -> StopMarket <$> arbitrary `suchThat` notTooBig + | otherwise -> fail "Invalid case" + +instance Arbitrary Operation where + arbitrary = elements [Buy, Sell] + +instance Arbitrary OrderState where + arbitrary = elements [Unsubmitted, + Submitted, + PartiallyExecuted, + Executed, + Cancelled, + Rejected, + OrderError ] + +instance Arbitrary Order where + arbitrary = Order <$> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary + +instance Arbitrary Trade where + arbitrary = Trade <$> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary + +instance Arbitrary P.Price where + arbitrary = P.Price <$> (arbitrary `suchThat` (\p -> abs p < 1000000000 * 10000000)) + +instance Arbitrary Bar where + arbitrary = Bar <$> + arbitraryTickerId <*> + arbitraryTimestamp <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary <*> + arbitrary `suchThat` (> 0) + +instance Arbitrary BarTimeframe where + arbitrary = BarTimeframe <$> (arbitrary `suchThat` (\p -> p > 0 && p < 86400 * 365)) + + diff --git a/test/Spec.hs b/test/Spec.hs index cc92b6b..364f9e6 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -6,7 +6,7 @@ import qualified Test.RoboCom.Utils import Test.Tasty main :: IO () -main = defaultMain $ testGroup "Tests" [unitTests] +main = defaultMain $ testGroup "Tests" [unitTests, properties] unitTests :: TestTree unitTests = testGroup "Unit Tests" @@ -14,3 +14,8 @@ unitTests = testGroup "Unit Tests" Test.RoboCom.Positions.unitTests, Test.RoboCom.Utils.unitTests, Test.BarAggregator.unitTests ] + +properties :: TestTree +properties = testGroup "Properties" + [Test.BarAggregator.properties ] + diff --git a/test/Test/BarAggregator.hs b/test/Test/BarAggregator.hs index f1f1a04..d9269d0 100644 --- a/test/Test/BarAggregator.hs +++ b/test/Test/BarAggregator.hs @@ -2,22 +2,28 @@ module Test.BarAggregator ( - unitTests + unitTests, + properties ) where 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 Data.Time.Calendar import Data.Time.Clock +import Safe import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC import Test.Tasty.SmallCheck as SC +import ArbitraryInstances + + unitTests = testGroup "BarAggregator" [ testUnknownBarSeries , testOneTick @@ -29,6 +35,10 @@ unitTests = testGroup "BarAggregator" [ , testNextBarAfterBarClose ] +properties = testGroup "BarAggregator" [ + prop_allTicksInOneBar + ] + testUnknownBarSeries :: TestTree testUnknownBarSeries = testCase "Tick with unknown ticker id" $ do let agg = BarAggregator M.empty M.empty [(0, 86400)] @@ -181,3 +191,28 @@ testNextBarAfterBarClose = testCase "Three bars (smaller timeframe) - next bar a barLow = fromDouble l, barClose = fromDouble c, 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)) + 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 + 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 + +