Add custom commands

5 files changed, 53 insertions, 32 deletions

diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs
index c77a9fc..5538eec 100644
--- a/lib/Daffm/Action/Commands.hs
+++ b/lib/Daffm/Action/Commands.hs
@@ -62,10 +62,10 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd
       ("move", Text.stripPrefix "+" -> Just inc) -> Just . CmdMove . MoveDown . read $ Text.unpack inc
       ("move", Text.stripPrefix "-" -> Just inc) -> Just . CmdMove . MoveUp . read $ Text.unpack inc
       ("move", readMaybe . Text.unpack -> Just pos) -> Just . CmdMove . MoveTo $ pos
-      _ -> Nothing
+      (cmd', args) -> Just $ CmdCustom cmd' args
 
-readCommandLines' :: Text.Text -> IO [Text.Text]
-readCommandLines' cmd = do
+readCommandLines :: Text.Text -> IO [Text.Text]
+readCommandLines cmd = do
   Proc.withCreateProcess
     (Proc.shell $ Text.unpack cmd)
       { Proc.delegate_ctlc = True,
@@ -77,47 +77,55 @@ readCommandLines' cmd = do
       _ <- Proc.waitForProcess p
       Text.lines <$> maybe (pure "") Text.hGetContents stdout
 
-processCommand :: Command -> AppEvent ()
-processCommand (CmdShell waitForKey cmd) = do
-  cmdSubstitutions cmd >>= suspendAndRunShellCommand waitForKey
+argSubst :: Text.Text -> Text.Text -> Text.Text
+argSubst = Text.replace "%args"
+
+processCommand :: Command -> CustomArgs -> AppEvent ()
+processCommand (CmdShell waitForKey cmd) args = do
+  cmdSubstitutions (argSubst args cmd) >>= suspendAndRunShellCommand waitForKey
   reloadDir
-processCommand (CmdCommandShell cmd) = do
-  stdout <- cmdSubstitutions cmd >>= liftIO . readCommandLines'
+processCommand (CmdCommandShell cmd) args = do
+  stdout <- cmdSubstitutions (argSubst args cmd) >>= liftIO . readCommandLines
   forM_ stdout runIfCmd
   reloadDir
   where
     runIfCmd (Text.stripPrefix "<daffm>" -> Just cmd') =
-      processCommand $ fromMaybe CmdNoop (parseCommand cmd')
+      processCommand (fromMaybe CmdNoop (parseCommand cmd')) args
     runIfCmd _ = pure ()
-processCommand CmdQuit = M.halt
-processCommand (CmdSetCmdline txt) = enterCmdline >> cmdSubstitutions txt >>= setCmdlineText
-processCommand CmdEnterCmdline = enterCmdline
-processCommand CmdLeaveCmdline = leaveCmdline
-processCommand CmdOpenSelection = openSelectedFile
-processCommand (CmdChangeDir dir) = cmdSubstitutions dir >>= changeDir
-processCommand CmdReload = reloadDir
-processCommand CmdToggleSelection = toggleCurrentFileSelection
-processCommand CmdClearSelection = clearFileSelections
-processCommand CmdGoBack = goBackToParentDir
-processCommand (CmdChain chain) = forM_ chain processCommand
-processCommand (CmdSearch term) = setSearchTerm term >> applySearch >> nextSearchMatch
-processCommand (CmdSearchNext change) = updateSearchIndex (+ change) >> nextSearchMatch
-processCommand (CmdKeymapSet keys command) =
+processCommand CmdQuit _args = M.halt
+processCommand (CmdSetCmdline txt) args = enterCmdline >> cmdSubstitutions (argSubst args txt) >>= setCmdlineText
+processCommand CmdEnterCmdline _args = enterCmdline
+processCommand CmdLeaveCmdline _args = leaveCmdline
+processCommand CmdOpenSelection _args = openSelectedFile
+processCommand (CmdChangeDir dir) args = cmdSubstitutions (argSubst args dir) >>= changeDir
+processCommand CmdReload _args = reloadDir
+processCommand CmdToggleSelection _args = toggleCurrentFileSelection
+processCommand CmdClearSelection _args = clearFileSelections
+processCommand CmdGoBack _ = goBackToParentDir
+processCommand (CmdChain chain) args = forM_ chain (`processCommand` args)
+processCommand (CmdSearch term) _ = setSearchTerm term >> applySearch >> nextSearchMatch
+processCommand (CmdSearchNext change) _ = updateSearchIndex (+ change) >> nextSearchMatch
+processCommand (CmdKeymapSet keys command) _ =
   modify $ \st -> st {stateKeyMap = Map.insert keys command $ stateKeyMap st}
-processCommand (CmdMove move) = moveCursor $ toUpdater move
+processCommand (CmdMove move) _ = moveCursor $ toUpdater move
   where
     toUpdater MoveToEnd = L.listMoveToEnd
     toUpdater (MoveTo pos) = L.listMoveTo pos
-    toUpdater (MoveUp inc) = L.listMoveBy $ - inc
+    toUpdater (MoveUp inc) = L.listMoveBy $ -inc
     toUpdater (MoveDown inc) = L.listMoveBy inc
     moveCursor :: (L.List FocusTarget FileInfo -> L.List FocusTarget FileInfo) -> AppEvent ()
     moveCursor updater = do
       files <- gets $ updater . stateFiles
       modify $ \st -> st {stateFiles = files}
-processCommand CmdNoop = pure ()
+processCommand (CmdCustom cmd args) _ = do
+  myCmd <- gets $ Map.lookup cmd . stateCustomCommands
+  case myCmd of
+    Just command -> processCommand command args
+    Nothing -> pure ()
+processCommand CmdNoop _ = pure ()
 
 evaluateCommand :: Text.Text -> AppEvent ()
 evaluateCommand cmdtxt =
   case parseCommand cmdtxt of
-    Just cmd -> processCommand cmd
+    Just cmd -> processCommand cmd ""
     Nothing -> pure ()
diff --git a/lib/Daffm/Action/Keymap.hs b/lib/Daffm/Action/Keymap.hs
index 4463446..c3079c9 100644
--- a/lib/Daffm/Action/Keymap.hs
+++ b/lib/Daffm/Action/Keymap.hs
@@ -11,7 +11,7 @@ processKeySequence = do
   let match = matchKeySequence stateKeyMap stateKeySequence
   case match of
     MatchSuccess cmd -> do
-      processCommand cmd
+      processCommand cmd ""
       modify (\st -> st {stateKeySequence = []})
     MatchPartial -> pure ()
     MatchFailure -> do
diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
index 3b61d6e..ee8f88e 100644
--- a/lib/Daffm/Configuration.hs
+++ b/lib/Daffm/Configuration.hs
@@ -26,7 +26,7 @@ defaultConfiguration =
   Configuration
     { configKeymap = defaultKeymaps,
       configOpener = Nothing,
-      configTheme = Map.empty,
+      configCommands = Map.empty,
       configExtend = Nothing
     }
 
@@ -102,7 +102,7 @@ configurationCodec =
     <$> (keymapCodec "keymap" .= configKeymap)
     <*> (openerCodec "opener" .= configOpener)
     <*> (extendCodec "extend" .= configExtend)
-    <*> pure Map.empty .= configTheme
+    <*> (commandsCodec "commands" .= configCommands)
   where
     openerCodec = Toml.dioptional . Toml.text
     extendCodec = Toml.dioptional . Toml.text
@@ -118,3 +118,11 @@ keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec
     commandCodec k = cmdCodec k <|> cmdChainCodec k
     cmdCodec = Toml.dimap (const "") toCmd . Toml.text
     cmdChainCodec = Toml.dimap (const []) (CmdChain . map toCmd) . Toml.arrayOf Toml._Text
+
+commandsCodec :: Toml.Key -> Toml.TomlCodec (Map.Map Text.Text Command)
+commandsCodec = Toml.tableMap Toml._KeyText commandCodec
+  where
+    toCmd = fromMaybe CmdNoop . parseCommand
+    commandCodec k = cmdCodec k <|> cmdChainCodec k
+    cmdCodec = Toml.dimap (const "") toCmd . Toml.text
+    cmdChainCodec = Toml.dimap (const []) (CmdChain . map toCmd) . Toml.arrayOf Toml._Text
diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs
index 6d7f6ea..040d244 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -39,6 +39,7 @@ mkEmptyAppState config =
       stateKeySequence = [],
       stateSearchTerm = Nothing,
       stateSearchMatches = Vec.empty,
+      stateCustomCommands = configCommands config,
       stateSearchIndex = 0
     }
 
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index d9dd977..15c284b 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -40,6 +40,7 @@ data FocusTarget = FocusCmdline | FocusMain deriving (Show, Eq, Ord)
 data AppState = AppState
   { stateCmdlineEditor :: CmdlineEditor,
     stateCwd :: FilePathText,
+    stateCustomCommands :: Map.Map Text.Text Command,
     stateFileSelections :: Set.Set FilePathText,
     stateFiles :: L.List FocusTarget FileInfo,
     stateFocusTarget :: FocusTarget,
@@ -53,6 +54,8 @@ data AppState = AppState
   }
   deriving (Show)
 
+type CustomArgs = Text.Text
+
 type AppEvent = EventM FocusTarget AppState
 
 type CmdlineEditor = Editor.Editor Text.Text FocusTarget
@@ -81,6 +84,7 @@ data Command
   | CmdSearchNext Int
   | CmdKeymapSet [Key] Command
   | CmdMove MoveInc
+  | CmdCustom Text.Text CustomArgs
   | CmdNoop
   deriving (Show, Eq)
 
@@ -94,7 +98,7 @@ data Configuration = Configuration
   { configKeymap :: !Keymap,
     configOpener :: !(Maybe Text.Text),
     configExtend :: !(Maybe Text.Text),
-    configTheme :: !(Map.Map Text.Text Text.Text)
+    configCommands :: !(Map.Map Text.Text Command)
   }
   deriving (Show)
 
@@ -103,7 +107,7 @@ instance Semigroup Configuration where
     a
       { configKeymap = configKeymap a <> configKeymap b,
         configOpener = configOpener a <|> configOpener b,
-        configTheme = configTheme a <> configTheme b
+        configCommands = configCommands a <> configCommands b
       }
 
 data Args = Args