Refactor mode data type

10 files changed, 84 insertions, 79 deletions

diff --git a/TODO.norg b/TODO.norg
index 41f40c7..d71d249 100644
--- a/TODO.norg
+++ b/TODO.norg
@@ -1,10 +1,11 @@
 * Current
   - ( ) TextStyle for drawText
   - ( ) Middle click
-  - ( ) Separate state for hint modes into ModeHint constructor
   - (-) Optimize speed of ocr
+  - ( ) Backspace deletes a single character in search mode
 
 * Later
+  - ( ) Separate state for hint modes into ModeHint constructor
   - ( ) Look into making mouse controls (click/mouse down/mouse up) cross-platform
   - ( ) Look into making screenshot cross-platform
   - ( ) Lens-ey setup for Mode access
diff --git a/cpp/libchelleport.cpp b/cpp/libchelleport.cpp
index 5845bc4..53ba64e 100644
--- a/cpp/libchelleport.cpp
+++ b/cpp/libchelleport.cpp
@@ -13,12 +13,12 @@ extern "C" OCRMatch *findWordCoordinates(const char *image_path, int *size) {
   OCRMatchSet matches;
   MEASURE("OCR", { matches = extractTextMatches(image_path); });
 
-  std::cout << "Match count: " << matches.size() << std::endl;
-
   static OCRMatch *ptr = new OCRMatch[matches.size()];
   std::copy(matches.begin(), matches.end(), ptr);
 
   *size = matches.size();
+  std::cout << "Match count: " << *size << std::endl;
+
   return ptr;
 }
 
diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs
index d69ab0e..96ff9ee 100644
--- a/specs/Specs/AppStateSpec.hs
+++ b/specs/Specs/AppStateSpec.hs
@@ -32,11 +32,11 @@ test = do
       join (stateGrid initState) `shouldBe` uniq (join $ stateGrid initState)
 
     context "when config specifies mode" $ do
-      let currentConfig = config {configMode = defaultSearchMode}
+      let currentConfig = config {configMode = ModeSearch def}
 
       it "continues to set given mode" $ do
         ((_, action), _) <- runWithMocks $ initialState currentConfig
-        action `shouldBe` Just (SetMode defaultSearchMode)
+        action `shouldBe` Just (SetMode $ ModeSearch def)
 
   describe "#update" $ do
     let defaultState = def {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]}
@@ -152,7 +152,7 @@ test = do
 
       context "when mode is ModeHints" $ do
         context "when there are no matches" $ do
-          let currentState = defaultState {stateKeySequence = "D", stateMode = defaultHintsMode}
+          let currentState = defaultState {stateKeySequence = "D", stateMode = ModeHints def}
 
           context "when input key sequence has matching values in grid" $ do
             it "does not update" $ do
@@ -167,7 +167,7 @@ test = do
               nextState `shouldBe` currentState {stateKeySequence = "DE"}
 
         context "when there are matches" $ do
-          let currentState = defaultState {stateKeySequence = "DE", stateMode = defaultHintsMode}
+          let currentState = defaultState {stateKeySequence = "DE", stateMode = ModeHints def}
 
           context "when input key sequence does not have matching values in grid" $ do
             it "adds key to key sequence and enables isMatched" $ do
@@ -235,13 +235,13 @@ test = do
       let currentState = defaultState
 
       it "updates mode in state and continues to initialize mode" $ do
-        ((nextState, action), _) <- runWithMocks $ update flush currentState $ SetMode defaultHintsMode
-        nextState `shouldBe` currentState {stateMode = defaultHintsMode, stateIsModeInitialized = False}
+        ((nextState, action), _) <- runWithMocks $ update flush currentState $ SetMode $ ModeHints def
+        nextState `shouldBe` currentState {stateMode = ModeHints def, stateIsModeInitialized = False}
         action `shouldBe` Just InitializeMode
 
     context "with action InitializeMode" $ do
       context "when mode is ModeHints" $ do
-        let currentState = defaultState {stateMode = defaultHintsMode, stateIsModeInitialized = False}
+        let currentState = defaultState {stateMode = ModeHints def, stateIsModeInitialized = False}
 
         it "updates initialization state to true" $ do
           ((nextState, action), _) <- runWithMocks $ update flush currentState InitializeMode
@@ -249,7 +249,7 @@ test = do
           action `shouldBe` Nothing
 
       context "when mode is ModeSearch" $ do
-        let currentState = defaultState {stateMode = defaultSearchMode, stateIsModeInitialized = False}
+        let currentState = defaultState {stateMode = ModeSearch def, stateIsModeInitialized = False}
 
         it "captures screenshot for word search" $ do
           ((_, _), mock) <- runWithMocks $ do
@@ -270,10 +270,11 @@ test = do
             `shouldBe` currentState
               { stateIsModeInitialized = True,
                 stateMode =
-                  defaultSearchMode
-                    { searchWords = [matchWord],
-                      searchFilteredWords = [matchWord]
-                    }
+                  ModeSearch $
+                    def
+                      { searchWords = [matchWord],
+                        searchFilteredWords = [matchWord]
+                      }
               }
 
     context "with action ShutdownApp" $ do
diff --git a/specs/Specs/ArgsSpec.hs b/specs/Specs/ArgsSpec.hs
index caaab75..8a97623 100644
--- a/specs/Specs/ArgsSpec.hs
+++ b/specs/Specs/ArgsSpec.hs
@@ -20,10 +20,10 @@ test = do
 
     context "when args contains -m or --mode with a valid mode" $ do
       it "parses configuration with mode" $ do
-        parseArgs ["-m", "search"] `shouldBe` Right (def {configMode = defaultSearchMode})
-        parseArgs ["--mode", "search"] `shouldBe` Right (def {configMode = defaultSearchMode})
-        parseArgs ["-m", "hints"] `shouldBe` Right (def {configMode = defaultHintsMode})
-        parseArgs ["--mode", "hints"] `shouldBe` Right (def {configMode = defaultHintsMode})
+        parseArgs ["-m", "search"] `shouldBe` Right (def {configMode = ModeSearch def})
+        parseArgs ["--mode", "search"] `shouldBe` Right (def {configMode = ModeSearch def})
+        parseArgs ["-m", "hints"] `shouldBe` Right (def {configMode = ModeHints def})
+        parseArgs ["--mode", "hints"] `shouldBe` Right (def {configMode = ModeHints def})
 
     context "when args contains -m or --mode with an invalid mode" $ do
       it "returns with error message" $ do
diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 370951e..4ad20a0 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -10,6 +10,7 @@ import Chelleport.Utils ((<||>))
 import qualified Chelleport.View as View
 import Control.Monad.IO.Class (MonadIO)
 import Control.Monad.Reader (ReaderT (runReaderT))
+import Data.Default (Default (def))
 import Data.Maybe (fromMaybe)
 import qualified SDL
 
@@ -33,10 +34,10 @@ eventHandler state event =
           Just ShutdownApp
       -- <C-s>: Enable search mode
       | checkKey [ctrl, key SDL.KeycodeS, pressed] ev ->
-          Just $ SetMode defaultSearchMode
+          Just $ SetMode $ ModeSearch def
       -- <C-t>: Enable hints mode
       | checkKey [ctrl, key SDL.KeycodeT, pressed] ev ->
-          Just $ SetMode defaultHintsMode
+          Just $ SetMode $ ModeHints def
       -- <C-n>, <C-p>: Search increment next/prev
       | checkKey [ctrl, key SDL.KeycodeN, pressed] ev ->
           Just $ IncrementHighlightIndex (stateRepetition state)
diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs
index fe397e8..9b69404 100644
--- a/src/Chelleport/AppState.hs
+++ b/src/Chelleport/AppState.hs
@@ -32,7 +32,7 @@ update _ state (ChainMouseClick btn) = do
   pure (state {stateRepetition = 1}, Just ResetKeys)
 
 -- HINTS MODE: Act on key inputs
-update _ state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
+update _ state@(State {stateMode = ModeHints {}}) (HandleKeyInput keycode) = do
   case (toKeyChar keycode, validNextKeys) of
     (Just keyChar, Just validChars')
       | stateIsMatched state && keyChar `elem` ("HJKL" :: String) -> do
@@ -48,21 +48,21 @@ update _ state@(State {stateMode = ModeHints}) (HandleKeyInput keycode) = do
     validNextKeys = nextChars (stateKeySequence state) (stateGrid state)
 
 -- SEARCH MODE: Act on key inputs
-update _ state@(State {stateMode = ModeSearch {searchWords, searchInputText}}) (HandleKeyInput keycode) = do
+update _ state@(State {stateMode = ModeSearch (ModeSearchData {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 highlightedIndex = clamp (0, length matches - 1) (searchHighlightedIndex $ modeSearchData mode)
       let updatedMode =
-            mode
+            (modeSearchData mode)
               { searchInputText = searchText,
                 searchFilteredWords = matches,
                 searchHighlightedIndex = highlightedIndex
               }
       let highlightedWord = matches `itemAt` highlightedIndex
       action <- traverse (fmap MoveMousePosition . wordPosition) highlightedWord
-      pure (state {stateMode = updatedMode}, action)
+      pure (state {stateMode = ModeSearch updatedMode}, action)
     _ -> do
       pure (state, Nothing)
   where
@@ -76,15 +76,15 @@ 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)
+      pure (state {stateRepetition = 1, stateMode = ModeSearch $ searchData {searchHighlightedIndex = highlightedIndexClamped}}, action)
       where
-        highlightedWord = searchFilteredWords mode `itemAt` highlightedIndexClamped
-        highlightedIndex = searchHighlightedIndex mode + n
+        highlightedWord = searchFilteredWords searchData `itemAt` highlightedIndexClamped
+        highlightedIndex = searchHighlightedIndex searchData + n
         highlightedIndexClamped =
           if highlightedIndex < 0
-            then length (searchFilteredWords mode) - 1
-            else highlightedIndex `mod` length (searchFilteredWords mode)
-        mode = stateMode state
+            then length (searchFilteredWords searchData) - 1
+            else highlightedIndex `mod` length (searchFilteredWords searchData)
+        searchData = modeSearchData $ stateMode state
     _ -> pure (state, Nothing)
 
 -- Move mouse incrementally
@@ -135,14 +135,14 @@ update _ state ResetKeys = do
       Nothing
     )
   where
-    resetMode mode@ModeHints = mode
-    resetMode (ModeSearch {searchWords}) =
-      defaultSearchMode {searchWords = searchWords, searchFilteredWords = searchWords}
+    resetMode mode@(ModeHints {}) = mode
+    resetMode (ModeSearch searchData@(ModeSearchData {searchWords})) =
+      ModeSearch (searchData {searchWords = searchWords, searchFilteredWords = searchWords})
 
 -- Initialize current mode
 update flush state InitializeMode =
   case stateMode state of
-    ModeHints -> pure (state {stateIsModeInitialized = True}, Nothing)
+    ModeHints {} -> pure (state {stateIsModeInitialized = True}, Nothing)
     ModeSearch {} -> do
       position <- windowPosition
       size <- windowSize
@@ -151,8 +151,8 @@ update flush state InitializeMode =
       showWindow
       flush
       matches <- getWordsInImage screenshot
-      let updatedMode = (stateMode state) {searchWords = matches, searchFilteredWords = matches}
-      pure (state {stateMode = updatedMode, stateIsModeInitialized = True}, Nothing)
+      let updatedSearchData = (modeSearchData $ stateMode state) {searchWords = matches, searchFilteredWords = matches}
+      pure (state {stateMode = ModeSearch updatedSearchData, stateIsModeInitialized = True}, Nothing)
 
 -- Set mode
 update _ state (SetMode mode) = do
diff --git a/src/Chelleport/Args.hs b/src/Chelleport/Args.hs
index 8c36c85..d01e94f 100644
--- a/src/Chelleport/Args.hs
+++ b/src/Chelleport/Args.hs
@@ -13,6 +13,6 @@ parseArgs (arg : args)
   | otherwise = Left $ "Unrecognized argument: " ++ arg
 
 updateMode :: String -> Configuration -> Either String Configuration
-updateMode "hints" cfg = Right cfg {configMode = defaultHintsMode}
-updateMode "search" cfg = Right cfg {configMode = defaultSearchMode}
+updateMode "hints" cfg = Right cfg {configMode = ModeHints def}
+updateMode "search" cfg = Right cfg {configMode = ModeSearch def}
 updateMode mode _ = Left $ "Invalid mode: " ++ mode
diff --git a/src/Chelleport/OCR.hs b/src/Chelleport/OCR.hs
index 3cd83ae..64c69e5 100644
--- a/src/Chelleport/OCR.hs
+++ b/src/Chelleport/OCR.hs
@@ -31,6 +31,7 @@ instance (MonadIO m) => MonadOCR (AppM m) where
       pure path
 
   getWordsInImage filePath = liftIO $ do
+    -- result `seq` pure result -- Strict eval
     findWordCoordinates filePath <* removeFile filePath
 
 findWordCoordinates :: String -> IO [OCRMatch]
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 3deb4a8..3224e6f 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -18,27 +18,33 @@ type KeySequence = [Char]
 
 type KeyGrid = [[Cell]]
 
-data Mode
-  = ModeHints
-  | ModeSearch
-      { searchWords :: [OCRMatch],
-        searchFilteredWords :: [OCRMatch],
-        searchInputText :: String,
-        searchHighlightedIndex :: Int
+data ModeSearchData = ModeSearchData
+  { searchWords :: [OCRMatch],
+    searchFilteredWords :: [OCRMatch],
+    searchInputText :: String,
+    searchHighlightedIndex :: Int
+  }
+  deriving (Show, Eq)
+
+instance Default ModeSearchData where
+  def =
+    ModeSearchData
+      { searchWords = [],
+        searchFilteredWords = [],
+        searchInputText = "",
+        searchHighlightedIndex = 0
       }
+
+data ModeHintsData = ModeHintsData
   deriving (Show, Eq)
 
-defaultSearchMode :: Mode
-defaultSearchMode =
-  ModeSearch
-    { searchWords = [],
-      searchFilteredWords = [],
-      searchInputText = "",
-      searchHighlightedIndex = 0
-    }
+instance Default ModeHintsData where
+  def = ModeHintsData
 
-defaultHintsMode :: Mode
-defaultHintsMode = ModeHints
+data Mode
+  = ModeHints {modeHintsData :: ModeHintsData}
+  | ModeSearch {modeSearchData :: ModeSearchData}
+  deriving (Show, Eq)
 
 data State = State
   { stateGrid :: KeyGrid,
@@ -62,7 +68,7 @@ instance Default State where
         stateIsDragging = False,
         stateRepetition = 1,
         stateIsModeInitialized = False,
-        stateMode = ModeHints
+        stateMode = ModeHints def
       }
 
 data Direction = DirUp | DirDown | DirLeft | DirRight
@@ -138,4 +144,4 @@ data Configuration = Configuration
   deriving (Show, Eq)
 
 instance Default Configuration where
-  def = Configuration {configMode = defaultHintsMode, configShowHelp = False}
+  def = Configuration {configMode = ModeHints def, configShowHelp = False}
diff --git a/src/Chelleport/View.hs b/src/Chelleport/View.hs
index 790b3f7..03c12d3 100644
--- a/src/Chelleport/View.hs
+++ b/src/Chelleport/View.hs
@@ -11,34 +11,29 @@ import Foreign.C (CInt)
 
 render :: (MonadDraw m) => State -> m ()
 render state = case stateMode state of
-  ModeHints -> renderHintsView state
-  ModeSearch {searchFilteredWords, searchHighlightedIndex} ->
-    renderSearchView state searchFilteredWords searchHighlightedIndex
+  ModeHints _ -> renderHintsView state
+  ModeSearch modeSearchData -> renderSearchView state modeSearchData
 
-getSearchText :: State -> String
-getSearchText state = case stateMode state of
-  ModeHints -> ""
-  ModeSearch {searchInputText, searchFilteredWords, searchHighlightedIndex} ->
+getSearchText :: State -> ModeSearchData -> String
+getSearchText state (ModeSearchData {searchInputText, searchFilteredWords, searchHighlightedIndex}) = searchText
+  where
     searchText
-    where
-      searchText
-        | stateIsModeInitialized state = "Searching (" ++ matchCount ++ "): " ++ searchInputText
-        | otherwise = "Loading..."
-      matchCount
-        | isEmpty searchFilteredWords = "0/0"
-        | otherwise = show (searchHighlightedIndex + 1) ++ "/" ++ show (length searchFilteredWords)
+      | stateIsModeInitialized state = "Searching (" ++ matchCount ++ "): " ++ searchInputText
+      | otherwise = "Loading..."
+    matchCount
+      | isEmpty searchFilteredWords = "0/0"
+      | otherwise = show (searchHighlightedIndex + 1) ++ "/" ++ show (length searchFilteredWords)
 
-renderSearchView :: (MonadDraw m) => State -> [OCRMatch] -> Int -> m ()
-renderSearchView state matches highlightedIndex = do
+renderSearchView :: (MonadDraw m) => State -> ModeSearchData -> m ()
+renderSearchView state searchData@(ModeSearchData {searchFilteredWords, searchHighlightedIndex}) = do
   renderGridLines state
 
-  forM_ (zip [0 ..] matches) $ \(index, OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do
-    setDrawColor $ if highlightedIndex == index then colorAccent else colorLightGray
+  forM_ (zip [0 ..] searchFilteredWords) $ \(index, OCRMatch {matchStartX, matchStartY, matchEndX, matchEndY}) -> do
+    setDrawColor $ if searchHighlightedIndex == index then colorAccent else colorLightGray
     fillRectVertices (matchStartX, matchStartY) (matchEndX, matchEndY)
 
   (w, h) <- windowSize
-  drawText (w `div` 2, h `div` 2) colorAccent FontSM (Text.pack $ getSearchText state)
-  pure ()
+  void $ drawText (w `div` 2, h `div` 2) colorWhite FontSM (Text.pack $ getSearchText state searchData)
 
 renderHintsView :: (MonadDraw m) => State -> m ()
 renderHintsView state = do