aboutsummaryrefslogtreecommitdiff
path: root/lib/Daffm/Action/Commands.hs
blob: 91e21b6c767b3aa11ab769d3f27cc2d6e597af99 (plain) (blame)
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
{-# 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 ()