From 7f5d0b170099704d1a2016e2af1d9bfbde7ea1ad Mon Sep 17 00:00:00 2001
From: defanor <defanor@uberspace.net>
Date: Tue, 19 Dec 2017 02:43:21 +0300
Subject: Enable a user to specify a configuration file

This covers both command-line options and the "load config" (former
"reload config") command.
---
 Pancake/Command.hs       | 12 +++++++++---
 Pancake/Configuration.hs | 13 ++++++++-----
 2 files changed, 17 insertions(+), 8 deletions(-)

(limited to 'Pancake')

diff --git a/Pancake/Command.hs b/Pancake/Command.hs
index 4c34a19..52ace06 100644
--- a/Pancake/Command.hs
+++ b/Pancake/Command.hs
@@ -59,7 +59,7 @@ data Command = Quit
              | Show Int
              | ShowCurrent
              | Shortcut String String
-             | ReloadConfig
+             | LoadConfig (Maybe FilePath)
              | SetWidth (Maybe Int)
              | Redisplay
              deriving (Show, Eq)
@@ -75,7 +75,6 @@ basicCommand = choice . map (\(s, c) -> try (string s <* eof) *> pure c) $
   , ("[", Back)
   , ("]", Forward)
   , (",", GoTo Nothing RCurrent)
-  , ("reload config", ReloadConfig)
   , ("help", Help)
   , ("?", ShowCurrent)
   , ("redisplay", Redisplay)
@@ -151,7 +150,13 @@ pNat = read <$> many1 digit
 -- | 'SetWidth' command parser.
 setWidth :: Parser Command
 setWidth = string "set width"
-           *> (SetWidth <$> optionMaybe (spaces *> pNat))
+           *> (SetWidth <$> optionMaybe (space *> pNat))
+           <* eof
+
+-- | 'LoadConfig' command parser.
+loadConf :: Parser Command
+loadConf = string "load config"
+           *> (LoadConfig <$> optionMaybe (space *> many1 anyChar))
            <* eof
 
 -- | Command parser.
@@ -166,5 +171,6 @@ command c =
           , saveCurrent <?> "save current"
           , save <?> "save"
           , setWidth <?> "set width"
+          , loadConf <?> "load config"
           , goTo <?> "follow uri"
           ])
diff --git a/Pancake/Configuration.hs b/Pancake/Configuration.hs
index ae42f65..772725e 100644
--- a/Pancake/Configuration.hs
+++ b/Pancake/Configuration.hs
@@ -116,11 +116,14 @@ instance Default Config where
         "-w \"\n-pancake-\nuri: %{url_effective}\ntype: %{content_type}\n\" "
 
 -- | Loads configuration from an XDG config directory.
-loadConfig :: MonadIO m => m Config
-loadConfig = liftIO $ do
-  dir <- getXdgDirectory XdgConfig "pancake"
-  createDirectoryIfMissing True dir
-  let configPath = dir </> "config.yaml"
+loadConfig :: MonadIO m => Maybe FilePath -> m Config
+loadConfig mp = liftIO $ do
+  configPath <- case mp of
+    Nothing -> do
+      dir <- getXdgDirectory XdgConfig "pancake"
+      createDirectoryIfMissing True dir
+      pure $ dir </> "config.yaml"
+    Just p -> pure p
   exists <- doesFileExist configPath
   if exists
     then do
-- 
cgit v1.2.3