aboutsummaryrefslogtreecommitdiff
path: root/lib/Daffm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Daffm')
-rw-r--r--lib/Daffm/Action/Keymap.hs23
-rw-r--r--lib/Daffm/Configuration.hs20
-rw-r--r--lib/Daffm/Event.hs37
-rw-r--r--lib/Daffm/Keymap.hs47
-rw-r--r--lib/Daffm/State.hs10
-rw-r--r--lib/Daffm/Types.hs2
-rw-r--r--lib/Daffm/View.hs22
7 files changed, 98 insertions, 63 deletions
diff --git a/lib/Daffm/Action/Keymap.hs b/lib/Daffm/Action/Keymap.hs
new file mode 100644
index 0000000..4463446
--- /dev/null
+++ b/lib/Daffm/Action/Keymap.hs
@@ -0,0 +1,23 @@
+module Daffm.Action.Keymap where
+
+import Control.Monad.State (get, modify)
+import Daffm.Action.Commands
+import Daffm.Keymap (matchKeySequence)
+import Daffm.Types
+
+processKeySequence :: AppEvent KeyMatchResult
+processKeySequence = do
+ (AppState {stateKeyMap, stateKeySequence}) <- get
+ let match = matchKeySequence stateKeyMap stateKeySequence
+ case match of
+ MatchSuccess cmd -> do
+ processCommand cmd
+ modify (\st -> st {stateKeySequence = []})
+ MatchPartial -> pure ()
+ MatchFailure -> do
+ modify (\st -> st {stateKeySequence = []})
+ pure match
+
+appendToKeySequence :: Key -> AppEvent ()
+appendToKeySequence key =
+ modify (\st -> st {stateKeySequence = stateKeySequence st <> [key]})
diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
index 6128816..a27d616 100644
--- a/lib/Daffm/Configuration.hs
+++ b/lib/Daffm/Configuration.hs
@@ -3,13 +3,13 @@ module Daffm.Configuration where
import Control.Arrow (ArrowChoice (left))
import Control.Exception (throwIO)
import Daffm.Action.Commands (parseCommand)
+import Daffm.Keymap (parseKeySequence)
import Daffm.Types
import Data.Bifunctor (Bifunctor (bimap))
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 V
import Toml ((.=))
import qualified Toml
@@ -21,7 +21,7 @@ loadConfigFile = Text.readFile "./config.toml" >>= parse
Right c -> pure c
parseConfig :: Text.Text -> Either Text.Text Configuration
-parseConfig txt = left Toml.prettyTomlDecodeErrors $ Toml.decode configurationCodec txt
+parseConfig = left Toml.prettyTomlDecodeErrors . Toml.decode configurationCodec
configurationCodec :: Toml.TomlCodec Configuration
configurationCodec =
@@ -32,19 +32,5 @@ configurationCodec =
keymapCodec = Toml.dimap (const Map.empty) toKeymap . keymapRawCodec
keymapRawCodec = Toml.tableMap Toml._KeyText Toml.text
toKeymap = Map.fromList . map (bimap toKeys toCmd) . Map.toList
- toKeys = fromMaybe [] . parseKey
+ toKeys = fromMaybe [] . parseKeySequence
toCmd = fromMaybe CmdNoop . parseCommand
-
-parseKey :: Text.Text -> Maybe [Key]
-parseKey keytxt = parse keytxt []
- where
- -- TODO: Refactor using https://hackage-content.haskell.org/package/brick-2.9/docs/Brick-Keybindings-Parse.html#v:parseBinding
- parse k keys = case k of
- (Text.null -> True) -> pure keys
- (Text.splitAt 1 -> (c, rest)) -> case (c, rest) of
- ("<", Text.splitAt 4 -> (Text.toLower -> "tab>", rest')) -> parse rest' $ keys <> [V.KChar '\t']
- ("<", Text.splitAt 3 -> (Text.toLower -> "cr>", rest')) -> parse rest' $ keys <> [V.KEnter]
- ("<", Text.splitAt 4 -> (Text.toLower -> "esc>", rest')) -> parse rest' $ keys <> [V.KEsc]
- _ -> do
- ch <- fst <$> Text.uncons c
- parse rest $ keys <> [V.KChar ch]
diff --git a/lib/Daffm/Event.hs b/lib/Daffm/Event.hs
index 262686b..04f687b 100644
--- a/lib/Daffm/Event.hs
+++ b/lib/Daffm/Event.hs
@@ -3,13 +3,12 @@ module Daffm.Event where
import qualified Brick.Types as T
import qualified Brick.Widgets.Edit as Editor
import qualified Brick.Widgets.List as L
-import Control.Monad.State (get, gets, modify)
+import Control.Monad.State (gets, modify)
import Daffm.Action.Cmdline
import Daffm.Action.Commands
+import Daffm.Action.Keymap (appendToKeySequence, processKeySequence)
import Daffm.State (cacheDirPosition)
-import Daffm.Types (AppEvent, AppState (..), Command (..), FocusTarget (..), Key, KeyMatchResult (..), KeySequence, Keymap)
-import qualified Data.Map as Map
-import Data.Maybe (fromMaybe)
+import Daffm.Types (AppEvent, AppState (..), FocusTarget (..), KeyMatchResult (..))
import qualified Graphics.Vty as V
appEvent :: T.BrickEvent FocusTarget e -> AppEvent ()
@@ -36,33 +35,3 @@ appEvent brickevent@(T.VtyEvent event) = do
modify (\appState -> appState {stateFiles = newFiles})
modify cacheDirPosition
appEvent _ = pure ()
-
-matchKeySequence :: Keymap -> KeySequence -> KeyMatchResult
-matchKeySequence keymaps keys
- | Map.member keys keymaps =
- MatchSuccess . fromMaybe CmdNoop $ Map.lookup keys keymaps
- | otherwise = partial keymaps keys
- where
- partial _ [] = MatchFailure
- partial (Map.null -> True) _ = MatchFailure
- partial keymaps' keys' = if hasMatch then MatchPartial else MatchFailure
- where
- hasMatch = any (startsWith keys' . fst) (Map.toList keymaps')
- startsWith ls1 ls2 = ls1 == take (length ls1) ls2
-
-processKeySequence :: AppEvent KeyMatchResult
-processKeySequence = do
- (AppState {stateKeyMap, stateKeySequence}) <- get
- let match = matchKeySequence stateKeyMap stateKeySequence
- case match of
- MatchSuccess cmd -> do
- processCommand cmd
- modify (\st -> st {stateKeySequence = []})
- MatchPartial -> pure ()
- MatchFailure -> do
- modify (\st -> st {stateKeySequence = []})
- pure match
-
-appendToKeySequence :: Key -> AppEvent ()
-appendToKeySequence key =
- modify (\st -> st {stateKeySequence = stateKeySequence st <> [key]})
diff --git a/lib/Daffm/Keymap.hs b/lib/Daffm/Keymap.hs
new file mode 100644
index 0000000..aae4a95
--- /dev/null
+++ b/lib/Daffm/Keymap.hs
@@ -0,0 +1,47 @@
+module Daffm.Keymap where
+
+import Daffm.Types
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import qualified Data.Text as Text
+import qualified Graphics.Vty as V
+
+showKeySequence :: KeySequence -> Text.Text
+showKeySequence = Text.intercalate "" . map showKey
+
+-- TODO: More chars
+showKey :: Key -> Text.Text
+showKey (V.KChar ' ') = "<space>"
+showKey (V.KChar '\t') = "<tab>"
+showKey (V.KChar c) = Text.singleton c
+showKey V.KEnter = "<cr>"
+showKey V.KEsc = "<esc>"
+showKey V.KBS = "<bs>"
+showKey _ = ""
+
+matchKeySequence :: Keymap -> KeySequence -> KeyMatchResult
+matchKeySequence keymaps keys
+ | Map.member keys keymaps =
+ MatchSuccess . fromMaybe CmdNoop $ Map.lookup keys keymaps
+ | otherwise = partial keymaps keys
+ where
+ partial _ [] = MatchFailure
+ partial (Map.null -> True) _ = MatchFailure
+ partial keymaps' keys' = if hasMatch then MatchPartial else MatchFailure
+ where
+ hasMatch = any (startsWith keys' . fst) (Map.toList keymaps')
+ startsWith ls1 ls2 = ls1 == take (length ls1) ls2
+
+parseKeySequence :: Text.Text -> Maybe [Key]
+parseKeySequence keytxt = parse keytxt []
+ where
+ parse k keys = case k of
+ (Text.null -> True) -> pure keys
+ (Text.stripPrefix "<tab>" -> (Just rest')) -> parse rest' $ keys <> [V.KChar '\t']
+ (Text.stripPrefix "<space>" -> (Just rest')) -> parse rest' $ keys <> [V.KChar ' ']
+ (Text.stripPrefix "<bs>" -> (Just rest')) -> parse rest' $ keys <> [V.KBS]
+ (Text.stripPrefix "<cr>" -> (Just rest')) -> parse rest' $ keys <> [V.KEnter]
+ (Text.stripPrefix "<esc>" -> (Just rest')) -> parse rest' $ keys <> [V.KEsc]
+ (Text.splitAt 1 -> (c, rest)) -> do
+ ch <- fst <$> Text.uncons c
+ parse rest $ keys <> [V.KChar ch]
diff --git a/lib/Daffm/State.hs b/lib/Daffm/State.hs
index d1964dc..f04ebc9 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -27,7 +27,7 @@ mkEmptyAppState config =
{ stateFiles = L.list FocusMain (Vec.fromList []) 1,
stateCmdlineEditor = mkEditor "",
stateFocusTarget = FocusMain,
- stateListPositionCache = Map.empty,
+ stateListPositionHistory = Map.empty,
stateFileSelections = Set.empty,
stateCwd = "",
stateKeyMap = defaultKeymaps <> configKeymap config,
@@ -67,14 +67,14 @@ normalizePath (Text.splitAt 2 -> ("~/", rest)) = do
normalizePath dir = pure dir
loadDirToState :: FilePathText -> AppState -> IO AppState
-loadDirToState dir' appState@(AppState {stateCwd, stateListPositionCache}) = do
+loadDirToState dir' appState@(AppState {stateCwd, stateListPositionHistory}) = do
dir <- normalizePath dir'
doesDirectoryExist (Text.unpack dir) >>= \case
True -> do
setCurrentDirectory $ Text.unpack dir
files <- listFilesInDir dir
let prevDirPosM = findIndex ((== stateCwd) . filePath) files
- let cachedPosM = Map.lookup dir stateListPositionCache
+ let cachedPosM = Map.lookup dir stateListPositionHistory
let pos = fromMaybe 0 (cachedPosM <|> prevDirPosM)
let list = L.listMoveTo pos $ L.list FocusMain (Vec.fromList files) 1
pure $
@@ -123,9 +123,9 @@ listFilesInDir dir = do
sortBy fileSorter <$> forM files (getFileInfo . Text.pack)
cacheDirPosition :: AppState -> AppState
-cacheDirPosition appState@(AppState {stateListPositionCache, stateCwd, stateFiles}) =
+cacheDirPosition appState@(AppState {stateListPositionHistory, stateCwd, stateFiles}) =
appState
- { stateListPositionCache = Map.insert stateCwd pos stateListPositionCache
+ { stateListPositionHistory = Map.insert stateCwd pos stateListPositionHistory
}
where
pos = fromMaybe 0 $ L.listSelected stateFiles
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index ee25e44..bf98e1c 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -39,7 +39,7 @@ data AppState = AppState
stateFileSelections :: Set.Set FilePathText,
stateFocusTarget :: FocusTarget,
stateCwd :: FilePathText,
- stateListPositionCache :: Map.Map Text.Text Int,
+ stateListPositionHistory :: Map.Map Text.Text Int,
stateKeySequence :: KeySequence,
stateKeyMap :: Keymap
}
diff --git a/lib/Daffm/View.hs b/lib/Daffm/View.hs
index d3845ba..387fffc 100644
--- a/lib/Daffm/View.hs
+++ b/lib/Daffm/View.hs
@@ -1,10 +1,11 @@
module Daffm.View where
import Brick.Types (Widget)
-import Brick.Widgets.Core (Padding (Max, Pad), hBox, hLimit, padLeft, padRight, txt, vBox, vLimit, withAttr, (<+>))
+import Brick.Widgets.Core (Padding (Max, Pad), emptyWidget, hBox, hLimit, padLeft, padRight, str, txt, vBox, vLimit, withAttr, (<+>))
import Brick.Widgets.Edit (renderEditor)
import qualified Brick.Widgets.List as L
import Daffm.Attrs (directoryAttr, directorySelectedAttr, fileAttr, fileSelectedAttr)
+import Daffm.Keymap (showKeySequence)
import Daffm.Types (AppState (..), FileInfo (..), FileType (..), FocusTarget (..))
import Data.Int (Int64)
import qualified Data.Set as Set
@@ -79,14 +80,23 @@ fileNameView False (FileInfo {fileName}) = withAttr fileAttr $ txt fileName
cmdlineView :: AppState -> Widget FocusTarget
cmdlineView (AppState {stateFocusTarget = FocusCmdline, stateCmdlineEditor}) =
txt ":" <+> renderEditor (txt . Text.unlines) True stateCmdlineEditor
-cmdlineView (AppState {stateFiles}) =
- hBox [txt ":", padLeft Max $ padRight (Pad 1) posIndicator]
+cmdlineView (AppState {stateFocusTarget = FocusMain, stateFiles, stateFileSelections, stateKeySequence}) =
+ hBox
+ [ txt ":",
+ rightAligned [keysView, padLeft (Pad 2) selectionsCountView, padLeft (Pad 2) posIndicatorView]
+ ]
where
- posIndicator = txt $ cur <> "/" <> total
+ keysView = txt $ showKeySequence stateKeySequence
+ rightAligned = padLeft Max . padRight (Pad 1) . hBox
+ posIndicatorView = str $ cur <> "/" <> total
+ selectionsCountView =
+ if Set.null stateFileSelections
+ then emptyWidget
+ else str $ show $ Set.size stateFileSelections
cur = case L.listSelected stateFiles of
Nothing -> "-"
- Just n -> Text.pack $ show (n + 1)
- total = Text.pack $ show $ Vec.length $ L.listElements stateFiles
+ Just n -> show (n + 1)
+ total = show $ Vec.length $ L.listElements stateFiles
prettyFileSize :: Int64 -> Text.Text
prettyFileSize i