Add configuration (keymap) loading from toml file

8 files changed, 88 insertions, 17 deletions

diff --git a/config.toml b/config.toml
new file mode 100644
index 0000000..5e4f11e
--- /dev/null
+++ b/config.toml
@@ -0,0 +1,7 @@
+[keymap]
+gdl = "cd /home/imsohexy/Downloads"
+gdc = "cd /home/imsohexy/Documents"
+gp = "cd /home/imsohexy/Pictures"
+gsc = "cd /home/imsohexy/Pictures/screenshots"
+dd = "!rm -rfi %f"
+pi = "!!clear; chafa -f kitty %"
diff --git a/daffm.cabal b/daffm.cabal
index 8b37971..7a1eeec 100644
--- a/daffm.cabal
+++ b/daffm.cabal
@@ -28,16 +28,17 @@ common common-config
     array,
     base,
     brick == 2.4,
+    tomland <= 1.3.3.3,
+    containers <= 0.8,
     data-default <= 0.8.0.1,
     directory <= 1.3.9.0,
     filepath <= 1.5.4.0,
-    process <= 1.6.26.1,
-    unix-compat <= 0.7.4.1,
     mtl == 2.3.1,
-    containers <= 0.8,
-    text-zipper <= 0.13,
+    process <= 1.6.26.1,
     temporary,
     text,
+    text-zipper <= 0.13,
+    unix-compat <= 0.7.4.1,
     vector,
     vty
 
@@ -63,6 +64,7 @@ library lib-daffm
     Daffm.Action.Commands
     Daffm.Action.Core
     Daffm.Attrs
+    Daffm.Configuration
     Daffm.Event
     Daffm.State
     Daffm.Types
diff --git a/exe/Main.hs b/exe/Main.hs
index 79a49f9..d165653 100644
--- a/exe/Main.hs
+++ b/exe/Main.hs
@@ -3,6 +3,7 @@ module Main where
 import qualified Brick.Main as M
 import Control.Monad (void)
 import qualified Daffm
+import Daffm.Configuration (loadConfigFile)
 import qualified Data.Text as Text
 import System.Directory (getCurrentDirectory)
 import System.FilePath (takeDirectory)
@@ -11,5 +12,6 @@ main :: IO ()
 main = do
   cwd <- getCurrentDirectory
   let parentDir = Text.pack $ takeDirectory cwd
-  initialState <- Daffm.loadDirToState (Text.pack cwd) parentDir Daffm.mkEmptyAppState
+  config <- loadConfigFile
+  initialState <- Daffm.loadDirToState (Text.pack cwd) parentDir $ Daffm.mkEmptyAppState config
   void $ M.defaultMain Daffm.app initialState
diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
new file mode 100644
index 0000000..6128816
--- /dev/null
+++ b/lib/Daffm/Configuration.hs
@@ -0,0 +1,50 @@
+module Daffm.Configuration where
+
+import Control.Arrow (ArrowChoice (left))
+import Control.Exception (throwIO)
+import Daffm.Action.Commands (parseCommand)
+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
+
+loadConfigFile :: IO Configuration
+loadConfigFile = Text.readFile "./config.toml" >>= parse
+  where
+    parse txt = case parseConfig txt of
+      Left e -> throwIO $ userError $ show e
+      Right c -> pure c
+
+parseConfig :: Text.Text -> Either Text.Text Configuration
+parseConfig txt = left Toml.prettyTomlDecodeErrors $ Toml.decode configurationCodec txt
+
+configurationCodec :: Toml.TomlCodec Configuration
+configurationCodec =
+  Configuration
+    <$> (keymapCodec "keymap" .= configKeymap)
+    <*> pure Map.empty .= configTheme
+  where
+    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
+    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/State.hs b/lib/Daffm/State.hs
index f45a154..2596f0c 100644
--- a/lib/Daffm/State.hs
+++ b/lib/Daffm/State.hs
@@ -4,7 +4,7 @@ import qualified Brick.Widgets.Edit as Editor
 import qualified Brick.Widgets.List as L
 import Control.Applicative ((<|>))
 import Control.Monad (filterM, forM)
-import Daffm.Types (AppState (..), Command (..), FileInfo (..), FilePathText, FileType (..), FocusTarget (..))
+import Daffm.Types
 import Data.List (findIndex, sortBy)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe)
@@ -20,8 +20,8 @@ import qualified System.PosixCompat as Posix
 mkEditor :: (Zipper.GenericTextZipper a) => a -> Editor.Editor a FocusTarget
 mkEditor = Editor.editor FocusCmdline (Just 1)
 
-mkEmptyAppState :: AppState
-mkEmptyAppState =
+mkEmptyAppState :: Configuration -> AppState
+mkEmptyAppState config =
   AppState
     { stateFiles = L.list FocusMain (Vec.fromList []) 1,
       stateCmdlineEditor = mkEditor "",
@@ -30,7 +30,7 @@ mkEmptyAppState =
       stateFileSelections = Set.empty,
       stateCwd = "",
       stateParentDir = "",
-      stateKeyMap = defaultKeymaps,
+      stateKeyMap = defaultKeymaps <> configKeymap config,
       stateKeySequence = []
     }
   where
@@ -48,12 +48,7 @@ mkEmptyAppState =
           ([K.KChar '\t'], CmdToggleSelection),
           ([K.KChar 'C'], CmdClearSelection),
           ([K.KChar '~'], CmdChangeDir "/home/imsohexy"),
-          ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "/home/imsohexy"),
-          ([K.KChar 'g', K.KChar 'd', K.KChar 'c'], CmdChangeDir "/home/imsohexy/Documents"),
-          ([K.KChar 'g', K.KChar 'd', K.KChar 'l'], CmdChangeDir "/home/imsohexy/Downloads"),
-          ([K.KChar 'g', K.KChar 'p'], CmdChangeDir "/home/imsohexy/Pictures"),
-          -- Just for testing
-          ([K.KChar 'p'], CmdShell True "chafa -f kitty %")
+          ([K.KChar 'g', K.KChar 'h'], CmdChangeDir "/home/imsohexy")
         ]
 
 toggleSetItem :: (Ord a) => a -> Set.Set a -> Set.Set a
diff --git a/lib/Daffm/Types.hs b/lib/Daffm/Types.hs
index 953e3a8..7264673 100644
--- a/lib/Daffm/Types.hs
+++ b/lib/Daffm/Types.hs
@@ -73,3 +73,9 @@ type Key = V.Key
 type Keymap = Map.Map [Key] Command
 
 type KeySequence = [Key]
+
+data Configuration = Configuration
+  { configKeymap :: !Keymap,
+    configTheme :: !(Map.Map Text.Text Text.Text)
+  }
+  deriving (Show)
diff --git a/notes.org b/notes.org
index c4aebb1..0733ebc 100644
--- a/notes.org
+++ b/notes.org
@@ -12,10 +12,11 @@
 - [X] Command parsing
 - [X] Cmdline must be single line
 - [X] Internal commands?
+- [X] parsing key sequence
+- [X] configuration file (toml?)
 - [ ] Error handling
+- [ ] Expand ~ to home in internal commands (cd)
 - [ ] Cmdline history
-- [ ] parsing key sequence
-- [ ] configuration file (toml?)
 - [ ] Cli arg parsing (dir arg)
 ** Right after
 - [ ] cd into dir symlinks
diff --git a/specs/Specs/FooSpec.hs b/specs/Specs/FooSpec.hs
index 4c5f640..3260ca9 100644
--- a/specs/Specs/FooSpec.hs
+++ b/specs/Specs/FooSpec.hs
@@ -1,6 +1,7 @@
 module Specs.FooSpec where
 
 import Daffm.Action.Commands (parseCommand)
+import Daffm.Configuration (parseKey)
 import Daffm.Event (matchKeySequence)
 import Daffm.Types
 import qualified Data.Map as Map
@@ -75,3 +76,10 @@ test = do
         parseCommand "cmdline-set hello" `shouldBe` Just (CmdSetCmdline "hello")
         parseCommand "cmdline-set" `shouldBe` Just (CmdSetCmdline "")
         parseCommand "cmdline-set somespaces    " `shouldBe` Just (CmdSetCmdline "somespaces    ")
+
+  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']