Add config file parsing.

[dead/lwn-epub.git] / src / Configuration.hs

diff --git a/src/Configuration.hs b/src/Configuration.hs
new file mode 100644 (file)
index 0000000..457480a
--- /dev/null
+++ b/src/Configuration.hs
@@ -0,0 +1,123 @@
+module Configuration (
+  Cfg(..),
+  get_cfg
+  )
+where
+
+import Control.Monad (mplus)
+import Data.ConfigFile
+import Data.Maybe (isJust)
+import Data.Monoid (Monoid(..))
+import System.Directory (
+  getAppUserDataDirectory
+  )
+import System.Exit (ExitCode(..), exitWith)
+import System.FilePath.Posix (joinPath)
+import System.IO (hPutStrLn, stderr)
+
+import qualified CommandLine as Cmd (
+  Args(..),
+  apply_args,
+  program_name
+  )
+import ExitCodes
+
+-- | Contains all of our configurable options.
+data Cfg = Cfg {
+  article  :: String,
+  output :: FilePath,
+  password :: Maybe String,
+  username :: Maybe String }
+
+
+instance Monoid Cfg where
+  mempty = Cfg { article  = "",
+                 output   = "",
+                 password = Nothing,
+                 username = Nothing }
+
+  mappend c1 c2 =
+    let article'  = (if null article1 then article2 else article1)
+        output'   = (if null output1 then output2 else output1)
+        password' = password1 `mplus` password2
+        username' = username1 `mplus` username2
+    in
+        Cfg { article  = article',
+              output   = output',
+              password = password',
+              username = username' }
+    where
+      article1  = article c1
+      article2  = article c2
+      output1   = output c1
+      output2   = output c2
+      password1 = password c1
+      password2 = password c2
+      username1 = username c1
+      username2 = username c2
+
+
+use_account :: Cfg -> Bool
+use_account cfg =
+  (isJust $ username cfg) && (isJust $ password cfg)
+
+format_cpe :: CPError -> String
+format_cpe (ParseError desc, _) = "Parse error: " ++ desc
+format_cpe (SectionAlreadyExists desc, _) = "Section already exists: " ++ desc
+format_cpe (NoSection desc, _) = "Missing section: " ++ desc
+format_cpe (NoOption desc, _) = "Missing required option: " ++ desc
+format_cpe (OtherProblem desc, _) = "Error: " ++ desc
+format_cpe (InterpolationError desc, _) = "Interpolation error: " ++ desc
+
+
+-- | The config parsing functions return either the result or a
+--   'CPError'. If there was an error, we represent it as 'Nothing'
+--   (at least if we're forcing the value into a 'Maybe'
+--   wrapper. Otherwise, we return 'Just' the result.
+either_to_maybe :: Either CPError a -> Maybe a
+either_to_maybe (Left  _) = Nothing
+either_to_maybe (Right x) = Just x
+
+
+config_filename :: String
+config_filename = Cmd.program_name ++ ".conf"
+
+config_path :: IO FilePath
+config_path = do
+  cfg_dir <- getAppUserDataDirectory Cmd.program_name
+  return $ joinPath [cfg_dir, config_filename]
+
+parse_config :: IO (Either String Cfg)
+parse_config = do
+  cfg_file <- config_path
+  parse_result <- readfile emptyCP cfg_file
+
+  return $
+    case parse_result of
+      Left err -> Left (format_cpe err)
+      Right cp ->
+          let cp_username = get cp "DEFAULT" "username"
+              cp_password = get cp "DEFAULT" "password"
+  
+              cfg_username = either_to_maybe cp_username
+              cfg_password = either_to_maybe cp_password
+          in
+              Right $ mempty { username = cfg_username,
+                               password = cfg_password }
+
+
+
+get_cfg :: IO Cfg
+get_cfg = do
+  cmd_article <- Cmd.apply_args
+  let arg_cfg = mempty { article = Cmd.article cmd_article,
+                         output  = Cmd.output cmd_article }
+
+  either_file_cfg <- parse_config
+  case either_file_cfg of
+    Left err -> do
+      hPutStrLn stderr err
+      exitWith $ ExitFailure exit_config_parse_failed
+    Right file_cfg ->
+      -- The left operand takes precedence when both are non-empty!
+      return $ arg_cfg `mappend` file_cfg