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

3 files changed, 109 insertions, 55 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