From 332fed0c0936a48b5cb68ebd7b2dc4d96003008e Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sun, 5 Oct 2025 15:28:56 +0530 Subject: Add opener script in config --- lib/Daffm/Action/Commands.hs | 44 ------------------------------------- lib/Daffm/Action/Core.hs | 52 ++++++++++++++++++++++++++++++++++++-------- lib/Daffm/Configuration.hs | 7 +++++- lib/Daffm/State.hs | 1 + lib/Daffm/Types.hs | 2 ++ 5 files changed, 52 insertions(+), 54 deletions(-) (limited to 'lib') diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs index e904bf5..a9b706f 100644 --- a/lib/Daffm/Action/Commands.hs +++ b/lib/Daffm/Action/Commands.hs @@ -3,11 +3,7 @@ {-# 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 @@ -15,11 +11,7 @@ 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 @@ -51,20 +43,6 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd ("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 @@ -81,28 +59,6 @@ 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 diff --git a/lib/Daffm/Action/Core.hs b/lib/Daffm/Action/Core.hs index fef6b36..f80e41a 100644 --- a/lib/Daffm/Action/Core.hs +++ b/lib/Daffm/Action/Core.hs @@ -6,14 +6,17 @@ module Daffm.Action.Core where import Brick (suspendAndResume') import qualified Brick.Widgets.List as L +import Control.Monad (void) import Control.Monad.State (MonadIO (liftIO), MonadState, get, gets, modify, put) import Daffm.State import Daffm.Types (AppEvent, AppState (..), FileInfo (..), FilePathText, FileType (..)) +import Data.Maybe (fromMaybe) import qualified Data.Set as Set import qualified Data.Text as Text import System.Directory (getHomeDirectory) +import qualified System.Exit as Proc import System.FilePath (takeDirectory) -import System.Process (callProcess) +import qualified System.Process as Proc modifyM :: (MonadState s m) => (s -> m s) -> m () modifyM f = get >>= f >>= put @@ -33,8 +36,7 @@ goBackToParentDir = do loadDir dir changeDir :: FilePathText -> AppEvent () -changeDir dir = do - loadDir dir +changeDir = loadDir goHome :: AppEvent () goHome = do @@ -43,15 +45,47 @@ goHome = do openSelectedFile :: AppEvent () openSelectedFile = do currentFile >>= \case - Just file -> openFile file + Just (FileInfo {filePath, fileType = Directory}) -> loadDir filePath + Just _ -> do + opener <- gets (fromMaybe "echo '%F' | xargs -i xdg-open {}" . stateOpenerScript) + cmdSubstitutions opener >>= suspendAndRunShellCommand False Nothing -> pure () -openFile :: FileInfo -> AppEvent () -openFile (FileInfo {filePath, fileType = Directory}) = loadDir filePath -openFile (FileInfo {filePath, fileType}) = do +shellCommand :: String -> IO Proc.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 + +-- 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 - putStrLn $ "Opening " <> show fileType <> ": " <> Text.unpack filePath - callProcess "nvim" [Text.unpack filePath] + 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 () currentFile :: AppEvent (Maybe FileInfo) currentFile = do diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs index a27d616..cc4749d 100644 --- a/lib/Daffm/Configuration.hs +++ b/lib/Daffm/Configuration.hs @@ -27,9 +27,14 @@ configurationCodec :: Toml.TomlCodec Configuration configurationCodec = Configuration <$> (keymapCodec "keymap" .= configKeymap) + <*> (openerCodec "opener" .= configOpener) <*> pure Map.empty .= configTheme where - keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec + openerCodec = Toml.dioptional . Toml.text + +keymapCodec :: Toml.Key -> Toml.TomlCodec Keymap +keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec + where keymapRawCodec = Toml.tableMap Toml._KeyText Toml.text toKeymap = Map.fromList . map (bimap toKeys toCmd) . Map.toList toKeys = fromMaybe [] . parseKeySequence diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs index f04ebc9..52ac7a0 100644 --- a/lib/Daffm/State.hs +++ b/lib/Daffm/State.hs @@ -31,6 +31,7 @@ mkEmptyAppState config = stateFileSelections = Set.empty, stateCwd = "", stateKeyMap = defaultKeymaps <> configKeymap config, + stateOpenerScript = configOpener config, stateKeySequence = [] } where diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs index bf98e1c..39ad5a0 100644 --- a/lib/Daffm/Types.hs +++ b/lib/Daffm/Types.hs @@ -41,6 +41,7 @@ data AppState = AppState stateCwd :: FilePathText, stateListPositionHistory :: Map.Map Text.Text Int, stateKeySequence :: KeySequence, + stateOpenerScript :: Maybe Text.Text, stateKeyMap :: Keymap } deriving (Show) @@ -75,6 +76,7 @@ type KeySequence = [Key] data Configuration = Configuration { configKeymap :: !Keymap, + configOpener :: Maybe Text.Text, configTheme :: !(Map.Map Text.Text Text.Text) } deriving (Show) -- cgit v1.3.1