diff options
Diffstat (limited to 'specs')
| -rw-r--r-- | specs/Main.hs | 2 | ||||
| -rw-r--r-- | specs/Mock.hs | 54 | ||||
| -rw-r--r-- | specs/Specs/AppStateUpdateSpec.hs | 20 |
3 files changed, 76 insertions, 0 deletions
diff --git a/specs/Main.hs b/specs/Main.hs index 335407f..5253fb9 100644 --- a/specs/Main.hs +++ b/specs/Main.hs @@ -1,8 +1,10 @@ module Main (main) where +import qualified Specs.AppStateUpdateSpec import qualified Specs.KeySequenceSpec import Test.Hspec (hspec) main :: IO () main = hspec $ do Specs.KeySequenceSpec.test + Specs.AppStateUpdateSpec.test diff --git a/specs/Mock.hs b/specs/Mock.hs new file mode 100644 index 0000000..7dad452 --- /dev/null +++ b/specs/Mock.hs @@ -0,0 +1,54 @@ +module Mock where + +import Chelleport.AppShell (MonadAppShell (..)) +import Chelleport.Control (MonadControl (..)) +import Chelleport.Draw (MonadDraw (..)) +import Chelleport.Types +import Control.Monad (void) +import Control.Monad.IO.Class (MonadIO) +import Control.Monad.State (MonadState (get, state), StateT (runStateT), gets) +import Data.Text (Text) +import Foreign.C (CInt) + +data Call + = CallPressMouseButton MouseButtonType + | CallMoveMousePosition CInt CInt + | CallGetMousePointerPosition + | CallHideWindow + | CallShowWindow + | CallShutdownApp + | CallDrawLine (CInt, CInt) (CInt, CInt) + | CallDrawText (CInt, CInt) Color Text + | CallDrawCircle Int (CInt, CInt) + | CallSetDrawColor Color + | CallWindowSize + deriving (Show, Eq) + +newtype MockCalls = MockCalls {calls :: [Call]} + +registerMockCall :: (MonadState MockCalls m) => Call -> m () +registerMockCall call = + void $ state (\mock -> ((), MockCalls {calls = calls mock ++ [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) + +instance (MonadIO m) => MonadControl (TestM m) where + pressMouseButton btn = registerMockCall $ CallPressMouseButton btn + moveMousePointer x y = registerMockCall $ CallMoveMousePosition x y + getMousePointerPosition = (0, 0) <$ registerMockCall CallGetMousePointerPosition + +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 = 0 <$ registerMockCall CallWindowSize + +instance (MonadIO m) => MonadAppShell (TestM m) where + hideWindow = registerMockCall CallHideWindow + showWindow = registerMockCall CallShowWindow + shutdownApp = registerMockCall CallShutdownApp diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs new file mode 100644 index 0000000..0b5cac0 --- /dev/null +++ b/specs/Specs/AppStateUpdateSpec.hs @@ -0,0 +1,20 @@ +module Specs.AppStateUpdateSpec where + +import Chelleport (update) +import Chelleport.Types +import Mock +import Test.Hspec + +test = do + describe "#update" $ do + context "with action TriggerLeftClick" $ do + let state = State {stateKeySequence = [], stateIsShiftPressed = False, stateIsMatched = False, stateGrid = []} + + it "hides window and triggers left clicks" $ do + (_, mock) <- runWithMocks $ update state TriggerLeftClick + calls mock `shouldContain` [CallHideWindow, CallPressMouseButton LeftClick] + + it "continues with action ShutdownApp without updating state" $ do + ((state, action), mock) <- runWithMocks $ update state TriggerLeftClick + action `shouldBe` Just ShutdownApp + state `shouldBe` state |
