Add configuration (keymap) loading from toml file

3 files changed, 61 insertions, 10 deletions

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)