diff options
| -rw-r--r-- | README.md | 5 | ||||
| -rw-r--r-- | TODO.norg | 6 | ||||
| -rw-r--r-- | bin/Main.hs | 28 | ||||
| -rw-r--r-- | chelleport.cabal | 6 | ||||
| -rw-r--r-- | specs/Main.hs | 2 | ||||
| -rw-r--r-- | specs/Specs/AppStateSpec.hs | 17 | ||||
| -rw-r--r-- | specs/Specs/ArgsSpec.hs | 39 | ||||
| -rw-r--r-- | src/Chelleport.hs | 7 | ||||
| -rw-r--r-- | src/Chelleport/AppState.hs | 8 | ||||
| -rw-r--r-- | src/Chelleport/Args.hs | 18 | ||||
| -rw-r--r-- | src/Chelleport/Context.hs | 2 | ||||
| -rw-r--r-- | src/Chelleport/Types.hs | 10 |
12 files changed, 131 insertions, 17 deletions
@@ -46,6 +46,10 @@ https://github.com/user-attachments/assets/93ddc1ff-6cbe-4be4-9507-d68de880212a ## Usage Use [sxhkd](https://github.com/baskerville/sxhkd), [shotkey](https://github.com/phenax/shotkey), your window manager or any other key binding manager to set up a keybinding for `chelleport`. +### CLI +- `chelleport --help` to see help menu +- `chelleport -m <mode>` to start in given mode. Allowed `search` or `hints`. `hints` by default + ### Hints mode (`ctrl+t` to switch to hints mode) - With the grid open, type any of the key sequences shown on the grid to move the pointer there - Once a match is found, you can now use `hjkl` keys to make smaller movements. Hold `shift` + `hjkl` to move in bigger increments. @@ -55,6 +59,7 @@ Use [sxhkd](https://github.com/baskerville/sxhkd), [shotkey](https://github.com/ - Words that are recognized by OCR will be highlighted - Type the characters in one of the words to move the cursor to it - Press `ctrl+n` & `ctrl+p` to go to next/previous match respectively +- NOTE: The startup is a little slow currently taking ~1 second to run ocr. Will keep optimizing to get this down. ## Feedback and Support @@ -1,14 +1,14 @@ * Current - - ( ) CLI args - - ( ) TextStyle for drawText - - (-) Optimize speed of ocr - ( ) Sort ocr match result by position on screen (top to bottom, left to right) + - ( ) TextStyle for drawText - ( ) Middle click + - (-) Optimize speed of ocr * Later - ( ) Look into making mouse controls (click/mouse down/mouse up) cross-platform - ( ) Look into making screenshot cross-platform - ( ) Lens-ey setup for Mode access + - ( ) Support 4k screen resolution? * Maybe - ( ) Scroll diff --git a/bin/Main.hs b/bin/Main.hs index ebc9a39..007fb5e 100644 --- a/bin/Main.hs +++ b/bin/Main.hs @@ -1,6 +1,32 @@ module Main where import qualified Chelleport +import Chelleport.Args (Configuration (configShowHelp)) +import qualified Chelleport.Args as Args +import qualified System.Environment +import System.Exit (exitFailure) main :: IO () -main = Chelleport.run +main = do + args <- System.Environment.getArgs + case Args.parseArgs args of + Right config + | configShowHelp config -> showHelp + | otherwise -> Chelleport.run config + Left err -> do + showHelp + putStrLn $ "[Error] " ++ err + exitFailure + +showHelp :: IO () +showHelp = + putStrLn . unlines $ + [ "Control your mouse with your keyboard", + "See https://github.com/phenax/chelleport for more information", + "", + "Usage: chelleport [FLAGS]", + "", + "Flags:", + " --help: Help menu. This thing right here", + " -m <mode>, --mode <mode>: Run program in mode. (search | hints)" + ] diff --git a/chelleport.cabal b/chelleport.cabal index 24ee97f..8bfb27d 100644 --- a/chelleport.cabal +++ b/chelleport.cabal @@ -83,6 +83,7 @@ library lib-chelleport Chelleport Chelleport.AppShell Chelleport.AppState + Chelleport.Args Chelleport.Config Chelleport.Context Chelleport.Control @@ -102,9 +103,10 @@ test-suite specs other-modules: Mock TestUtils - Specs.KeySequenceSpec - Specs.AppStateSpec Specs.AppEventSpec + Specs.AppStateSpec + Specs.ArgsSpec + Specs.KeySequenceSpec Specs.ViewSpec build-depends: lib-chelleport, diff --git a/specs/Main.hs b/specs/Main.hs index 4af8694..36404fe 100644 --- a/specs/Main.hs +++ b/specs/Main.hs @@ -2,6 +2,7 @@ module Main (main) where import qualified Specs.AppEventSpec import qualified Specs.AppStateSpec +import qualified Specs.ArgsSpec import qualified Specs.KeySequenceSpec import qualified Specs.ViewSpec import Test.Hspec (hspec) @@ -10,5 +11,6 @@ main :: IO () main = hspec $ do Specs.AppEventSpec.test Specs.AppStateSpec.test + Specs.ArgsSpec.test Specs.KeySequenceSpec.test Specs.ViewSpec.test diff --git a/specs/Specs/AppStateSpec.hs b/specs/Specs/AppStateSpec.hs index de9d552..9864a0e 100644 --- a/specs/Specs/AppStateSpec.hs +++ b/specs/Specs/AppStateSpec.hs @@ -1,9 +1,11 @@ module Specs.AppStateSpec where import Chelleport.AppState (initialState, update) +import Chelleport.Args (Configuration (configMode)) import Chelleport.Types import Chelleport.Utils (uniq) import Control.Monad (join) +import Data.Default (Default (def)) import qualified SDL import Test.Hspec import TestUtils @@ -11,22 +13,31 @@ import TestUtils test :: SpecWith () test = do describe "#initialState" $ do + let config = def + it "returns the initial state of the app" $ do - ((initState, _), _) <- runWithMocks initialState + ((initState, _), _) <- runWithMocks $ initialState config stateKeySequence initState `shouldBe` [] stateIsMatched initState `shouldBe` False stateIsShiftPressed initState `shouldBe` False it "returns grid with 16x9 key sequences" $ do - ((initState, _), _) <- runWithMocks initialState + ((initState, _), _) <- runWithMocks $ initialState config length (stateGrid initState) `shouldBe` 9 stateGrid initState `shouldSatisfy` all ((== 16) . length) stateGrid initState `shouldSatisfy` all (all ((== 2) . length)) it "returns grid with all unique key sequences" $ do - ((initState, _), _) <- runWithMocks initialState + ((initState, _), _) <- runWithMocks $ initialState config join (stateGrid initState) `shouldBe` uniq (join $ stateGrid initState) + context "when config specifies mode" $ do + let currentConfig = config {configMode = defaultSearchMode} + + it "continues to set given mode" $ do + ((_, action), _) <- runWithMocks $ initialState currentConfig + action `shouldBe` Just (SetMode defaultSearchMode) + describe "#update" $ do let defaultState = defaultAppState {stateGrid = [["ABC", "DEF"], ["DJK", "JKL"]]} diff --git a/specs/Specs/ArgsSpec.hs b/specs/Specs/ArgsSpec.hs new file mode 100644 index 0000000..caaab75 --- /dev/null +++ b/specs/Specs/ArgsSpec.hs @@ -0,0 +1,39 @@ +module Specs.ArgsSpec where + +import Chelleport.Args (parseArgs) +import Chelleport.Types +import Data.Default (Default (def)) +import Test.Hspec + +test :: SpecWith () +test = do + describe "#parseArgs" $ do + context "when there are no args" $ do + it "parses default configuration" $ do + let config = parseArgs [] + config `shouldBe` Right def + + context "when args contains --help" $ do + it "enables show help without parsing the rest of the args" $ do + parseArgs ["--help"] `shouldBe` Right (def {configShowHelp = True}) + parseArgs ["--help", "-m", "mode"] `shouldBe` Right (def {configShowHelp = True}) + + 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}) + + context "when args contains -m or --mode with an invalid mode" $ do + it "returns with error message" $ do + parseArgs ["--mode", "invalidmode"] `shouldBe` Left "Invalid mode: invalidmode" + parseArgs ["-m", "invalidmode"] `shouldBe` Left "Invalid mode: invalidmode" + + context "when args contains -m or --mode without any mode" $ do + it "returns with error message" $ do + parseArgs ["--mode"] `shouldBe` Left "Missing value for mode" + + context "when args contains an invalid flag" $ do + it "enables show help without parsing the rest of the args" $ do + parseArgs ["--foobar"] `shouldBe` Left "Unrecognized argument: --foobar" 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} |