Add cli arg parsing for starting in given mode

5 files changed, 37 insertions, 8 deletions

diff --git a/src/Chelleport.hs b/src/Chelleport.hs
index 0f5569e..02977c9 100644
--- a/src/Chelleport.hs
+++ b/src/Chelleport.hs
@@ -2,6 +2,7 @@ module Chelleport where
 
 import Chelleport.AppShell (setupAppShell)
 import qualified Chelleport.AppState as AppState
+import Chelleport.Args (Configuration)
 import Chelleport.Context (initializeContext)
 import Chelleport.Control (anyAlphabetic, anyDigit, checkKey, ctrl, eventToKeycode, hjkl, hjklDirection, key, pressed, released, shift)
 import Chelleport.KeySequence (keycodeToInt, toKeyChar)
@@ -13,12 +14,12 @@ import Control.Monad.Reader (ReaderT (runReaderT))
 import Data.Maybe (fromMaybe)
 import qualified SDL
 
-run :: IO ()
-run = do
+run :: Configuration -> IO ()
+run config = do
   ctx <- initializeContext
   -- Cosplaying as elm
   runAppWithCtx ctx $
-    setupAppShell ctx AppState.initialState AppState.update eventHandler View.render
+    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
diff --git a/src/Chelleport/AppState.hs b/src/Chelleport/AppState.hs
index 8c7bac1..168cacf 100644
--- a/src/Chelleport/AppState.hs
+++ b/src/Chelleport/AppState.hs
@@ -1,6 +1,7 @@
 module Chelleport.AppState (initialState, update) where
 
 import Chelleport.AppShell (MonadAppShell (hideWindow, showWindow, shutdownApp))
+import Chelleport.Args (Configuration (configMode))
 import Chelleport.Control (MonadControl (..), directionalIncrement, hjklDirection)
 import Chelleport.Draw (MonadDraw (windowPosition, windowSize), pointerPositionIncrement, screenPositionFromCellPosition, wordPosition)
 import Chelleport.KeySequence (findMatchPosition, generateGrid, nextChars, toKeyChar)
@@ -12,10 +13,11 @@ import Data.Char (toLower)
 import Data.Maybe (isJust)
 import qualified Text.Fuzzy as Fuzzy
 
-initialState :: (Monad m) => m (State, Maybe AppAction)
-initialState = do
+initialState :: (Monad m) => Configuration -> m (State, Maybe AppAction)
+initialState config = do
   let cells = either error id $ generateGrid 0 (rows, columns) hintKeys
-  pure (defaultAppState {stateGrid = cells}, Just $ SetMode defaultHintsMode)
+  let action = Just $ SetMode $ configMode config
+  pure (defaultAppState {stateGrid = cells}, action)
   where
     rows = 9
     columns = 16
diff --git a/src/Chelleport/Args.hs b/src/Chelleport/Args.hs
new file mode 100644
index 0000000..8c36c85
--- /dev/null
+++ b/src/Chelleport/Args.hs
@@ -0,0 +1,18 @@
+module Chelleport.Args where
+
+import Chelleport.Types
+import Data.Default (Default (def))
+
+parseArgs :: [String] -> Either String Configuration
+parseArgs [] = Right def
+parseArgs (arg : args)
+  | arg `elem` ["-h", "--help"] = Right $ def {configShowHelp = True}
+  | arg `elem` ["-m", "--mode"] = case args of
+      [] -> Left "Missing value for mode"
+      (mode : rest) -> parseArgs rest >>= updateMode mode
+  | 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 mode _ = Left $ "Invalid mode: " ++ mode
diff --git a/src/Chelleport/Context.hs b/src/Chelleport/Context.hs
index 3109e05..53ad668 100644
--- a/src/Chelleport/Context.hs
+++ b/src/Chelleport/Context.hs
@@ -3,8 +3,6 @@ module Chelleport.Context (initializeContext) where
 import Chelleport.Config
 import Chelleport.Types
 import Data.ByteString (ByteString)
--- import Data.Time.Clock.System
--- import qualified Debug.Trace as Debug
 import Data.FileEmbed (embedFileRelative)
 import qualified Graphics.X11 as X11
 import SDL (($=))
diff --git a/src/Chelleport/Types.hs b/src/Chelleport/Types.hs
index 89b2e3d..ae05dad 100644
--- a/src/Chelleport/Types.hs
+++ b/src/Chelleport/Types.hs
@@ -1,6 +1,7 @@
 module Chelleport.Types where
 
 import Control.Monad.Reader (MonadIO, MonadReader, ReaderT)
+import Data.Default (Default (def))
 import Data.Vector.Storable (Storable)
 import Data.Word (Word8)
 import Foreign (Ptr, Storable (alignment, peek, poke, sizeOf), castPtr, nullPtr, plusPtr)
@@ -126,3 +127,12 @@ instance Storable OCRMatch where
 
   -- NOTE: Dont need poke
   poke _ _ = undefined
+
+data Configuration = Configuration
+  { configMode :: Mode,
+    configShowHelp :: Bool
+  }
+  deriving (Show, Eq)
+
+instance Default Configuration where
+  def = Configuration {configMode = defaultHintsMode, configShowHelp = False}