Refactor state update + test fixes

4 files changed, 203 insertions, 202 deletions

diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index d8f74ae..4b3ed42 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -1,32 +1,16 @@
 module Chelleport where
 
-import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp), setupAppShell)
+import Chelleport.AppShell (setupAppShell)
+import qualified Chelleport.AppState as AppState
 import Chelleport.Context (initializeContext)
-import Chelleport.Control
-  ( MonadControl (clickMouseButton, getMousePointerPosition, moveMousePointer, pressMouseButton, releaseMouseButton),
-    anyAlphanumeric,
-    anyDigit,
-    checkKey,
-    ctrl,
-    directionalIncrement,
-    eventToKeycode,
-    key,
-    pressed,
-    released,
-    shift,
-  )
-import Chelleport.Draw (MonadDraw (windowPosition, windowSize), cellSize)
-import Chelleport.KeySequence (findMatchPosition, generateGrid, keycodeToInt, nextChars, toKeyChar)
-import Chelleport.OCR (MonadOCR (captureScreenshot), getWordsInImage)
+import Chelleport.Control (anyAlphanumeric, anyDigit, checkKey, ctrl, eventToKeycode, key, pressed, released, shift)
+import Chelleport.KeySequence (keycodeToInt)
 import Chelleport.Types
-import Chelleport.Utils (cIntToInt, clamp, intToCInt, isEmpty, itemAt, (<||>))
+import Chelleport.Utils ((<||>))
 import qualified Chelleport.View
-import Control.Monad (forM_)
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Reader (ReaderT (runReaderT))
-import Data.Char (toLower)
-import Data.List (isInfixOf)
-import Data.Maybe (fromMaybe, isJust)
+import Data.Maybe (fromMaybe)
 import qualified SDL
 
 run :: IO ()
@@ -35,23 +19,14 @@ run = do
   runAppWithCtx ctx $
     setupAppShell
       ctx
-      initialState
-      update
+      AppState.initialState
+      AppState.update
       eventHandler
       Chelleport.View.render
   where
     runAppWithCtx :: (MonadIO m) => DrawContext -> AppM m x -> m x
     runAppWithCtx ctx = (`runReaderT` ctx) . runAppM
 
-initialState :: (Monad m) => m (State, Maybe AppAction)
-initialState = do
-  let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
-  pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode)
-  where
-    rows = 9
-    columns = 16
-    hintKeys = ['A' .. 'Z']
-
 eventHandler :: State -> SDL.Event -> Maybe AppAction
 eventHandler state event =
   case SDL.eventPayload event of
@@ -89,167 +64,3 @@ eventHandler state event =
       | checkKey [pressed, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState True
       | checkKey [released, key SDL.KeycodeRShift <||> key SDL.KeycodeLShift] ev -> Just $ UpdateShiftState False
     _ -> Nothing
-
-wordPosition :: (MonadDraw m) => OCRMatch -> m (Int, Int)
-wordPosition (OCRMatch {matchStartX, matchStartY}) = do
-  (x, y) <- windowPosition
-  pure (cIntToInt $ x + matchStartX, cIntToInt $ y + matchStartY)
-
-update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction)
--- Set mode
-update state (SetMode mode) = do
-  case mode of
-    ModeHints -> pure (state {stateMode = mode}, Nothing)
-    ModeSearch {} -> do
-      pos <- windowPosition
-      size <- windowSize
-      screenshot <- hideWindow >> captureScreenshot pos size <* showWindow
-
-      wordsOnScreen <- getWordsInImage screenshot
-      let updatedMode = mode {searchWords = wordsOnScreen, searchFilteredWords = wordsOnScreen}
-      pure (state {stateMode = updatedMode}, Nothing)
-
--- HINTS MODE: Act on key inputs
-update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
-  case (toKeyChar keycode, validChars) of
-    (Just keyChar, Just validChars')
-      | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
-          incr <- incrementValue
-          let action = IncrementMouseCursor $ directionalIncrement incr keyChar
-          pure (state, Just action)
-      | keyChar `elem` validChars' -> do
-          let newKeySequence = stateKeySequence state ++ [keyChar]
-          let matchPosition = findMatchPosition newKeySequence $ stateGrid state
-          let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
-          action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . getPosition) matchPosition
-          pure (state', action)
-    _ -> pure (state, Nothing)
-  where
-    validChars = nextChars (stateKeySequence state) (stateGrid state)
-    getPosition (row, col) = do
-      (wcell, hcell) <- cellSize state
-      let x = (wcell `div` 2) + wcell * intToCInt col
-      let y = (hcell `div` 2) + hcell * intToCInt row
-      (winx, winy) <- windowPosition
-      pure (cIntToInt $ winx + x, cIntToInt $ winy + y)
-    incrementValue = do
-      (wcell, hcell) <- cellSize state
-      if stateIsShiftPressed state
-        then pure (wcell `div` 4, hcell `div` 4)
-        else pure (wcell `div` 16, hcell `div` 16)
-
--- SEARCH MODE: Act on key inputs
-update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do
-  case toKeyChar keycode of
-    Just keyChar -> do
-      let searchText = searchInputText ++ [toLower keyChar]
-      let matches = filterMatches searchText
-      let mode = stateMode state
-      let highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex mode)
-      let updatedMode =
-            mode
-              { searchInputText = searchText,
-                searchFilteredWords = matches,
-                searchHighlightedIndex = highlightedIndex
-              }
-      let highlightedWord = matches `itemAt` highlightedIndex
-      action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord
-      pure (state {stateMode = updatedMode}, action)
-    _ -> do
-      pure (state, Nothing)
-  where
-    filterMatches text
-      | isEmpty text = searchWords
-      | otherwise = filter (isInfixOf text . map toLower . matchText) searchWords
-
--- Increment highlighted index for search mode
-update state (IncrementHighlightIndex n) = do
-  case stateMode state of
-    ModeSearch {} -> do
-      let mode = stateMode state
-      let index = searchHighlightedIndex mode + n
-      let highlightedIndex =
-            if index < 0
-              then length (searchFilteredWords mode) - 1
-              else index `mod` length (searchFilteredWords mode)
-      let highlightedWord = searchFilteredWords mode `itemAt` highlightedIndex
-      action <- maybe (pure Nothing) (fmap (Just . MoveMousePosition) . wordPosition) highlightedWord
-      pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndex}}, action)
-    _ -> pure (state, Nothing)
-
--- Move mouse incrementally
-update state (IncrementMouseCursor (incX, incY)) = do
-  (curX, curY) <- getMousePointerPosition
-  let count = case stateRepetition state of 0 -> 1; n -> n
-  let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY)
-  pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos)
-
--- Move mouse to given position
-update state (MoveMousePosition (x, y)) = do
-  moveMousePointer (intToCInt x) (intToCInt y)
-  pure (state, Nothing)
-
--- Reset entered key sequence and state
-update state ResetKeys = do
-  pure
-    ( state
-        { stateKeySequence = [],
-          stateIsMatched = False,
-          stateRepetition = 1,
-          stateMode = resetMode (stateMode state)
-        },
-      Nothing
-    )
-  where
-    resetMode mode@ModeHints = mode
-    resetMode (ModeSearch {searchWords}) =
-      defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords}
-
--- Trigger click
-update state (TriggerMouseClick btn) = do
-  hideWindow
-  let count = case stateRepetition state of 0 -> 1; n -> n
-  forM_ [1 .. count] $ \_ -> do
-    clickMouseButton btn
-  pure (state {stateRepetition = 1}, Just ShutdownApp)
-
--- Chain clicks
-update state (ChainMouseClick btn) = do
-  hideWindow
-  let count = case stateRepetition state of 0 -> 1; n -> n
-  forM_ [1 .. count] $ \_ -> do
-    clickMouseButton btn
-  showWindow
-  pure (state {stateRepetition = 1}, Just ResetKeys)
-
--- Cleanup everything and exit
-update state ShutdownApp = do
-  shutdownApp
-  pure (state, Nothing)
-
--- Mouse dragging
-update state MouseDragToggle
-  | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd)
-  | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart)
-
--- Mouse button press
-update state MouseDragStart = do
-  hideWindow
-  pressMouseButton
-  showWindow
-  pure (state {stateRepetition = 1}, Nothing)
-
--- Mouse button release
-update state MouseDragEnd = do
-  hideWindow
-  releaseMouseButton
-  showWindow
-  pure (state {stateRepetition = 1}, Nothing)
-
--- Set repetition count
-update state (UpdateRepetition count) = do
-  pure (state {stateRepetition = count}, Nothing)
-
--- Set/unset whether shift is pressed
-update state (UpdateShiftState shiftPressed) =
-  pure (state {stateIsShiftPressed = shiftPressed}, Nothing)
diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs
new file mode 100644
index 0000000..25575f1
--- /dev/null
+++ b/src/Chelleport/AppState.hs
@@ -0,0 +1,170 @@
+module Chelleport.AppState (initialState, update) where
+
+import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp))
+import Chelleport.Control (MonadControl (..), directionalIncrement)
+import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionIncrement, screenPositionFromCellPosition, wordPosition)
+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 Control.Monad (forM_)
+import Data.Char (toLower)
+import Data.List (isInfixOf)
+import Data.Maybe (fromMaybe, isJust)
+
+initialState :: (Monad m) => m (State, Maybe AppAction)
+initialState = do
+  let cells = fromMaybe (pure undefined) $ generateGrid 0 (rows, columns) hintKeys
+  pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode)
+  where
+    rows = 9
+    columns = 16
+    hintKeys = ['A' .. 'Z']
+
+update :: (MonadAppShell m, MonadDraw m, MonadControl m, MonadOCR m) => State -> AppAction -> m (State, Maybe AppAction)
+-- Chain clicks
+update state (ChainMouseClick btn) = do
+  hideWindow
+  let count = case stateRepetition state of 0 -> 1; n -> n
+  forM_ [1 .. count] $ \_ -> do
+    clickMouseButton btn
+  showWindow
+  pure (state {stateRepetition = 1}, Just ResetKeys)
+
+-- HINTS MODE: Act on key inputs
+update state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
+  case (toKeyChar keycode, validNextKeys) of
+    (Just keyChar, Just validChars')
+      | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
+          incr <- pointerPositionIncrement state
+          let action = IncrementMouseCursor $ directionalIncrement incr keyChar
+          pure (state, Just action)
+      | keyChar `elem` validChars' -> do
+          let newKeySequence = stateKeySequence state ++ [keyChar]
+          let matchPosition = findMatchPosition newKeySequence $ stateGrid state
+          let state' = state {stateKeySequence = newKeySequence, stateIsMatched = isJust matchPosition}
+          action <- traverse (fmap MoveMousePosition . screenPositionFromCellPosition state) matchPosition
+          pure (state', action)
+    _ -> pure (state, Nothing)
+  where
+    validNextKeys = nextChars (stateKeySequence state) (stateGrid state)
+
+-- SEARCH MODE: Act on key inputs
+update state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (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 mode)
+      let updatedMode =
+            mode
+              { searchInputText = searchText,
+                searchFilteredWords = matches,
+                searchHighlightedIndex = highlightedIndex
+              }
+      let highlightedWord = matches `itemAt` highlightedIndex
+      action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
+      pure (state {stateMode = updatedMode}, action)
+    _ -> do
+      pure (state, Nothing)
+  where
+    mode = stateMode state
+    filterMatches text
+      | isEmpty text = searchWords
+      | otherwise = filter (isInfixOf text . map toLower . matchText) searchWords
+
+-- Increment highlighted index for search mode
+update state (IncrementHighlightIndex n) = do
+  case stateMode state of
+    ModeSearch {} -> do
+      action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
+      pure (state {stateRepetition = 1, stateMode = mode {searchHighlightedIndex = highlightedIndexClamped}}, action)
+      where
+        highlightedWord = searchFilteredWords mode `itemAt` highlightedIndex
+        highlightedIndex = searchHighlightedIndex mode + n
+        highlightedIndexClamped =
+          if highlightedIndex < 0
+            then length (searchFilteredWords mode) - 1
+            else highlightedIndex `mod` length (searchFilteredWords mode)
+        mode = stateMode state
+    _ -> pure (state, Nothing)
+
+-- Move mouse incrementally
+update state (IncrementMouseCursor (incX, incY)) = do
+  (curX, curY) <- getMousePointerPosition
+  let count = case stateRepetition state of 0 -> 1; n -> n
+  let pos = (cIntToInt curX + count * incX, cIntToInt curY + count * incY)
+  pure (state {stateRepetition = 1}, Just $ MoveMousePosition pos)
+
+-- Mouse button release
+update state MouseDragEnd = do
+  hideWindow
+  releaseMouseButton
+  showWindow
+  pure (state {stateRepetition = 1}, Nothing)
+
+-- Mouse button press
+update state MouseDragStart = do
+  hideWindow
+  pressMouseButton
+  showWindow
+  pure (state {stateRepetition = 1}, Nothing)
+
+-- Mouse dragging
+update state MouseDragToggle
+  | stateIsDragging state = pure (state {stateIsDragging = False}, Just MouseDragEnd)
+  | otherwise = do pure (state {stateIsDragging = True}, Just MouseDragStart)
+
+-- Move mouse to given position
+update state (MoveMousePosition (x, y)) = do
+  moveMousePointer (intToCInt x) (intToCInt y)
+  pure (state, Nothing)
+
+-- Reset entered key sequence and state
+update state ResetKeys = do
+  pure
+    ( state
+        { stateKeySequence = [],
+          stateIsMatched = False,
+          stateRepetition = 1,
+          stateMode = resetMode (stateMode state)
+        },
+      Nothing
+    )
+  where
+    resetMode mode@ModeHints = mode
+    resetMode (ModeSearch {searchWords}) =
+      defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords}
+
+-- Set mode
+update state (SetMode mode) = do
+  case mode of
+    ModeHints -> pure (state {stateMode = mode}, Nothing)
+    ModeSearch {} -> do
+      position <- windowPosition
+      size <- windowSize
+      screenshot <- hideWindow >> captureScreenshot position size <* showWindow
+      matches <- getWordsInImage screenshot
+      let updatedMode = mode {searchWords = matches, searchFilteredWords = matches}
+      pure (state {stateMode = updatedMode}, Nothing)
+
+-- Cleanup everything and exit
+update state ShutdownApp = do
+  shutdownApp
+  pure (state, Nothing)
+
+-- Trigger click
+update state (TriggerMouseClick btn) = do
+  hideWindow
+  let count = case stateRepetition state of 0 -> 1; n -> n
+  forM_ [1 .. count] $ \_ -> do
+    clickMouseButton btn
+  pure (state {stateRepetition = 1}, Just ShutdownApp)
+
+-- Set repetition count
+update state (UpdateRepetition count) = do
+  pure (state {stateRepetition = count}, Nothing)
+
+-- Set/unset whether shift is pressed
+update state (UpdateShiftState shiftPressed) =
+  pure (state {stateIsShiftPressed = shiftPressed}, Nothing)
diff --git a/src/Chelleport/Draw.hs b/src/Chelleport/Draw.hs
index 60944a3..dbda1c1 100644
--- a/src/Chelleport/Draw.hs
+++ b/src/Chelleport/Draw.hs
@@ -1,7 +1,7 @@
 module Chelleport.Draw where
 
 import Chelleport.Types
-import Chelleport.Utils (intToCInt)
+import Chelleport.Utils (cIntToInt, intToCInt)
 import Control.Monad.Reader (MonadIO, MonadReader (ask), asks)
 import Data.Text (Text)
 import qualified Data.Vector.Storable as Vector
@@ -84,6 +84,26 @@ cellSize (State {stateGrid}) = do
   let hcell = height `div` intToCInt (length stateGrid)
   pure (wcell, hcell)
 
+pointerPositionIncrement :: (MonadDraw m) => State -> m (CInt, CInt)
+pointerPositionIncrement state = do
+  (wcell, hcell) <- cellSize state
+  if stateIsShiftPressed state
+    then pure (wcell `div` 4, hcell `div` 4)
+    else pure (wcell `div` 16, hcell `div` 16)
+
+screenPositionFromCellPosition :: (MonadDraw m) => State -> (Int, Int) -> m (Int, Int)
+screenPositionFromCellPosition state (row, col) = do
+  (wcell, hcell) <- cellSize state
+  let x = (wcell `div` 2) + wcell * intToCInt col
+  let y = (hcell `div` 2) + hcell * intToCInt row
+  (winx, winy) <- windowPosition
+  pure (cIntToInt $ winx + x, cIntToInt $ winy + y)
+
+wordPosition :: (MonadDraw m) => OCRMatch -> m (Int, Int)
+wordPosition (OCRMatch {matchStartX, matchStartY}) = do
+  (x, y) <- windowPosition
+  pure (cIntToInt $ x + matchStartX, cIntToInt $ y + matchStartY)
+
 drawHorizontalLine :: (MonadDraw m) => CInt -> m ()
 drawHorizontalLine y = do
   (width, _) <- windowSize
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 59ed43d..f526fe8 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -65,18 +65,18 @@ defaultAppState =
 data AppAction
   = ChainMouseClick MouseButtonType
   | HandleKeyInput SDL.Keycode
+  | IncrementHighlightIndex Int
   | IncrementMouseCursor (Int, Int)
-  | MouseDragStart
   | MouseDragEnd
+  | MouseDragStart
   | MouseDragToggle
   | MoveMousePosition (Int, Int)
   | ResetKeys
+  | SetMode Mode
   | ShutdownApp
   | TriggerMouseClick MouseButtonType
-  | UpdateShiftState Bool
   | UpdateRepetition Int
-  | SetMode Mode
-  | IncrementHighlightIndex Int
+  | UpdateShiftState Bool
   deriving (Show, Eq)
 
 data FontSize = FontSM | FontLG deriving (Show, Eq)