From a3cc21ebb749c1e5071d857990c6aaed0d182840 Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Fri, 24 Oct 2025 00:41:56 +0530 Subject: Add move command and gj gk keys --- lib/Daffm/Action/Commands.hs | 27 +++++++-- lib/Daffm/Action/Core.hs | 134 +++++++++++++++++++++---------------------- lib/Daffm/Configuration.hs | 38 ++++++++++++ lib/Daffm/State.hs | 13 +++-- lib/Daffm/Types.hs | 37 ++---------- 5 files changed, 137 insertions(+), 112 deletions(-) diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs index a6a55e6..669ff3c 100644 --- a/lib/Daffm/Action/Commands.hs +++ b/lib/Daffm/Action/Commands.hs @@ -4,9 +4,10 @@ module Daffm.Action.Commands where import qualified Brick as M +import qualified Brick.Widgets.List as L import Control.Monad (forM_) import Control.Monad.IO.Class (MonadIO (liftIO)) -import Control.Monad.State (modify) +import Control.Monad.State (gets, modify) import Daffm.Action.Cmdline import Daffm.Action.Core import Daffm.Keymap (parseKeySequence) @@ -27,8 +28,9 @@ runCmdline = do 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 (Text.stripPrefix "!!" -> Just cmd) = Just $ CmdShell True cmd +parseCommand (Text.stripPrefix "!" -> Just cmd) = Just $ CmdShell False cmd +parseCommand (Text.stripPrefix "/" -> Just term) = Just $ CmdSearch $ trim term parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd where splitCmdArgs = second trimStart . Text.break isSpace @@ -37,7 +39,7 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd ("quit", _) -> Just CmdQuit ("shell!", cmd') -> Just $ CmdShell True cmd' ("shell", cmd') -> Just $ CmdShell False cmd' - ("command-shell", cmd') -> Just $ CmdCommandShell cmd' + ("eval", cmd') -> Just $ CmdCommandShell cmd' ("back", _) -> Just CmdGoBack ("open", _) -> Just CmdOpenSelection ("reload", _) -> Just CmdReload @@ -51,6 +53,10 @@ parseCommand cmd = mkCmd . splitCmdArgs $ trimStart cmd ("search", term) -> Just $ CmdSearch $ trim term ("search-next", _) -> Just $ CmdSearchNext 1 ("search-prev", _) -> Just $ CmdSearchNext (-1) + ("move", Text.stripPrefix "$" -> Just _) -> Just $ CmdMove MoveToEnd + ("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", pos) -> Just . CmdMove . MoveTo . read $ Text.unpack pos ("map", Text.break isSpace -> (keysraw, cmdraw)) -> do keys <- parseKeySequence keysraw cmd' <- parseCommand $ trimStart cmdraw @@ -95,7 +101,18 @@ 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) = modify $ \s -> s {stateKeyMap = Map.insert keys command $ stateKeyMap s} +processCommand (CmdKeymapSet keys command) = + modify $ \st -> st {stateKeyMap = Map.insert keys command $ stateKeyMap st} +processCommand (CmdMove move) = moveCursor $ toUpdater move + where + toUpdater MoveToEnd = L.listMoveToEnd + toUpdater (MoveTo pos) = L.listMoveTo pos + 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 () evaluateCommand :: Text.Text -> AppEvent () diff --git a/lib/Daffm/Action/Core.hs b/lib/Daffm/Action/Core.hs index 72bccef..dc68c5d 100644 --- a/lib/Daffm/Action/Core.hs +++ b/lib/Daffm/Action/Core.hs @@ -25,24 +25,21 @@ modifyM f = get >>= f >>= put loadDir :: FilePathText -> AppEvent () loadDir dir = do modifyM (liftIO . (>>= filterInvalidSelections) . loadDirToState dir) - applySearch + applySearch -- Apply search after loading dir to update match indexes reloadDir :: AppEvent () -reloadDir = do - AppState {stateCwd} <- get - loadDir stateCwd +reloadDir = gets stateCwd >>= loadDir goBackToParentDir :: AppEvent () goBackToParentDir = do - dir <- gets (Text.pack . takeDirectory . Text.unpack . stateCwd) - loadDir dir + parentDir <- gets (Text.pack . takeDirectory . Text.unpack . stateCwd) + loadDir parentDir changeDir :: FilePathText -> AppEvent () changeDir = loadDir goHome :: AppEvent () -goHome = do - liftIO getHomeDirectory >>= changeDir . Text.pack +goHome = liftIO getHomeDirectory >>= changeDir . Text.pack openSelectedFile :: AppEvent () openSelectedFile = do @@ -54,99 +51,98 @@ openSelectedFile = do cmdSubstitutions opener >>= suspendAndRunShellCommand False Nothing -> pure () -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 "%" (escape file) - . Text.replace "%d" (escape 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 +cmdSubstitutions cmd = gets (`substitute` cmd) + where + escape = (\s -> "'" <> s <> "'") . Text.replace "'" "\\'" + substitute (AppState {stateFiles, stateCwd, stateFileSelections}) = + Text.replace "%" (escape cursorFile) + . Text.replace "%d" (escape 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 selectionsOrCursor) + . Text.replace "%F" (Text.dropWhileEnd (== '\n') $ Text.unlines selectionsOrCursor) + where + cursorFile = maybe "" (filePath . snd) . L.listSelectedElement $ stateFiles + selections = Set.elems stateFileSelections + selectionsOrCursor = if Set.null stateFileSelections then [cursorFile] else selections -- 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 + suspendAndResume' $ + shellCommand (Text.unpack cmd) >>= \case 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 () +shellCommand :: String -> IO Proc.ExitCode +shellCommand cmd = do + Proc.withCreateProcess + (Proc.shell cmd) {Proc.delegate_ctlc = True} + $ \_ _ _ p -> Proc.waitForProcess p + currentFile :: AppEvent (Maybe FileInfo) -currentFile = do - gets (fmap snd . L.listSelectedElement . stateFiles) +currentFile = gets (fmap snd . L.listSelectedElement . stateFiles) toggleCurrentFileSelection :: AppEvent () toggleCurrentFileSelection = do - currentFile >>= maybe (pure ()) (modify . toggleFileSelection . filePath) + currentFile >>= \case + Just fileInfo -> modify . toggleFileSelection . filePath $ fileInfo + Nothing -> pure () moveCurrent 1 clearFileSelections :: AppEvent () clearFileSelections = - modify $ \s -> s {stateFileSelections = Set.empty} + modify $ \st -> st {stateFileSelections = Set.empty} moveCurrent :: Int -> AppEvent () -moveCurrent count = do - files <- gets stateFiles - modify $ \s -> s {stateFiles = L.listMoveBy count files} +moveCurrent count = + modify $ \st -> st {stateFiles = L.listMoveBy count $ stateFiles st} setSearchTerm :: Text.Text -> AppEvent () -setSearchTerm "" = modify (\st -> st {stateSearchTerm = Nothing, stateSearchIndex = 0}) -setSearchTerm term = modify (\st -> st {stateSearchTerm = Just term, stateSearchIndex = 0}) +setSearchTerm "" = modify $ \st -> st {stateSearchTerm = Nothing, stateSearchIndex = 0} +setSearchTerm term = modify $ \st -> st {stateSearchTerm = Just term, stateSearchIndex = 0} applySearch :: AppEvent () -applySearch = get >>= apply +applySearch = get >>= search where - apply :: AppState -> AppEvent () - apply (AppState {stateSearchTerm = Nothing}) = - modify - (\st -> st {stateSearchMatches = Vec.empty, stateSearchIndex = 0}) - apply (AppState {stateSearchTerm = Just term, stateFiles}) = do - let search (_, FileInfo {fileName}) = Text.toLower term `Text.isInfixOf` Text.toLower fileName - let matches = Vec.map fst . Vec.filter search . Vec.indexed $ L.listElements stateFiles - modify - ( \st -> - st - { stateSearchMatches = matches, - stateSearchIndex = wrapSearchIndex st (stateSearchIndex st) - } - ) + search :: AppState -> AppEvent () + search (AppState {stateSearchTerm = Nothing}) = + modify $ \st -> st {stateSearchMatches = Vec.empty, stateSearchIndex = 0} + search (AppState {stateSearchTerm = Just term, stateFiles}) = + modify $ + \st -> + st + { stateSearchMatches = searchFiles stateFiles, + stateSearchIndex = wrapSearchIndex st $ stateSearchIndex st + } + where + isAMatch (FileInfo {fileName}) = Text.toLower term `Text.isInfixOf` Text.toLower fileName + searchFiles = Vec.map fst . Vec.filter (isAMatch . snd) . Vec.indexed . L.listElements nextSearchMatch :: AppEvent () -nextSearchMatch = do - st@(AppState {stateSearchMatches, stateFiles, stateSearchIndex}) <- get - let nextFiles = - if Vec.null stateSearchMatches - then stateFiles - else L.listMoveTo (stateSearchMatches Vec.! wrapSearchIndex st stateSearchIndex) stateFiles - modify (\st' -> st' {stateFiles = nextFiles}) +nextSearchMatch = + modify (\st -> st {stateFiles = forwardSearch st}) + where + forwardSearch st@(AppState {stateSearchMatches, stateFiles, stateSearchIndex}) = + if Vec.null stateSearchMatches + then stateFiles + else L.listMoveTo (stateSearchMatches Vec.! wrapSearchIndex st stateSearchIndex) stateFiles wrapSearchIndex :: AppState -> Int -> Int wrapSearchIndex (AppState {stateSearchMatches}) nextIndex = - let matchCount = length stateSearchMatches - in if - | nextIndex < 0 -> matchCount - 1 - | nextIndex >= matchCount && matchCount /= 0 -> nextIndex `mod` matchCount - | otherwise -> nextIndex + if + | nextIndex < 0 -> matchCount - 1 + | nextIndex >= matchCount && matchCount /= 0 -> nextIndex `mod` matchCount + | otherwise -> nextIndex + where + matchCount = length stateSearchMatches updateSearchIndex :: (Int -> Int) -> AppEvent () -updateSearchIndex upd = - modify (\st -> st {stateSearchIndex = wrapSearchIndex st $ upd $ stateSearchIndex st}) +updateSearchIndex update = + modify $ \st -> st {stateSearchIndex = wrapSearchIndex st $ update $ stateSearchIndex st} diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs index 9536007..884db36 100644 --- a/lib/Daffm/Configuration.hs +++ b/lib/Daffm/Configuration.hs @@ -15,11 +15,49 @@ import qualified Data.Map as Map import Data.Maybe (fromMaybe) import qualified Data.Text as Text import qualified Data.Text.IO as Text +import qualified Graphics.Vty as K import System.Directory (XdgDirectory (XdgConfig), getXdgDirectory) import System.FilePath (joinPath) import Toml ((.=)) import qualified Toml +defaultConfiguration :: Configuration +defaultConfiguration = + Configuration + { configKeymap = defaultKeymaps, + configOpener = Nothing, + configTheme = Map.empty, + configExtend = Nothing + } + +defaultKeymaps :: Keymap +defaultKeymaps = + Map.fromList + [ ([K.KChar 'q'], CmdQuit), + ([K.KChar 'r', K.KChar 'r'], CmdReload), + ([K.KChar '!'], CmdSetCmdline "!"), + ([K.KChar '/'], CmdSetCmdline "/"), + ([K.KChar 'n'], CmdSearchNext 1), + ([K.KChar 'N'], CmdSearchNext (-1)), + ([K.KChar ':'], CmdEnterCmdline), + ([K.KChar 'l'], CmdOpenSelection), + ([K.KChar 'h'], CmdGoBack), + ([K.KEnter], CmdOpenSelection), + ([K.KBS], CmdGoBack), + ([K.KChar 'v'], CmdToggleSelection), + ([K.KChar '\t'], CmdToggleSelection), + ([K.KChar 'C'], CmdClearSelection), + ([K.KChar '~'], CmdChangeDir "~"), + ([K.KChar '$'], CmdShell False "$SHELL"), + ([K.KChar 'g', K.KChar 'x'], CmdShell False "!xdg-open % >/dev/null 2>&1"), + ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "~"), + ([K.KChar 'g', K.KChar 'c', K.KChar 'f', K.KChar 'g'], CmdChangeDir "~/.config/daffm"), + ([K.KChar 'g', K.KChar 'g'], CmdMove $ MoveTo 0), + ([K.KChar 'g', K.KChar 'k'], CmdMove $ MoveTo 0), + ([K.KChar 'g', K.KChar 'j'], CmdMove MoveToEnd), + ([K.KChar 'G'], CmdMove MoveToEnd) + ] + getConfigDir :: IO FilePath getConfigDir = getXdgDirectory XdgConfig "daffm" diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs index 98b9aa9..cd8d6ec 100644 --- a/lib/Daffm/State.hs +++ b/lib/Daffm/State.hs @@ -3,11 +3,13 @@ {-# HLINT ignore "Redundant multi-way if" #-} module Daffm.State where +import Brick (suspendAndResume') import qualified Brick.Widgets.Edit as Editor import qualified Brick.Widgets.List as L import Control.Applicative ((<|>)) import Control.Exception (try) import Control.Monad (filterM, forM) +import qualified Debug.Trace as Debug import Daffm.Types import Daffm.Utils (trim) import Data.List (findIndex, sortBy) @@ -69,6 +71,7 @@ stripQuotes txt = fromMaybe txt (double <|> single) single = Text.stripPrefix "'" txt >>= Text.stripSuffix "'" stripTrailingSlash :: Text.Text -> Text.Text +stripTrailingSlash path@"/" = path stripTrailingSlash path = fromMaybe path $ Text.stripSuffix "/" path textAsString :: (String -> String) -> Text.Text -> Text.Text @@ -78,7 +81,7 @@ loadDirToState :: FilePathText -> AppState -> IO AppState loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do normalizedDir <- (normalizePath . stripTrailingSlash . stripQuotes . trim) dir' >>= withCwdFallback stat <- Posix.getFileStatus $ Text.unpack normalizedDir - let (dir, targetFilePathM) = + let (dir, targetFilePath) = if Posix.isDirectory stat then (normalizedDir, Nothing) else (textAsString takeDirectory normalizedDir, Just normalizedDir) @@ -86,10 +89,10 @@ loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = d True -> do setCurrentDirectory $ Text.unpack dir files <- listFilesInDir dir - let prevDirPosM = findIndex ((== stateCwd) . filePath) files - let cachedPosM = Map.lookup dir stateListPositionHistory - let targetFilePosM = targetFilePathM >>= \f -> findIndex ((== f) . filePath) files - let pos = fromMaybe 0 (targetFilePosM <|> cachedPosM <|> prevDirPosM) + let prevDirPos = findIndex ((== stateCwd) . filePath) files + let cachedPos = Map.lookup dir stateListPositionHistory + let targetFilePos = targetFilePath >>= \target -> findIndex ((== target) . filePath) files + let pos = fromMaybe 0 (targetFilePos <|> cachedPos <|> prevDirPos) let list = L.listMoveTo pos $ L.list FocusMain (Vec.fromList files) 1 pure $ appState {stateFiles = list, stateCwd = dir, stateSearchIndex = 0, stateSearchMatches = Vec.empty} False -> pure appState diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs index 3fd7086..d9dd977 100644 --- a/lib/Daffm/Types.hs +++ b/lib/Daffm/Types.hs @@ -8,7 +8,6 @@ import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Vector as Vec -import qualified Graphics.Vty as K import qualified Graphics.Vty as V import System.Posix.Types (FileMode, FileOffset) @@ -61,6 +60,9 @@ type CmdlineEditor = Editor.Editor Text.Text FocusTarget data KeyMatchResult = MatchSuccess Command | MatchPartial | MatchFailure deriving (Show, Eq) +data MoveInc = MoveDown Int | MoveUp Int | MoveTo Int | MoveToEnd + deriving (Show, Eq) + data Command = CmdShell Bool Text.Text | CmdCommandShell Text.Text @@ -78,6 +80,7 @@ data Command | CmdSearch Text.Text | CmdSearchNext Int | CmdKeymapSet [Key] Command + | CmdMove MoveInc | CmdNoop deriving (Show, Eq) @@ -110,35 +113,3 @@ data Args = Args } deriving (Show) -defaultConfiguration :: Configuration -defaultConfiguration = - Configuration - { configKeymap = defaultKeymaps, - configOpener = Nothing, - configTheme = Map.empty, - configExtend = Nothing - } - -defaultKeymaps :: Keymap -defaultKeymaps = - Map.fromList - [ ([K.KChar 'q'], CmdQuit), - ([K.KChar 'r', K.KChar 'r'], CmdReload), - ([K.KChar '!'], CmdSetCmdline "!"), - ([K.KChar '/'], CmdSetCmdline "search "), - ([K.KChar 'n'], CmdSearchNext 1), - ([K.KChar 'N'], CmdSearchNext (-1)), - ([K.KChar ':'], CmdEnterCmdline), - ([K.KChar 'l'], CmdOpenSelection), - ([K.KChar 'h'], CmdGoBack), - ([K.KEnter], CmdOpenSelection), - ([K.KBS], CmdGoBack), - ([K.KChar 'v'], CmdToggleSelection), - ([K.KChar '\t'], CmdToggleSelection), - ([K.KChar 'C'], CmdClearSelection), - ([K.KChar '~'], CmdChangeDir "~"), - ([K.KChar '$'], CmdShell False "$SHELL"), - ([K.KChar 'g', K.KChar 'x'], CmdShell False "!xdg-open % >/dev/null 2>&1"), - ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "~"), - ([K.KChar 'g', K.KChar 'c', K.KChar 'f', K.KChar 'g'], CmdChangeDir "~/.config/daffm") - ] -- cgit v1.3.1