1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
|
{-# 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 qualified GHC.IO.Exception as Proc
import System.Exit (ExitCode)
import qualified System.Process as Proc
runCmdline :: AppEvent ()
runCmdline = do
cmd <- getCmdlineText
leaveCmdline
evaluateCommand cmd
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
-- Suspend tui and run shell command
-- When waitForKey is true, it will prompt for a key press on success
-- When exit code is non-zero, it will print it and prompt for key press regardless of waitForKey
suspendAndRunShellCommand :: Bool -> Text.Text -> AppEvent ()
suspendAndRunShellCommand waitForKey cmd = do
suspendAndResume' $ do
exitCode <- shellCommand $ Text.unpack cmd
case exitCode of
Proc.ExitFailure code -> do
putStrLn $ "Process exited with " <> show code
putStrLn "Press any key to continue" >> void getChar
_ | waitForKey -> putStrLn "Press any key to continue" >> void getChar
_ -> pure ()
processCommand :: Command -> AppEvent ()
processCommand (CmdShell waitForKey cmd) = do
cmdSubstitutions cmd >>= suspendAndRunShellCommand waitForKey
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 ()
shellCommand :: String -> IO ExitCode
shellCommand cmd = do
Proc.withCreateProcess
(Proc.shell cmd) {Proc.delegate_ctlc = True}
$ \_ _ _ p -> Proc.waitForProcess p
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
evaluateCommand :: Text.Text -> AppEvent ()
evaluateCommand cmdtxt =
case parseCommand cmdtxt of
Just cmd -> processCommand cmd
Nothing -> pure ()
|
