Add multi-key handling + command parsing + shell/shell! aliases

7 files changed, 224 insertions, 79 deletions

diff --git a/lib/Daffm/Action/Cmdline.hs b/lib/Daffm/Action/Cmdline.hs
index 12f7a9d..34e5e41 100644
--- a/lib/Daffm/Action/Cmdline.hs
+++ b/lib/Daffm/Action/Cmdline.hs
@@ -1,18 +1,18 @@
 module Daffm.Action.Cmdline where
 
-import Brick (suspendAndResume')
 import qualified Brick.Widgets.Edit as Editor
-import qualified Brick.Widgets.List as L
-import Control.Monad (unless, void)
-import Control.Monad.State (get, gets, modify)
-import Daffm.Action.Core (reloadDir)
-import Daffm.Types (AppEvent, AppState (..), FileInfo (..), FocusTarget (..))
-import Data.Char (isSpace)
-import qualified Data.Set as Set
+import Control.Monad.State (gets, modify)
+import qualified Control.Monad.State.Strict as StateStrict
+import Daffm.Types
+import Daffm.Utils (trimStart)
 import qualified Data.Text as Text
 import qualified Data.Text.Zipper as Z
 import qualified Data.Text.Zipper as Zipper
-import System.Process (callCommand, callProcess)
+
+getCmdlineText :: AppEvent Text.Text
+getCmdlineText = StateStrict.gets cmdtext
+  where
+    cmdtext = trimStart . Text.unlines . Editor.getEditContents . stateCmdlineEditor
 
 leaveCmdline :: AppEvent ()
 leaveCmdline = clearCmdline >> modify (\st -> st {stateFocusTarget = FocusMain})
@@ -27,50 +27,6 @@ setCmdlineText text =
 clearCmdline :: AppEvent ()
 clearCmdline = applyCmdlineEdit Z.clearZipper
 
-runCmdline :: AppEvent ()
-runCmdline = do
-  cmd <- gets (trimCmd . Editor.getEditContents . stateCmdlineEditor)
-  evaluateCommand cmd
-  leaveCmdline
-  where
-    trimCmd = Text.dropWhile isSpace . Text.dropWhileEnd isSpace . Text.unlines
-
-evaluateCommand :: Text.Text -> AppEvent ()
-evaluateCommand (Text.splitAt 2 -> ("!!", cmd)) = do
-  cmd' <- Text.unpack <$> cmdSubstitutions cmd
-  suspendAndResume' $ do
-    callCommand cmd'
-    putStrLn "Press any key to continue" >> void getChar
-  reloadDir
-evaluateCommand (Text.splitAt 1 -> ("!", cmd)) = do
-  cmd' <- Text.unpack <$> cmdSubstitutions cmd
-  suspendAndResume' $ callCommand cmd'
-  reloadDir
-evaluateCommand "delete" = do
-  (AppState {stateFileSelections, stateFiles}) <- get
-  let files =
-        if Set.null stateFileSelections
-          then maybe [] ((: []) . filePath . snd) $ L.listSelectedElement stateFiles
-          else Set.elems stateFileSelections
-  unless (null files) $ do
-    suspendAndResume' $ callProcess "rm" ("-rfi" : map Text.unpack files)
-  reloadDir
-evaluateCommand _cmd = pure ()
-
-cmdSubstitutions :: Text.Text -> AppEvent Text.Text
-cmdSubstitutions cmd = do
-  (AppState {stateFiles, stateCwd, stateFileSelections}) <- get
-  let file = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
-  let escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
-  let selections = Set.elems stateFileSelections
-  -- TODO: Escaping %
-  let subst =
-        Text.replace "%" file
-          . Text.replace "%d" stateCwd
-          . Text.replace "%s" (Text.unwords $ map escape selections)
-          . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
-  pure . subst $ cmd
-
 applyCmdlineEdit :: (Zipper.TextZipper Text.Text -> Zipper.TextZipper Text.Text) -> AppEvent ()
 applyCmdlineEdit zipper = do
   editor <- gets stateCmdlineEditor
diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs
new file mode 100644
index 0000000..91e21b6
--- /dev/null
+++ b/lib/Daffm/Action/Commands.hs
@@ -0,0 +1,95 @@
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+{-# HLINT ignore "Use for_" #-}
+module Daffm.Action.Commands where
+
+import Brick (suspendAndResume')
+import qualified Brick as M
+import qualified Brick.Widgets.List as L
+import Control.Monad (void)
+import Control.Monad.State (get)
+import Daffm.Action.Cmdline
+import Daffm.Action.Core
+import Daffm.Types
+import Daffm.Utils (trimStart)
+import Data.Bifunctor (Bifunctor (second))
+import Data.Char (isSpace)
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import System.Process (callCommand)
+
+parseCommand :: Text.Text -> Maybe Command
+parseCommand (Text.splitAt 2 -> ("!!", cmd)) = Just $ CmdShell True cmd
+parseCommand (Text.splitAt 1 -> ("!", cmd)) = Just $ CmdShell False cmd
+parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
+  where
+    splitCmdArgs = second trimStart . Text.splitAt cmdEndIdx
+    cmdEndIdx = fromMaybe (Text.length cmd) $ Text.findIndex isSpace cmd
+    mkCmd = \case
+      ("q", _) -> Just CmdQuit
+      ("quit", _) -> Just CmdQuit
+      ("shell!", cmd') -> Just $ CmdShell True cmd'
+      ("shell", cmd') -> Just $ CmdShell False cmd'
+      ("back", _) -> Just CmdGoBack
+      ("open", _) -> Just CmdOpenSelection
+      ("reload", _) -> Just CmdReload
+      ("cd", dir) -> Just $ CmdChangeDir dir
+      ("noop", _) -> Just CmdNoop
+      ("cmdline-enter", _) -> Just CmdEnterCmdline
+      ("cmdline-leave", _) -> Just CmdLeaveCmdline
+      ("cmdline-set", txt) -> Just $ CmdSetCmdline txt
+      ("selection-toggle", _) -> Just CmdToggleSelection
+      ("selection-clear", _) -> Just CmdClearSelection
+      _ -> Nothing
+
+processCommand :: Command -> AppEvent ()
+processCommand (CmdShell True cmd) = do
+  cmd' <- Text.unpack <$> cmdSubstitutions cmd
+  suspendAndResume' $ do
+    callCommand cmd'
+    putStrLn "Press any key to continue" >> void getChar
+  reloadDir
+processCommand (CmdShell False cmd) = do
+  cmd' <- Text.unpack <$> cmdSubstitutions cmd
+  suspendAndResume' $ callCommand cmd'
+  reloadDir
+processCommand CmdQuit = M.halt
+processCommand (CmdSetCmdline txt) = enterCmdline >> setCmdlineText txt
+processCommand CmdEnterCmdline = enterCmdline
+processCommand CmdLeaveCmdline = leaveCmdline
+processCommand CmdOpenSelection = openSelectedFile
+processCommand (CmdChangeDir dir) = changeDir dir
+processCommand CmdReload = reloadDir
+processCommand CmdToggleSelection = toggleCurrentFileSelection
+processCommand CmdClearSelection = clearFileSelections
+processCommand CmdGoBack = goBackToParentDir
+processCommand CmdNoop = pure ()
+
+cmdSubstitutions :: Text.Text -> AppEvent Text.Text
+cmdSubstitutions cmd = do
+  (AppState {stateFiles, stateCwd, stateFileSelections}) <- get
+  let file = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles
+  let escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'"
+  let selections = Set.elems stateFileSelections
+  let selectionsOrCurrent = if Set.null stateFileSelections then [file] else selections
+  let subst =
+        Text.replace "%" file
+          . Text.replace "%d" stateCwd
+          . Text.replace "%s" (Text.unwords $ map escape selections)
+          . Text.replace "%S" (Text.dropWhileEnd (== '\n') $ Text.unlines selections)
+          . Text.replace "%f" (Text.unwords $ map escape selectionsOrCurrent)
+          . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCurrent)
+  pure . subst $ cmd
+
+runCmdline :: AppEvent ()
+runCmdline = do
+  cmd <- getCmdlineText
+  leaveCmdline
+  evaluateCommand cmd
+
+evaluateCommand :: Text.Text -> AppEvent ()
+evaluateCommand cmdtxt =
+  case parseCommand cmdtxt of
+    Just cmd -> processCommand cmd
+    Nothing -> pure ()
diff --git a/lib/Daffm/Action/Core.hs b/lib/Daffm/Action/Core.hs
index 337801e..ce04073 100644
--- a/lib/Daffm/Action/Core.hs
+++ b/lib/Daffm/Action/Core.hs
@@ -32,10 +32,13 @@ goBackToParentDir = do
   dir <- gets stateParentDir
   loadDir dir (Text.pack . takeDirectory $ Text.unpack dir)
 
+changeDir :: FilePathText -> AppEvent ()
+changeDir dir = do
+  loadDir dir (Text.pack $ takeDirectory $ Text.unpack dir)
+
 goHome :: AppEvent ()
 goHome = do
-  dir <- liftIO getHomeDirectory
-  loadDir (Text.pack dir) (Text.pack $ takeDirectory dir)
+  liftIO getHomeDirectory >>= changeDir . Text.pack
 
 openSelectedFile :: AppEvent ()
 openSelectedFile = do
diff --git a/lib/Daffm/Event.hs b/lib/Daffm/Event.hs
index 247719b..262686b 100644
--- a/lib/Daffm/Event.hs
+++ b/lib/Daffm/Event.hs
@@ -1,42 +1,68 @@
 module Daffm.Event where
 
-import qualified Brick.Main as M
 import qualified Brick.Types as T
 import qualified Brick.Widgets.Edit as Editor
 import qualified Brick.Widgets.List as L
-import Control.Monad.State (gets, modify)
+import Control.Monad.State (get, gets, modify)
 import Daffm.Action.Cmdline
-import Daffm.Action.Core
+import Daffm.Action.Commands
 import Daffm.State (cacheDirPosition)
-import Daffm.Types (AppEvent, AppState (..), FocusTarget (..))
+import Daffm.Types (AppEvent, AppState (..), Command (..), FocusTarget (..), Key, KeyMatchResult (..), KeySequence, Keymap)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
 import qualified Graphics.Vty as V
 
 appEvent :: T.BrickEvent FocusTarget e -> AppEvent ()
 appEvent brickevent@(T.VtyEvent event) = do
   focusTarget <- gets stateFocusTarget
   case (focusTarget, event) of
-    (FocusMain, V.EvKey (V.KChar 'l') []) -> openSelectedFile
-    (FocusMain, V.EvKey (V.KChar 'h') []) -> goBackToParentDir
-    (FocusMain, V.EvKey V.KEnter []) -> openSelectedFile
-    (FocusMain, V.EvKey V.KBS []) -> goBackToParentDir
-    (FocusMain, V.EvKey (V.KChar '~') []) -> goHome
-    (FocusMain, V.EvKey (V.KChar ':') []) -> enterCmdline
-    (FocusMain, V.EvKey (V.KChar '!') []) -> setCmdlineText "!" >> enterCmdline
-    (FocusMain, V.EvKey (V.KChar 'q') []) -> M.halt
-    (FocusMain, V.EvKey (V.KChar 'r') [V.MCtrl]) -> reloadDir
-    (FocusMain, V.EvKey (V.KChar 'v') []) -> toggleCurrentFileSelection
-    (FocusMain, V.EvKey (V.KChar 'C') []) -> clearFileSelections
-    -- Just for testing
-    (FocusMain, V.EvKey (V.KChar 'p') [V.MCtrl]) -> evaluateCommand "!!chafa -f kitty %"
     (FocusCmdline, V.EvKey V.KEsc []) -> leaveCmdline
     (FocusCmdline, V.EvKey V.KEnter []) -> runCmdline
-    (FocusMain, _) -> do
-      files <- gets stateFiles
-      newFiles <- T.nestEventM' files (L.handleListEventVi L.handleListEvent event)
-      modify (\appState -> appState {stateFiles = newFiles})
     (FocusCmdline, _) -> do
       editor <- gets stateCmdlineEditor
       newEditor <- T.nestEventM' editor (Editor.handleEditorEvent brickevent)
       modify (\appState -> appState {stateCmdlineEditor = newEditor})
+    (FocusMain, V.EvKey key []) -> do
+      appendToKeySequence key
+      processKeySequence >>= \case
+        MatchFailure -> do
+          files <- gets stateFiles
+          newFiles <- T.nestEventM' files (L.handleListEventVi L.handleListEvent event)
+          modify (\appState -> appState {stateFiles = newFiles})
+        _ -> pure ()
+    (FocusMain, _) -> do
+      files <- gets stateFiles
+      newFiles <- T.nestEventM' files (L.handleListEventVi L.handleListEvent event)
+      modify (\appState -> appState {stateFiles = newFiles})
   modify cacheDirPosition
 appEvent _ = pure ()
+
+matchKeySequence :: Keymap -> KeySequence -> KeyMatchResult
+matchKeySequence keymaps keys
+  | Map.member keys keymaps =
+      MatchSuccess . fromMaybe CmdNoop $ Map.lookup keys keymaps
+  | otherwise = partial keymaps keys
+  where
+    partial _ [] = MatchFailure
+    partial (Map.null -> True) _ = MatchFailure
+    partial keymaps' keys' = if hasMatch then MatchPartial else MatchFailure
+      where
+        hasMatch = any (startsWith keys' . fst) (Map.toList keymaps')
+    startsWith ls1 ls2 = ls1 == take (length ls1) ls2
+
+processKeySequence :: AppEvent KeyMatchResult
+processKeySequence = do
+  (AppState {stateKeyMap, stateKeySequence}) <- get
+  let match = matchKeySequence stateKeyMap stateKeySequence
+  case match of
+    MatchSuccess cmd -> do
+      processCommand cmd
+      modify (\st -> st {stateKeySequence = []})
+    MatchPartial -> pure ()
+    MatchFailure -> do
+      modify (\st -> st {stateKeySequence = []})
+  pure match
+
+appendToKeySequence :: Key -> AppEvent ()
+appendToKeySequence key =
+  modify (\st -> st {stateKeySequence = stateKeySequence st <> [key]})
diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs
index beeb646..f45a154 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -4,7 +4,7 @@ import qualified Brick.Widgets.Edit as Editor
 import qualified Brick.Widgets.List as L
 import Control.Applicative ((<|>))
 import Control.Monad (filterM, forM)
-import Daffm.Types (AppState (..), FileInfo (..), FilePathText, FileType (..), FocusTarget (..))
+import Daffm.Types (AppState (..), Command (..), FileInfo (..), FilePathText, FileType (..), FocusTarget (..))
 import Data.List (findIndex, sortBy)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
@@ -12,6 +12,7 @@ import qualified Data.Set as Set
 import qualified Data.Text as Text
 import qualified Data.Text.Zipper.Generic as Zipper
 import qualified Data.Vector as Vec
+import qualified Graphics.Vty as K
 import System.Directory (listDirectory, makeAbsolute, setCurrentDirectory)
 import System.PosixCompat (fileExist)
 import qualified System.PosixCompat as Posix
@@ -28,8 +29,32 @@ mkEmptyAppState =
       stateListPositionCache = Map.empty,
       stateFileSelections = Set.empty,
       stateCwd = "",
-      stateParentDir = ""
+      stateParentDir = "",
+      stateKeyMap = defaultKeymaps,
+      stateKeySequence = []
     }
+  where
+    defaultKeymaps =
+      Map.fromList
+        [ ([K.KChar 'q'], CmdQuit),
+          ([K.KChar 'r', K.KChar 'r'], CmdReload),
+          ([K.KChar '!'], CmdSetCmdline "!"),
+          ([K.KChar ':'], CmdEnterCmdline),
+          ([K.KChar 'l'], CmdOpenSelection),
+          ([K.KChar 'h'], CmdGoBack),
+          ([K.KEnter], CmdOpenSelection),
+          ([K.KBS], CmdGoBack),
+          ([K.KChar 'v'], CmdToggleSelection),
+          ([K.KChar '\t'], CmdToggleSelection),
+          ([K.KChar 'C'], CmdClearSelection),
+          ([K.KChar '~'], CmdChangeDir "/home/imsohexy"),
+          ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "/home/imsohexy"),
+          ([K.KChar 'g', K.KChar 'd', K.KChar 'c'], CmdChangeDir "/home/imsohexy/Documents"),
+          ([K.KChar 'g', K.KChar 'd', K.KChar 'l'], CmdChangeDir "/home/imsohexy/Downloads"),
+          ([K.KChar 'g', K.KChar 'p'], CmdChangeDir "/home/imsohexy/Pictures"),
+          -- Just for testing
+          ([K.KChar 'p'], CmdShell True "chafa -f kitty %")
+        ]
 
 toggleSetItem :: (Ord a) => a -> Set.Set a -> Set.Set a
 toggleSetItem val set =
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index ffff4d0..953e3a8 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -6,6 +6,7 @@ import qualified Brick.Widgets.List as L
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import qualified Data.Text as Text
+import qualified Graphics.Vty as V
 import System.Posix.Types (FileMode, FileOffset)
 
 data FileType
@@ -39,10 +40,36 @@ data AppState = AppState
     stateFocusTarget :: FocusTarget,
     stateCwd :: FilePathText,
     stateListPositionCache :: Map.Map Text.Text Int,
-    stateParentDir :: FilePathText
+    stateParentDir :: FilePathText,
+    stateKeySequence :: KeySequence,
+    stateKeyMap :: Keymap
   }
   deriving (Show)
 
 type AppEvent = EventM FocusTarget AppState
 
 type CmdlineEditor = Editor.Editor Text.Text FocusTarget
+
+data KeyMatchResult = MatchSuccess Command | MatchPartial | MatchFailure
+  deriving (Show, Eq)
+
+data Command
+  = CmdShell Bool Text.Text
+  | CmdQuit
+  | CmdSetCmdline Text.Text
+  | CmdEnterCmdline
+  | CmdLeaveCmdline
+  | CmdOpenSelection
+  | CmdChangeDir Text.Text
+  | CmdReload
+  | CmdToggleSelection
+  | CmdClearSelection
+  | CmdGoBack
+  | CmdNoop
+  deriving (Show, Eq)
+
+type Key = V.Key
+
+type Keymap = Map.Map [Key] Command
+
+type KeySequence = [Key]
diff --git a/lib/Daffm/Utils.hs b/lib/Daffm/Utils.hs
new file mode 100644
index 0000000..af4e0b2
--- /dev/null
+++ b/lib/Daffm/Utils.hs
@@ -0,0 +1,13 @@
+module Daffm.Utils where
+
+import Data.Char (isSpace)
+import qualified Data.Text as Text
+
+trimStart :: Text.Text -> Text.Text
+trimStart = Text.dropWhile isSpace
+
+trimEnd :: Text.Text -> Text.Text
+trimEnd = Text.dropWhileEnd isSpace
+
+trim :: Text.Text -> Text.Text
+trim = trimStart . trimEnd