Show keyseq,selections in statusline + minor refactor

11 files changed, 108 insertions, 70 deletions

diff --git a/config.toml b/config.toml
index cdd7d94..bd1179e 100644
--- a/config.toml
+++ b/config.toml
@@ -5,3 +5,5 @@ gp = "cd ~/Pictures"
 gsc = "cd ~/Pictures/screenshots"
 dd = "!rm -rfi %f"
 pi = "!!clear; chafa -f kitty %"
+md = "cmdline-set !mkdir -p "
+mf = "cmdline-set !touch "
diff --git a/daffm.cabal b/daffm.cabal
index 7a1eeec..7d677cd 100644
--- a/daffm.cabal
+++ b/daffm.cabal
@@ -63,9 +63,11 @@ library lib-daffm
     Daffm.Action.Cmdline
     Daffm.Action.Commands
     Daffm.Action.Core
+    Daffm.Action.Keymap
     Daffm.Attrs
     Daffm.Configuration
     Daffm.Event
+    Daffm.Keymap
     Daffm.State
     Daffm.Types
     Daffm.Utils
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
diff --git a/notes.org b/notes.org
index 82f75b8..4a3b637 100644
--- a/notes.org
+++ b/notes.org
@@ -16,10 +16,10 @@
 - [X] configuration file (toml?)
 - [X] Error handling
 - [X] Expand ~ to home in internal commands (cd)
+- [X] Show current pending keys in statusline
+- [ ] Opener configuration
 - [ ] Cmdline history
 - [ ] Cli arg parsing (dir arg)
-- [ ] Opener configuration
-- [ ] Show current pending keys in statusline
 ** Right after
 - [ ] handle on open (for external integrations)
 - [ ] copy/paste across instances
diff --git a/specs/Specs/FooSpec.hs b/specs/Specs/FooSpec.hs
index 3260ca9..24545f9 100644
--- a/specs/Specs/FooSpec.hs
+++ b/specs/Specs/FooSpec.hs
@@ -1,8 +1,7 @@
 module Specs.FooSpec where
 
 import Daffm.Action.Commands (parseCommand)
-import Daffm.Configuration (parseKey)
-import Daffm.Event (matchKeySequence)
+import Daffm.Keymap (matchKeySequence, parseKeySequence)
 import Daffm.Types
 import qualified Data.Map as Map
 import qualified Graphics.Vty as K
@@ -80,6 +79,6 @@ test = do
   describe "parseKey" $ do
     context "when given keys" $ do
       it "parses correctly" $ do
-        parseKey "gdl" `shouldBe` Just [K.KChar 'g', K.KChar 'd', K.KChar 'l']
-        parseKey "<tab>g<cr>" `shouldBe` Just [K.KChar '\t', K.KChar 'g', K.KEnter]
-        parseKey "<esc>22" `shouldBe` Just [K.KEsc, K.KChar '2', K.KChar '2']
+        parseKeySequence "gdl" `shouldBe` Just [K.KChar 'g', K.KChar 'd', K.KChar 'l']
+        parseKeySequence "<tab>g<cr>" `shouldBe` Just [K.KChar '\t', K.KChar 'g', K.KEnter]
+        parseKeySequence "<esc>22" `shouldBe` Just [K.KEsc, K.KChar '2', K.KChar '2']