diff options
Diffstat (limited to 'specs/TestUtils.hs')
| -rw-r--r-- | specs/TestUtils.hs | 65 |
1 files changed, 65 insertions, 0 deletions
diff --git a/specs/TestUtils.hs b/specs/TestUtils.hs new file mode 100644 index 0000000..c98899d --- /dev/null +++ b/specs/TestUtils.hs @@ -0,0 +1,65 @@ +module TestUtils where + +import Chelleport.AppShell (MonadAppShell (..)) +import Chelleport.Control (MonadControl (..)) +import Chelleport.Draw (MonadDraw (..)) +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.State (MonadState (state), StateT (runStateT)) +import qualified Data.Text as Text +import Foreign.C (CInt) +import Mock +import Test.Hspec + +$(generateMock [''MonadDraw, ''MonadControl, ''MonadAppShell]) + +newtype MockCalls = MockCalls {calls :: [Call]} + deriving (Show) + +shouldHaveCalled :: (HasCallStack) => MockCalls -> Call -> Expectation +shouldHaveCalled mock call = calls mock `shouldContain` [call] + +runWithMocks :: (MonadIO m) => TestM m a -> m (a, MockCalls) +runWithMocks action = runStateT (runTestM action) (MockCalls []) + +newtype TestM m a = TestM {runTestM :: StateT MockCalls m a} + deriving (Functor, Applicative, Monad, MonadIO, MonadState MockCalls) + +mockWindowWidth :: CInt +mockWindowWidth = 1920 + +mockWindowHeight :: CInt +mockWindowHeight = 1080 + +mockWindowOffsetX :: CInt +mockWindowOffsetX = 200 + +mockWindowOffsetY :: CInt +mockWindowOffsetY = 100 + +mockTextWidth :: Int +mockTextWidth = 10 + +registerMockCall :: (MonadState MockCalls m) => Call -> m () +registerMockCall call = + void $ state (\mock -> ((), MockCalls {calls = calls mock ++ [call]})) + +instance (MonadIO m) => MonadControl (TestM m) where + clickMouseButton btn = registerMockCall $ Mock_clickMouseButton btn + moveMousePointer x y = registerMockCall $ Mock_moveMousePointer x y + getMousePointerPosition = (42, 42) <$ registerMockCall Mock_getMousePointerPosition + pressMouseButton = registerMockCall Mock_pressMouseButton + releaseMouseButton = registerMockCall Mock_releaseMouseButton + +instance (MonadIO m) => MonadDraw (TestM m) where + drawLine p1 p2 = registerMockCall $ Mock_drawLine p1 p2 + drawText p color text = (fromIntegral $ mockTextWidth * Text.length text, 0) <$ registerMockCall (Mock_drawText p color text) + drawCircle radius p = registerMockCall $ Mock_drawCircle radius p + setDrawColor color = registerMockCall $ Mock_setDrawColor color + windowSize = (mockWindowWidth, mockWindowHeight) <$ registerMockCall Mock_windowSize + windowPosition = (mockWindowOffsetX, mockWindowOffsetY) <$ registerMockCall Mock_windowPosition + +instance (MonadIO m) => MonadAppShell (TestM m) where + hideWindow = registerMockCall Mock_hideWindow + showWindow = registerMockCall Mock_showWindow + shutdownApp = registerMockCall Mock_shutdownApp |
