Make backspace delete a single character in search + split up key input action

7 files changed, 192 insertions, 87 deletions

diff --git a/TODO.norg b/TODO.norg
index d67c110..c83b1c9 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,9 +1,8 @@
 * Current
-  - ( ) Middle click
   - (-) Optimize speed of ocr
-  - ( ) Backspace deletes a single character in search mode
 
 * Later
+  - ( ) Middle click
   - ( ) Look into making mouse controls (click/mouse down/mouse up) cross-platform
   - ( ) Look into making screenshot cross-platform
   - ( ) Support 4k screen resolution?
diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs
index 39b8437..51e0819 100644
--- a/specs/Specs/AppStateSpec.hs
+++ b/specs/Specs/AppStateSpec.hs
@@ -2,7 +2,7 @@ module Specs.AppStateSpec where
 
 import Chelleport.AppState (initialState, update)
 import Chelleport.Types
-import Chelleport.Utils (uniq)
+import Chelleport.Utils (isNotEmpty, uniq)
 import Control.Monad (join)
 import Data.Default (Default (def))
 import qualified SDL
@@ -75,11 +75,122 @@ test = do
                                    Mock_showWindow
                                  ]
 
+    context "with action HandleFilterInputChange" $ do
+      context "when mode is ModeSearch" $ do
+        it "todo: implement" $ do
+          True `shouldBe` True
+
+      context "when mode is ModeHints" $ do
+        context "when there are no matches" $ do
+          let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "DE"}}
+
+          context "when input key sequence has matching values in grid" $ do
+            it "does not update" $ do
+              ((nextState, action), _) <- runWithMocks $ update flush currentState HandleFilterInputChange
+              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 flush currentState HandleFilterInputChange
+              action `shouldBe` Nothing
+              nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateIsMatched = False, stateKeySequence = "DE"}}
+
+        context "when there are matches" $ do
+          let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "DEF"}}
+
+          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 flush currentState HandleFilterInputChange
+              nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateIsMatched = True, stateKeySequence = "DEF"}}
+
+            it "continues with MoveMousePosition action at center of matched cell" $ do
+              ((_, action), _) <- runWithMocks $ do
+                Mock_windowSize `mockReturns` mockWindowSize
+                Mock_windowPosition `mockReturns` mockWindowPosition
+                update flush currentState HandleFilterInputChange
+              action `shouldBe` Just (MoveMousePosition (1640, 370))
+
+    context "with action HandleKeyInput" $ do
+      context "when mode is ModeSearch" $ do
+        let currentState = defaultState {stateMode = ModeSearch $ def {searchInputText = "h"}}
+
+        it "adds key to input text as lower cased and continues with filter action" $ do
+          ((nextState, action), _) <- runWithMocks $ update flush currentState $ HandleKeyInput SDL.KeycodeE
+          nextState `shouldBe` currentState {stateMode = ModeSearch def {searchInputText = "he"}}
+          action `shouldBe` Just HandleFilterInputChange
+
+      context "when mode is ModeHints" $ do
+        let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "D"}}
+
+        context "when input key sequence has matching values in grid" $ do
+          it "does not update" $ do
+            ((nextState, action), _) <- runWithMocks $ update flush 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 and continues with filter action" $ do
+            ((nextState, action), _) <- runWithMocks $ update flush currentState $ HandleKeyInput SDL.KeycodeE
+            nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DE"}}
+            action `shouldBe` Just HandleFilterInputChange
+
     context "with action IncrementHighlightIndex" $ do
-      -- let currentState = defaultState
+      context "when filtered match list is empty" $ do
+        let defaultSearchData = def {searchFilteredWords = [], searchHighlightedIndex = 2}
+        let currentState = defaultState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData}
 
-      it "todo: implement" $ do
-        True `shouldBe` True
+        it "does not continue or update state" $ do
+          ((nextState, action), _) <- runWithMocks $ do
+            update flush currentState $ IncrementHighlightIndex 3
+          nextState `shouldBe` currentState {stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 0}}
+          action `shouldBe` Nothing
+
+      context "when there are some matches" $ do
+        let defaultSearchData =
+              def
+                { searchHighlightedIndex = 0,
+                  searchFilteredWords =
+                    [ def {matchText = "Hello"},
+                      def {matchStartX = 10, matchText = "World"},
+                      def {matchStartX = 20, matchText = "Door"}
+                    ]
+                }
+        let currentState = defaultState {stateRepetition = 2, stateMode = ModeSearch defaultSearchData}
+
+        it "continues with moving mouse to word at index" $ do
+          ((_, action), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1
+          action `shouldBe` Just (MoveMousePosition (fromIntegral mockWindowOffsetX + 20, fromIntegral mockWindowOffsetY))
+
+        it "increments index by given number times the repetition count" $ do
+          ((nextState, _), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1
+          nextState `shouldBe` currentState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 2}}
+
+        it "resets repetition back to 1" $ do
+          ((nextState, _), _) <- runWithMocks $ update flush currentState $ IncrementHighlightIndex 1
+          stateRepetition nextState `shouldBe` 1
+
+        context "when incrementing higher than the last element" $ do
+          let defaultSearchData =
+                def
+                  { searchHighlightedIndex = 2,
+                    searchFilteredWords =
+                      [ def {matchText = "Hello"},
+                        def {matchStartX = 10, matchText = "World"},
+                        def {matchStartX = 20, matchText = "Door"}
+                      ]
+                  }
+          let currentState = defaultState {stateRepetition = 2, stateMode = ModeSearch defaultSearchData}
+
+          it "circles back to the start of match list" $ do
+            ((nextState, _), _) <- runWithMocks $ do
+              update flush currentState $ IncrementHighlightIndex 1
+            nextState `shouldBe` currentState {stateRepetition = 1, stateMode = ModeSearch defaultSearchData {searchHighlightedIndex = 1}}
+
+          it "continues with moving mouse to word at index" $ do
+            ((_, action), _) <- runWithMocks $ do
+              update flush currentState $ IncrementHighlightIndex 1
+            action `shouldBe` Just (MoveMousePosition (fromIntegral mockWindowOffsetX + 10, fromIntegral mockWindowOffsetY))
 
     context "with action IncrementMouseCursor" $ do
       context "when repetition is 1" $ do
@@ -149,42 +260,6 @@ test = do
           ((_, action), _) <- runWithMocks $ update flush currentState MouseDragToggle
           action `shouldBe` Just MouseDragStart
 
-    context "with action HandleKeyInput" $ do
-      context "when mode is ModeSearch" $ do
-        it "todo: implement" $ do
-          True `shouldBe` True
-
-      context "when mode is ModeHints" $ do
-        context "when there are no matches" $ do
-          let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {stateKeySequence = "D"}}
-
-          context "when input key sequence has matching values in grid" $ do
-            it "does not update" $ do
-              ((nextState, action), _) <- runWithMocks $ update flush 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 flush currentState $ HandleKeyInput SDL.KeycodeE
-              action `shouldBe` Nothing
-              nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DE"}}
-
-        context "when there are matches" $ do
-          let currentState = defaultState {stateMode = ModeHints $ defaultHintModeData {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 flush currentState $ HandleKeyInput SDL.KeycodeF
-              nextState `shouldBe` currentState {stateMode = ModeHints defaultHintModeData {stateKeySequence = "DEF", stateIsMatched = True}}
-
-            it "continues with MoveMousePosition action at center of matched cell" $ do
-              ((_, action), _) <- runWithMocks $ do
-                Mock_windowSize `mockReturns` mockWindowSize
-                Mock_windowPosition `mockReturns` mockWindowPosition
-                update flush currentState $ HandleKeyInput SDL.KeycodeF
-              action `shouldBe` Just (MoveMousePosition (1640, 370))
-
     context "with action MoveMouseInDirection" $ do
       let currentState = defaultState
 
@@ -264,7 +339,7 @@ test = do
           stateIsModeInitialized nextState `shouldBe` True
           action `shouldBe` Nothing
 
-        it "returns grid with 16x9 key sequences" $ do
+        it "returns grid of key sequences with the right number of rows and columns" $ do
           ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode
           case stateMode nextState of
             ModeHints hintsData -> do
@@ -277,7 +352,7 @@ test = do
           ((nextState, _), _) <- runWithMocks $ update flush currentState InitializeMode
           case stateMode nextState of
             ModeHints hintsData -> do
-              join (stateGrid hintsData) `shouldSatisfy` (not . null)
+              join (stateGrid hintsData) `shouldSatisfy` isNotEmpty
               join (stateGrid hintsData) `shouldBe` uniq (join $ stateGrid hintsData)
             _ -> undefined
 
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index d4c21ed..8cc02c7 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -17,13 +17,14 @@ import qualified SDL
 run :: Configuration -> IO ()
 run config = do
   ctx <- initializeContext
-  -- Cosplaying as elm
+  -- Cosplaying as elm's state machine
   runAppWithCtx ctx $
     setupAppShell ctx (AppState.initialState config) AppState.update eventHandler View.render
   where
     runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x
     runAppWithCtx ctx = (`runReaderT` ctx) . runAppM
 
+-- TODO: Make event handling independent of state
 eventHandler :: State -> SDL.Event -> Maybe AppAction
 eventHandler state event =
   case SDL.eventPayload event of
@@ -43,9 +44,9 @@ eventHandler state event =
           Just $ SetMode $ ModeHints def
       -- <C-n>, <C-p>: Search increment next/prev
       | checkKey [ctrl, key SDL.KeycodeN, pressed] ev ->
-          Just $ IncrementHighlightIndex (stateRepetition state)
+          Just $ IncrementHighlightIndex 1
       | checkKey [ctrl, key SDL.KeycodeP, pressed] ev ->
-          Just $ IncrementHighlightIndex (-1 * stateRepetition state)
+          Just $ IncrementHighlightIndex (-1)
       -- <C-hjkl>: Movement
       | checkKey [ctrl, hjkl, pressed] ev ->
           MoveMouseInDirection . hjklDirection <$> toKeyChar (eventToKeycode ev)
@@ -56,7 +57,9 @@ eventHandler state event =
             else Just $ TriggerMouseClick LeftClick
       -- Backspace: Reset keys
       | checkKey [key SDL.KeycodeBackspace, pressed] ev ->
-          Just ResetKeys
+          case stateMode state of
+            ModeHints {} -> Just ResetKeys
+            ModeSearch {} -> Just DeleteLastInput
       -- <C-v>: Toggle mouse dragging
       | checkKey [ctrl, key SDL.KeycodeV, pressed] ev ->
           Just MouseDragToggle
diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs
index bcb7dce..f11ca44 100644
--- a/src/Chelleport/AppState.hs
+++ b/src/Chelleport/AppState.hs
@@ -6,7 +6,7 @@ import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionI
 import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars, toKeyChar)
 import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage)
 import Chelleport.Types
-import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt)
+import Chelleport.Utils (cIntToInt, clamp, cycleInRange, intToCInt, isEmpty, itemAt)
 import Control.Monad (replicateM_)
 import Data.Char (toLower)
 import Data.Default (Default (def))
@@ -29,6 +29,44 @@ update _ state (ChainMouseClick btn) = do
   showWindow
   pure (state {stateRepetition = 1}, Just ResetKeys)
 
+-- Delete last input char
+update _ state DeleteLastInput = case stateMode state of
+  ModeHints {} -> pure (state, Nothing)
+  ModeSearch searchData@(ModeSearchData {searchInputText})
+    | isEmpty searchInputText -> pure (state, Nothing)
+    | otherwise -> do
+        let updatedText = take (length searchInputText - 1) searchInputText
+        pure
+          ( state {stateMode = ModeSearch searchData {searchInputText = updatedText}},
+            Just HandleFilterInputChange
+          )
+
+-- HINTS MODE: Set match state when a match is found for the key sequence
+update _ state@(State {stateMode = ModeHints hintsData}) HandleFilterInputChange = do
+  let updatedHintsData = hintsData {stateIsMatched = isJust matchPosition}
+  action <- fmap MoveMousePosition <$> traverse (screenPositionFromCellPosition state) matchPosition
+  pure (state {stateMode = ModeHints updatedHintsData}, action)
+  where
+    (ModeHintsData {stateKeySequence}) = hintsData
+    matchPosition = findMatchPosition stateKeySequence $ stateGrid hintsData
+
+-- SEARCH MODE: Filter results based on text input
+update _ state@(State {stateMode = ModeSearch searchData}) HandleFilterInputChange = do
+  let updatedModeData =
+        searchData
+          { searchFilteredWords = filteredMatches,
+            searchHighlightedIndex = highlightedIndex
+          }
+  action <- fmap MoveMousePosition <$> traverse wordPosition highlightedWord
+  pure (state {stateMode = ModeSearch updatedModeData}, action)
+  where
+    (ModeSearchData {searchInputText, searchWords, searchHighlightedIndex}) = searchData
+    highlightedIndex = clamp (0, length filteredMatches - 1) searchHighlightedIndex
+    highlightedWord = filteredMatches `itemAt` highlightedIndex
+    filteredMatches
+      | isEmpty searchInputText = searchWords
+      | otherwise = Fuzzy.original <$> Fuzzy.filter searchInputText searchWords "" "" matchText False
+
 -- HINTS MODE: Act on key inputs
 update _ state@(State {stateMode = ModeHints hintsData}) (HandleKeyInput keycode) = do
   case (toKeyChar keycode, validNextKeys) of
@@ -36,53 +74,32 @@ update _ state@(State {stateMode = ModeHints hintsData}) (HandleKeyInput keycode
       | stateIsMatched hintsData && keyChar `elem` ("HJKL" :: String) -> do
           pure (state, Just $ MoveMouseInDirection $ hjklDirection keyChar)
       | keyChar `elem` validChars' -> do
-          let newKeySequence = stateKeySequence hintsData ++ [keyChar]
-          let matchPosition = findMatchPosition newKeySequence $ stateGrid hintsData
-          let updatedHintsData = hintsData {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
-          action <- traverse (fmap MoveMousePosition . screenPositionFromCellPosition state) matchPosition
-          pure (state {stateMode = ModeHints updatedHintsData}, action)
+          let updatedHintsData = hintsData {stateKeySequence = stateKeySequence hintsData ++ [keyChar]}
+          pure (state {stateMode = ModeHints updatedHintsData}, Just HandleFilterInputChange)
     _ -> pure (state, Nothing)
   where
     validNextKeys = nextChars (stateKeySequence hintsData) (stateGrid hintsData)
 
 -- SEARCH MODE: Act on key inputs
-update _ state@(State {stateMode = ModeSearch (ModeSearchData {searchWords, searchInputText})}) (HandleKeyInput keycode) = do
+update _ state@(State {stateMode = ModeSearch searchData}) (HandleKeyInput keycode) = do
   case toKeyChar keycode of
     Just keyChar -> do
-      let searchText = searchInputText ++ [toLower keyChar]
-      let matches = filterMatches searchText
-      let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex $ modeSearchData mode)
-      let updatedMode =
-            (modeSearchData mode)
-              { searchInputText = searchText,
-                searchFilteredWords = matches,
-                searchHighlightedIndex = highlightedIndex
-              }
-      let highlightedWord = matches `itemAt` highlightedIndex
-      action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
-      pure (state {stateMode = ModeSearch updatedMode}, action)
-    _ -> do
-      pure (state, Nothing)
-  where
-    mode = stateMode state
-    filterMatches text
-      | isEmpty text = searchWords
-      | otherwise = Fuzzy.original <$> Fuzzy.filter text searchWords "" "" matchText False
+      let updatedMode = searchData {searchInputText = searchInputText searchData ++ [toLower keyChar]}
+      pure (state {stateMode = ModeSearch updatedMode}, Just HandleFilterInputChange)
+    _ -> pure (state, Nothing)
 
 -- Increment highlighted index for search mode
 update _ state (IncrementHighlightIndex n) = do
   case stateMode state of
-    ModeSearch {} -> do
+    ModeSearch searchData@(ModeSearchData {searchFilteredWords, searchHighlightedIndex}) -> do
+      let updatedModeData = searchData {searchHighlightedIndex = updatedHighlightedIndex}
       action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
-      pure (state {stateRepetition = 1, stateMode = ModeSearch $ searchData {searchHighlightedIndex = highlightedIndexClamped}}, action)
+      pure (state {stateRepetition = 1, stateMode = ModeSearch updatedModeData}, action)
       where
-        highlightedWord = searchFilteredWords searchData `itemAt` highlightedIndexClamped
-        highlightedIndex = searchHighlightedIndex searchData + n
-        highlightedIndexClamped =
-          if highlightedIndex < 0
-            then length (searchFilteredWords searchData) - 1
-            else highlightedIndex `mod` length (searchFilteredWords searchData)
-        searchData = modeSearchData $ stateMode state
+        highlightedWord = searchFilteredWords `itemAt` updatedHighlightedIndex
+        increment = n * stateRepetition state
+        updatedHighlightedIndex =
+          cycleInRange (0, length searchFilteredWords - 1) $ searchHighlightedIndex + increment
     _ -> pure (state, Nothing)
 
 -- Move mouse incrementally
diff --git a/src/Chelleport/Control.hs b/src/Chelleport/Control.hs
index b987564..3873c1e 100644
--- a/src/Chelleport/Control.hs
+++ b/src/Chelleport/Control.hs
@@ -72,7 +72,7 @@ keyModifier :: SDL.KeyboardEventData -> SDL.KeyModifier
 keyModifier = SDL.keysymModifier . SDL.keyboardEventKeysym
 
 checkKey :: [SDL.KeyboardEventData -> Bool] -> SDL.KeyboardEventData -> Bool
-checkKey = (<&&>)
+checkKey = foldl (<&&>) (const True)
 
 pressed :: SDL.KeyboardEventData -> Bool
 pressed = (SDL.Pressed ==) . SDL.keyboardEventKeyMotion
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 4001de8..4d07dbb 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -83,6 +83,8 @@ data Direction = DirUp | DirDown | DirLeft | DirRight
 
 data AppAction
   = ChainMouseClick MouseButtonType
+  | DeleteLastInput
+  | HandleFilterInputChange
   | HandleKeyInput SDL.Keycode
   | IncrementHighlightIndex Int
   | IncrementMouseCursor (Int, Int)
@@ -144,6 +146,9 @@ instance Storable OCRMatch where
   -- NOTE: Dont need poke
   poke _ _ = undefined
 
+instance Default OCRMatch where
+  def = OCRMatch {matchStartX = 0, matchStartY = 0, matchEndX = 0, matchEndY = 0, matchText = ""}
+
 data Configuration = Configuration
   { configMode :: Mode,
     configShowHelp :: Bool
diff --git a/src/Chelleport/Utils.hs b/src/Chelleport/Utils.hs
index 3f0dd73..4367c4f 100644
--- a/src/Chelleport/Utils.hs
+++ b/src/Chelleport/Utils.hs
@@ -37,15 +37,21 @@ benchmark msg m = do
   pure result
 
 itemAt :: [a] -> Int -> Maybe a
-itemAt [] _ = Nothing
 itemAt (x : _) 0 = Just x
 itemAt (_ : xs) i = itemAt xs (i - 1)
+itemAt _ _ = Nothing
 
 clamp :: (Integral a) => (a, a) -> a -> a
 clamp (low, high) n = max low (min high n)
 
-(<&&>) :: [a -> Bool] -> a -> Bool
-(<&&>) preds ev = all (\p -> p ev) preds
+cycleInRange :: (Integral a) => (a, a) -> a -> a
+cycleInRange (low, high) n
+  | n < low = high
+  | high <= low = low
+  | otherwise = low + ((n - low) `mod` (high - low + 1))
+
+(<&&>) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
+(<&&>) p1 p2 x = p1 x && p2 x
 
 (<||>) :: (a -> Bool) -> (a -> Bool) -> a -> Bool
 (<||>) p1 p2 x = p1 x || p2 x