Few tests for RoboCom.Position

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

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]

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 }