Add arg parsing, loading config from XDG_CONFIG_HOME and -c arg for loading config file

1 files changed, 26 insertions, 2 deletions

diff --git a/lib/Daffm/Configuration.hs b/lib/Daffm/Configuration.hs
index afcca08..494d2a4 100644
--- a/lib/Daffm/Configuration.hs
+++ b/lib/Daffm/Configuration.hs
@@ -2,6 +2,7 @@ module Daffm.Configuration where
 
 import Control.Arrow (ArrowChoice (left))
 import Control.Exception (throwIO)
+import qualified Control.Exception as IO
 import Daffm.Action.Commands (parseCommand)
 import Daffm.Keymap (parseKeySequence)
 import Daffm.Types
@@ -10,12 +11,35 @@ import qualified Data.Map as Map
 import Data.Maybe (fromMaybe)
 import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
+import System.Directory (XdgDirectory (XdgConfig), getXdgDirectory)
+import System.FilePath (joinPath)
 import Toml ((.=))
 import qualified Toml
 
-loadConfigFile :: IO Configuration
-loadConfigFile = Text.readFile "./config.toml" >>= parse
+getConfigDir :: IO FilePath
+getConfigDir = getXdgDirectory XdgConfig "daffm"
+
+getDefaultConfigFilePath :: String -> IO FilePath
+getDefaultConfigFilePath "" = do
+  dir <- getConfigDir
+  pure $ joinPath [dir, "config.toml"]
+getDefaultConfigFilePath name = do
+  dir <- getConfigDir
+  pure $ joinPath [dir, "config" <> name <> ".toml"]
+
+resolveConfigPath :: Maybe String -> IO FilePath
+resolveConfigPath Nothing = getDefaultConfigFilePath ""
+resolveConfigPath (Just ('@' : name)) = getDefaultConfigFilePath name
+resolveConfigPath (Just path) = pure path
+
+loadConfigFile :: Maybe String -> IO Configuration
+loadConfigFile pathM = do
+  resolveConfigPath pathM >>= (IO.try . Text.readFile) >>= foobar
   where
+    foobar :: Either IOError Text.Text -> IO Configuration
+    foobar rawE = case rawE of
+      Left _ -> pure defaultConfiguration
+      Right txt -> parse txt
     parse txt = case parseConfig txt of
       Left e -> throwIO $ userError $ show e
       Right c -> pure c