{-# 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 }