Add tests for state management

5 files changed, 187 insertions, 9 deletions

diff --git a/specs/Main.hs b/specs/Main.hs
index 5253fb9..4308669 100644
--- a/specs/Main.hs
+++ b/specs/Main.hs
@@ -1,5 +1,6 @@
 module Main (main) where
 
+import qualified Specs.AppEventSpec
 import qualified Specs.AppStateUpdateSpec
 import qualified Specs.KeySequenceSpec
 import Test.Hspec (hspec)
@@ -8,3 +9,4 @@ main :: IO ()
 main = hspec $ do
   Specs.KeySequenceSpec.test
   Specs.AppStateUpdateSpec.test
+  Specs.AppEventSpec.test
diff --git a/specs/Mock.hs b/specs/Mock.hs
index 7dad452..db07e6f 100644
--- a/specs/Mock.hs
+++ b/specs/Mock.hs
@@ -6,9 +6,10 @@ 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 Control.Monad.State (MonadState (state), StateT (runStateT))
 import Data.Text (Text)
 import Foreign.C (CInt)
+import Test.Hspec
 
 data Call
   = CallPressMouseButton MouseButtonType
@@ -25,11 +26,15 @@ data Call
   deriving (Show, Eq)
 
 newtype MockCalls = MockCalls {calls :: [Call]}
+  deriving (Show)
 
 registerMockCall :: (MonadState MockCalls m) => Call -> m ()
 registerMockCall call =
   void $ state (\mock -> ((), MockCalls {calls = calls mock ++ [call]}))
 
+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 [])
 
@@ -39,14 +44,14 @@ newtype TestM m a = TestM {runTestM :: StateT MockCalls m a}
 instance (MonadIO m) => MonadControl (TestM m) where
   pressMouseButton btn = registerMockCall $ CallPressMouseButton btn
   moveMousePointer x y = registerMockCall $ CallMoveMousePosition x y
-  getMousePointerPosition = (0, 0) <$ registerMockCall CallGetMousePointerPosition
+  getMousePointerPosition = (42, 42) <$ 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
+  windowSize = 100 <$ registerMockCall CallWindowSize
 
 instance (MonadIO m) => MonadAppShell (TestM m) where
   hideWindow = registerMockCall CallHideWindow
diff --git a/specs/Specs/AppEventSpec.hs b/specs/Specs/AppEventSpec.hs
new file mode 100644
index 0000000..9ac9d4c
--- /dev/null
+++ b/specs/Specs/AppEventSpec.hs
@@ -0,0 +1,68 @@
+module Specs.AppEventSpec where
+
+import Chelleport (eventHandler)
+import Chelleport.Types
+import qualified SDL
+import SDL.Internal.Numbered (FromNumber (fromNumber))
+import Test.Hspec
+import Unsafe.Coerce (unsafeCoerce)
+
+test :: SpecWith ()
+test = do
+  describe "#eventHandler" $ do
+    let mkEvent payload = SDL.Event {SDL.eventTimestamp = 0, SDL.eventPayload = payload}
+    let mkKeyboardEvent key motion =
+          mkEvent $
+            SDL.KeyboardEvent $
+              SDL.KeyboardEventData
+                { SDL.keyboardEventWindow = unsafeCoerce (0 :: Integer),
+                  SDL.keyboardEventRepeat = False,
+                  SDL.keyboardEventKeysym =
+                    SDL.Keysym
+                      { SDL.keysymScancode = SDL.Scancode0,
+                        SDL.keysymModifier = fromNumber 0,
+                        SDL.keysymKeycode = key
+                      },
+                  SDL.keyboardEventKeyMotion = motion
+                }
+
+    context "when window quit event is triggered" $ do
+      it "shuts down app" $ do
+        let action = eventHandler $ mkEvent SDL.QuitEvent
+        action `shouldBe` Just ShutdownApp
+
+    context "when q key is pressed" $ do
+      it "shuts down app" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeQ SDL.Pressed
+        action `shouldBe` Just ShutdownApp
+
+    context "when escape key is pressed" $ do
+      it "shuts down app" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeEscape SDL.Pressed
+        action `shouldBe` Just ShutdownApp
+
+    context "when space key is pressed" $ do
+      it "triggers left mouse button click" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeSpace SDL.Pressed
+        action `shouldBe` Just TriggerLeftClick
+
+    context "when tab key is pressed" $ do
+      it "resets key state" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeTab SDL.Pressed
+        action `shouldBe` Just ResetKeys
+
+    context "when an alphanumeric key (excluding Q) is pressed" $ do
+      it "calls key input handler" $ do
+        eventHandler (mkKeyboardEvent SDL.KeycodeA SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.KeycodeA)
+        eventHandler (mkKeyboardEvent SDL.KeycodeB SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.KeycodeB)
+        eventHandler (mkKeyboardEvent SDL.Keycode9 SDL.Pressed) `shouldBe` Just (HandleKeyInput SDL.Keycode9)
+
+    context "when shift key is pressed" $ do
+      it "enables shift" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Pressed
+        action `shouldBe` Just (UpdateShiftState True)
+
+    context "when shift key is released" $ do
+      it "disabled shift" $ do
+        let action = eventHandler $ mkKeyboardEvent SDL.KeycodeRShift SDL.Released
+        action `shouldBe` Just (UpdateShiftState False)
diff --git a/specs/Specs/AppStateUpdateSpec.hs b/specs/Specs/AppStateUpdateSpec.hs
index 0b5cac0..169cd8b 100644
--- a/specs/Specs/AppStateUpdateSpec.hs
+++ b/specs/Specs/AppStateUpdateSpec.hs
@@ -1,20 +1,123 @@
 module Specs.AppStateUpdateSpec where
 
-import Chelleport (update)
+import Chelleport (initialState, update)
 import Chelleport.Types
 import Mock
+import qualified SDL
 import Test.Hspec
 
+test :: SpecWith ()
 test = do
+  describe "#initialState" $ do
+    it "returns the initial state of the app" $ do
+      (initState, _) <- runWithMocks initialState
+      length (stateGrid initState) `shouldBe` 9
+      stateGrid initState `shouldSatisfy` all ((== 16) . length)
+      stateGrid initState `shouldSatisfy` all (all ((== 2) . length))
+      stateKeySequence initState `shouldBe` []
+      stateIsMatched initState `shouldBe` False
+      stateIsShiftPressed initState `shouldBe` False
+
   describe "#update" $ do
+    let defaultState =
+          State
+            { stateKeySequence = [],
+              stateIsShiftPressed = False,
+              stateIsMatched = False,
+              stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]
+            }
+
+    context "with action HandleKeyInput" $ do
+      context "when there are no matches" $ do
+        let currentState = defaultState {stateKeySequence = "D"}
+
+        context "when input key sequence has matching values in grid" $ do
+          it "does not update" $ do
+            ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeZ
+            action `shouldBe` Nothing
+            nextState `shouldBe` currentState
+
+        context "when input key sequence does not have matching values in grid" $ do
+          it "adds key to key sequence" $ do
+            ((nextState, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeE
+            action `shouldBe` Nothing
+            nextState `shouldBe` currentState {stateKeySequence = "DE"}
+
+      context "when there is a matches" $ do
+        let currentState = defaultState {stateKeySequence = "DE"}
+
+        context "when input key sequence does not have matching values in grid" $ do
+          it "adds key to key sequence and enables isMatched" $ do
+            ((nextState, _), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF
+            nextState `shouldBe` currentState {stateKeySequence = "DEF", stateIsMatched = True}
+
+          it "continues with MoveMousePosition action" $ do
+            ((_, action), _) <- runWithMocks $ update currentState $ HandleKeyInput SDL.KeycodeF
+            action `shouldBe` Just (MoveMousePosition (0, 1))
+
     context "with action TriggerLeftClick" $ do
-      let state = State {stateKeySequence = [], stateIsShiftPressed = False, stateIsMatched = False, stateGrid = []}
+      let currentState = defaultState
 
       it "hides window and triggers left clicks" $ do
-        (_, mock) <- runWithMocks $ update state TriggerLeftClick
+        (_, mock) <- runWithMocks $ update currentState TriggerLeftClick
         calls mock `shouldContain` [CallHideWindow, CallPressMouseButton LeftClick]
 
       it "continues with action ShutdownApp without updating state" $ do
-        ((state, action), mock) <- runWithMocks $ update state TriggerLeftClick
+        ((nextState, action), _) <- runWithMocks $ update currentState TriggerLeftClick
+        -- handleMocks
+        --   [ CallPressMouseButton LeftClick `returns` (1, 2),
+        --     CallHideWindow `returns` ()
+        --   ]
         action `shouldBe` Just ShutdownApp
-        state `shouldBe` state
+        nextState `shouldBe` currentState
+
+    context "with action MoveMousePosition" $ do
+      let currentState = defaultState
+
+      -- TODO: Test with inline mocked values
+      it "moves mouse pointer to center of cell of given coordinates" $ do
+        (_, mock) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0)
+        mock `shouldHaveCalled` CallMoveMousePosition 25 25
+
+      it "does not continue or update state" $ do
+        (result, _) <- runWithMocks $ update currentState $ MoveMousePosition (0, 0)
+        result `shouldBe` (currentState, Nothing)
+
+    context "with action ResetKeys" $ do
+      let currentState = defaultState
+
+      it "resets state without any action" $ do
+        ((nextState, action), _) <- runWithMocks $ update currentState ResetKeys
+        action `shouldBe` Nothing
+        nextState `shouldBe` currentState {stateKeySequence = [], stateIsMatched = False}
+
+    context "with action IncrementMouseCursor" $ do
+      let currentState = defaultState
+
+      -- TODO: Test with inline mocked values
+      it "hides window and triggers left clicks" $ do
+        (_, mock) <- runWithMocks $ update currentState $ IncrementMouseCursor (10, -20)
+        mock `shouldHaveCalled` CallMoveMousePosition 52 22
+
+      it "does not continue or update state" $ do
+        (result, _) <- runWithMocks $ update currentState $ IncrementMouseCursor (0, 0)
+        result `shouldBe` (currentState, Nothing)
+
+    context "with action ShutdownApp" $ do
+      let currentState = defaultState
+
+      it "hides window and triggers left clicks" $ do
+        (_, mock) <- runWithMocks $ update currentState ShutdownApp
+        mock `shouldHaveCalled` CallShutdownApp
+
+      it "does not continue or update state" $ do
+        (result, _) <- runWithMocks $ update currentState ShutdownApp
+        result `shouldBe` (currentState, Nothing)
+
+    context "with action UpdateShiftState" $ do
+      let currentState = defaultState
+
+      it "updates shift state without any action" $ do
+        ((nextState, action), _) <- runWithMocks $ update currentState $ UpdateShiftState True
+        action `shouldBe` Nothing
+        nextState `shouldBe` currentState {stateIsShiftPressed = True}
diff --git a/specs/Specs/KeySequenceSpec.hs b/specs/Specs/KeySequenceSpec.hs
index 2efbece..7a92105 100644
--- a/specs/Specs/KeySequenceSpec.hs
+++ b/specs/Specs/KeySequenceSpec.hs
@@ -1,9 +1,9 @@
 module Specs.KeySequenceSpec where
 
 import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars)
-import qualified Debug.Trace as Debug
 import Test.Hspec
 
+test :: SpecWith ()
 test = do
   describe "#nextChars" $ do
     context "when there is a partial match" $ do