Generate mock call type from typeclasses th

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