diff --git a/robocom-zero.cabal b/robocom-zero.cabal index 5170f28..6d2b95a 100644 --- a/robocom-zero.cabal +++ b/robocom-zero.cabal @@ -87,9 +87,11 @@ test-suite robots-test , tasty-hspec , quickcheck-text , quickcheck-instances + , containers ghc-options: -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 other-modules: Test.RoboCom.Indicators + , Test.RoboCom.Positions , Test.RoboCom.Utils source-repository head diff --git a/test/Spec.hs b/test/Spec.hs index e486b37..8f4e70a 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,4 +1,5 @@ import qualified Test.RoboCom.Indicators +import qualified Test.RoboCom.Positions import qualified Test.RoboCom.Utils import Test.Tasty @@ -7,4 +8,7 @@ main :: IO () main = defaultMain $ testGroup "Tests" [unitTests] unitTests :: TestTree -unitTests = testGroup "Properties" [Test.RoboCom.Indicators.unitTests, Test.RoboCom.Utils.unitTests] +unitTests = testGroup "Unit Tests" + [Test.RoboCom.Indicators.unitTests, + Test.RoboCom.Positions.unitTests, + Test.RoboCom.Utils.unitTests] diff --git a/test/Test/RoboCom/Positions.hs b/test/Test/RoboCom/Positions.hs new file mode 100644 index 0000000..2a0b339 --- /dev/null +++ b/test/Test/RoboCom/Positions.hs @@ -0,0 +1,110 @@ + +{-# LANGUAGE OverloadedStrings #-} + +module Test.RoboCom.Positions +( + unitTests +) where + +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 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 + +data TestState = TestState + { + positions :: [Position], + testInt :: Int + } + +defaultState = TestState { + positions = [], + testInt = 0 + } + +data TestConfig = TestConfig + +instance ParamsHasMainTicker TestConfig where + mainTicker _ = "TEST_TICKER" + +instance StateHasPositions TestState where + getPositions = positions + setPositions a p = a { positions = p } + +defaultStrategyEnvironment = StrategyEnvironment + { + seInstanceId = "test_instance", + seAccount = "test_account", + seVolume = 1, + seBars = M.empty, + seLastTimestamp = (UTCTime (fromGregorian 1970 1 1) 0) + } + +unitTests = testGroup "RoboCom.Positions" [ + testEnterAtMarket, + testEnterAtMarketSendsAction, + testEnterAtMarketSubmissionDeadline + ] + +testEnterAtMarket = testCase "enterAtMarket creates position in PositionWaitingOpenSubmission state" $ do + let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element + assertBool "Should be exactly 1 position" ((length . positions) newState == 1) + let pos = head . positions $ newState + assertBool "Should be in PositionWaitingOpenSubmission" (isPositionWaitingOpenSubmission . posState $ pos) + let (PositionWaitingOpenSubmission order) = posState pos + assertBool "Account should be 'test_account'" (orderAccountId order == "test_account") + assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER") + assertBool "Order price should be Market" (orderPrice order == Market) + assertBool "Order quantity should be 1" (orderQuantity order == 1) + assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0) + assertBool "Order operation should be Buy" (orderOperation order == Buy) + assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" "")) + where + element = enterAtMarket "long" Buy + + isPositionWaitingOpenSubmission (PositionWaitingOpenSubmission _) = True + isPositionWaitingOpenSubmission _ = False + +testEnterAtMarketSendsAction = testCase "enterAtMarket sends ActionSubmitOrder" $ do + let (newState, actions, _) = runStrategyElement TestConfig defaultState defaultStrategyEnvironment element + case (L.find isActionOrder actions) of + Just (ActionOrder order) -> do + assertBool "Account should be 'test_account'" (orderAccountId order == "test_account") + assertBool "Security should be 'TEST_TICKER'" (orderSecurity order == "TEST_TICKER") + assertBool "Order price should be Market" (orderPrice order == Market) + assertBool "Order quantity should be 1" (orderQuantity order == 1) + assertBool "Executed order quantity should be 0" (orderExecutedQuantity order == 0) + assertBool "Order operation should be Buy" (orderOperation order == Buy) + assertBool "Order signal id should be correct" (orderSignalId order == (SignalId "test_instance" "long" "")) + Nothing -> assertFailure "Should be exactly 1 ActionOrder" + where + element = enterAtMarket "long" Buy + + isActionOrder (ActionOrder _) = True + isActionOrder _ = False + +testEnterAtMarketSubmissionDeadline = 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) + let pos = head . positions $ newState' + assertBool "Cancelled position" (posState pos == PositionCancelled) + where + element = enterAtMarket "long" Buy + afterDeadline = (UTCTime (fromGregorian 1970 1 1) 100) + tick = Tick { + security = "TEST_TICKER", + datatype = LastTradePrice, + timestamp = afterDeadline, + value = fromDouble 12.00, + volume = 1 }