From 424d65e53b99c65f07f36578e3d0975c4d093c0e Mon Sep 17 00:00:00 2001 From: Akshay Nair Date: Sun, 5 Oct 2025 22:21:42 +0530 Subject: Add extend config property to extend configs + move defaults --- lib/Daffm/Action/Commands.hs | 2 -- lib/Daffm/Configuration.hs | 22 ++++++++++++++++++---- lib/Daffm/Keymap.hs | 2 +- lib/Daffm/State.hs | 31 ++++++------------------------- lib/Daffm/Types.hs | 42 ++++++++++++++++++++++++++++++++++++++++-- notes.org | 14 +++++++------- 6 files changed, 72 insertions(+), 41 deletions(-) diff --git a/lib/Daffm/Action/Commands.hs b/lib/Daffm/Action/Commands.hs index 98fec9a..a9cf691 100644 --- a/lib/Daffm/Action/Commands.hs +++ b/lib/Daffm/Action/Commands.hs @@ -15,8 +15,6 @@ import Data.Char (isSpace) import Data.Maybe (fromMaybe) import qualified Data.Text as Text import qualified Data.Text.IO as Text -import qualified GHC.IO.Handle.Text as Proc -import System.Process (readProcessWithExitCode) import qualified System.Process as Proc runCmdline :: AppEvent () diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs index d3691cd..9536007 100644 --- a/lib/Daffm/Configuration.hs +++ b/lib/Daffm/Configuration.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-} + +{-# HLINT ignore "Use <=<" #-} module Daffm.Configuration where import Control.Applicative ((<|>)) @@ -35,12 +38,21 @@ resolveConfigPath (Just path) = pure path loadConfigFile :: Maybe String -> IO Configuration loadConfigFile pathM = do - resolveConfigPath pathM >>= (IO.try . Text.readFile) >>= foobar + cfgPath <- resolveConfigPath pathM + config <- load cfgPath + case configExtend config of + Just path -> do + baseCfgPath <- resolveConfigPath $ Just $ Text.unpack path + if baseCfgPath == cfgPath + then pure config + else (config <>) <$> load baseCfgPath + _ -> pure config where - foobar :: Either IOError Text.Text -> IO Configuration - foobar rawE = case rawE of + load = (>>= parseWithDefault) . IO.try . Text.readFile + parseWithDefault :: Either IOError Text.Text -> IO Configuration + parseWithDefault rawE = case rawE of Left _ -> pure defaultConfiguration - Right txt -> parse txt + Right txt -> (<> defaultConfiguration) <$> parse txt parse txt = case parseConfig txt of Left e -> throwIO $ userError $ show e Right c -> pure c @@ -53,9 +65,11 @@ configurationCodec = Configuration <$> (keymapCodec "keymap" .= configKeymap) <*> (openerCodec "opener" .= configOpener) + <*> (extendCodec "extend" .= configExtend) <*> pure Map.empty .= configTheme where openerCodec = Toml.dioptional . Toml.text + extendCodec = Toml.dioptional . Toml.text keymapCodec :: Toml.Key -> Toml.TomlCodec Keymap keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec diff --git a/lib/Daffm/Keymap.hs b/lib/Daffm/Keymap.hs index aae4a95..5e5856f 100644 --- a/lib/Daffm/Keymap.hs +++ b/lib/Daffm/Keymap.hs @@ -36,7 +36,7 @@ parseKeySequence :: Text.Text -> Maybe [Key] parseKeySequence keytxt = parse keytxt [] where parse k keys = case k of - (Text.null -> True) -> pure keys + "" -> pure keys (Text.stripPrefix "" -> (Just rest')) -> parse rest' $ keys <> [V.KChar '\t'] (Text.stripPrefix "" -> (Just rest')) -> parse rest' $ keys <> [V.KChar ' '] (Text.stripPrefix "" -> (Just rest')) -> parse rest' $ keys <> [V.KBS] diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs index 7601acd..210cd8d 100644 --- a/lib/Daffm/State.hs +++ b/lib/Daffm/State.hs @@ -13,33 +13,11 @@ import qualified Data.Set as Set import qualified Data.Text as Text import qualified Data.Text.Zipper.Generic as Zipper import qualified Data.Vector as Vec -import qualified Graphics.Vty as K import System.Directory (doesDirectoryExist, doesPathExist, getCurrentDirectory, getHomeDirectory, listDirectory, makeAbsolute, setCurrentDirectory) -import System.FilePath (joinPath, takeDirectory, takeFileName) +import System.FilePath (joinPath, takeDirectory) import System.PosixCompat (fileExist) import qualified System.PosixCompat as Posix -defaultKeymaps :: Keymap -defaultKeymaps = - Map.fromList - [ ([K.KChar 'q'], CmdQuit), - ([K.KChar 'r', K.KChar 'r'], CmdReload), - ([K.KChar '!'], CmdSetCmdline "!"), - ([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") - ] - mkEditor :: (Zipper.GenericTextZipper a) => a -> Editor.Editor a FocusTarget mkEditor = Editor.editor FocusCmdline (Just 1) @@ -52,7 +30,7 @@ mkEmptyAppState config = stateListPositionHistory = Map.empty, stateFileSelections = Set.empty, stateCwd = "", - stateKeyMap = configKeymap config <> defaultKeymaps, + stateKeyMap = configKeymap config, stateOpenerScript = configOpener config, stateKeySequence = [] } @@ -82,12 +60,15 @@ stripQuotes txt = fromMaybe txt (double <|> single) double = Text.stripPrefix "\"" txt >>= Text.stripSuffix "\"" single = Text.stripPrefix "'" txt >>= Text.stripSuffix "'" +stripTrailingSlash :: Text.Text -> Text.Text +stripTrailingSlash path = fromMaybe path $ Text.stripSuffix "/" path + textAsString :: (String -> String) -> Text.Text -> Text.Text textAsString f = Text.pack . f . Text.unpack loadDirToState :: FilePathText -> AppState -> IO AppState loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do - normalizedDir <- (normalizePath . stripQuotes . trim) dir' >>= withCwdFallback + normalizedDir <- (normalizePath . stripTrailingSlash . stripQuotes . trim) dir' >>= withCwdFallback stat <- Posix.getSymbolicLinkStatus $ Text.unpack normalizedDir let (dir, targetFilePathM) = if Posix.isDirectory stat diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs index 5133c2b..eb9d9a5 100644 --- a/lib/Daffm/Types.hs +++ b/lib/Daffm/Types.hs @@ -3,9 +3,11 @@ module Daffm.Types where import Brick (EventM) import qualified Brick.Widgets.Edit as Editor import qualified Brick.Widgets.List as L +import Control.Applicative ((<|>)) import qualified Data.Map as Map import qualified Data.Set as Set import qualified Data.Text as Text +import qualified Graphics.Vty as K import qualified Graphics.Vty as V import System.Posix.Types (FileMode, FileOffset) @@ -78,10 +80,46 @@ type KeySequence = [Key] data Configuration = Configuration { configKeymap :: !Keymap, - configOpener :: Maybe Text.Text, + configOpener :: !(Maybe Text.Text), + configExtend :: !(Maybe Text.Text), configTheme :: !(Map.Map Text.Text Text.Text) } deriving (Show) +instance Semigroup Configuration where + a <> b = + a + { configKeymap = configKeymap a <> configKeymap b, + configOpener = configOpener a <|> configOpener b, + configTheme = configTheme a <> configTheme b + } + defaultConfiguration :: Configuration -defaultConfiguration = Configuration {configKeymap = Map.empty, configOpener = Nothing, configTheme = Map.empty} +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 ':'], 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") + ] diff --git a/notes.org b/notes.org index 7b5d4d5..d25d8b5 100644 --- a/notes.org +++ b/notes.org @@ -25,20 +25,20 @@ - [X] Fix cmd substitution for all command args - [X] Command: command-shell special variant of shell that evaluates output as commands - [X] Given file name, open dir of file with cursor on file +- [X] Config extend (extend = true will extend config.toml) +- [ ] Finish nvim integration +- [ ] Command: search, search-next, search-prev - [ ] Store last directory path (for auto cd in shell) - [ ] Store selections path (for copy/move/paste across instances) -- [ ] Command: search, search-next, search-prev ** Right after -- [ ] Cmdline history -- [ ] Command: pipe (think about this) (pipe selection file names/file contents) +- [ ] cmdline tab completion - [ ] Allow escaping % in commands -- [ ] Rethink % substituions - [ ] theme from config +- [ ] Cmdline history +- [ ] Rethink % substituions - [ ] cd into dir symlinks -- [ ] Fix keymap evaluation? (If vd is bound, it doesnt evaluate a v binding) -- [ ] Config extend (extend = true will extend config.toml) ** Later -- [ ] cmdline tab completion +- [ ] Fix keymap evaluation? (If vd is bound, it doesnt evaluate a v binding) - [ ] Allow escaping % in commands - [ ] watch for changes - [ ] bind command: define keybindings -- cgit v1.3.1