diff options
Diffstat (limited to 'specs')
| -rw-r--r-- | specs/Mock.hs | 32 | ||||
| -rw-r--r-- | specs/Specs/AppStateUpdateSpec.hs | 9 |
2 files changed, 32 insertions, 9 deletions
diff --git a/specs/Mock.hs b/specs/Mock.hs index db07e6f..5644a06 100644 --- a/specs/Mock.hs +++ b/specs/Mock.hs @@ -12,16 +12,19 @@ import Foreign.C (CInt) import Test.Hspec data Call - = CallPressMouseButton MouseButtonType - | CallMoveMousePosition CInt CInt + = CallDrawCircle Int (CInt, CInt) + | CallDrawLine (CInt, CInt) (CInt, CInt) + | CallDrawText (CInt, CInt) Color Text | CallGetMousePointerPosition | CallHideWindow + | CallMouseButtonDown + | CallMouseButtonUp + | CallMoveMousePosition CInt CInt + | CallPressMouseButton MouseButtonType + | CallSetDrawColor Color | CallShowWindow | CallShutdownApp - | CallDrawLine (CInt, CInt) (CInt, CInt) - | CallDrawText (CInt, CInt) Color Text - | CallDrawCircle Int (CInt, CInt) - | CallSetDrawColor Color + | CallWindowPosition | CallWindowSize deriving (Show, Eq) @@ -45,13 +48,28 @@ instance (MonadIO m) => MonadControl (TestM m) where pressMouseButton btn = registerMockCall $ CallPressMouseButton btn moveMousePointer x y = registerMockCall $ CallMoveMousePosition x y getMousePointerPosition = (42, 42) <$ registerMockCall CallGetMousePointerPosition + mouseButtonDown = registerMockCall CallMouseButtonDown + mouseButtonUp = registerMockCall CallMouseButtonUp + +mockWindowWidth :: CInt +mockWindowWidth = 1920 + +mockWindowHeight :: CInt +mockWindowHeight = 1080 + +mockWindowOffsetX :: CInt +mockWindowOffsetX = 200 + +mockWindowOffsetY :: CInt +mockWindowOffsetY = 100 instance (MonadIO m) => MonadDraw (TestM m) where drawLine p1 p2 = registerMockCall $ CallDrawLine p1 p2 drawText p color text = (0, 0) <$ registerMockCall (CallDrawText p color text) drawCircle radius p = registerMockCall $ CallDrawCircle radius p setDrawColor color = registerMockCall $ CallSetDrawColor color - windowSize = 100 <$ registerMockCall CallWindowSize + windowSize = (mockWindowWidth, mockWindowHeight) <$ registerMockCall CallWindowSize + windowPosition = (mockWindowOffsetX, mockWindowOffsetY) <$ registerMockCall CallWindowPosition instance (MonadIO m) => MonadAppShell (TestM m) where hideWindow = registerMockCall CallHideWindow diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs index 3f8ca47..fd79c95 100644 --- a/specs/Specs/AppStateUpdateSpec.hs +++ b/specs/Specs/AppStateUpdateSpec.hs @@ -2,7 +2,7 @@ module Specs.AppStateUpdateSpec where import Chelleport (initialState, update) import Chelleport.Types -import Chelleport.Utils (uniq) +import Chelleport.Utils (intToCInt, uniq) import Control.Monad (join) import Mock import qualified SDL @@ -90,6 +90,8 @@ test = do context "with action MoveMousePosition" $ do let currentState = defaultState + let rows = intToCInt $ length $ stateGrid currentState + let columns = intToCInt $ length $ head $ stateGrid currentState -- TODO: Test with inline mocked values it "moves mouse pointer to center of cell of given coordinates" $ do @@ -98,7 +100,10 @@ test = do -- [ CallPressMouseButton LeftClick `returns` (1, 2), -- CallHideWindow `returns` () -- ] - mock `shouldHaveCalled` CallMoveMousePosition 25 25 + mock + `shouldHaveCalled` CallMoveMousePosition + (mockWindowOffsetX + mockWindowWidth `div` columns `div` 2) + (mockWindowOffsetY + mockWindowHeight `div` rows `div` 2) it "does not continue or update state" $ do (result, _) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0) |