Fix the --full-story handling.

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

diff --git a/src/Configuration.hs b/src/Configuration.hs
index 457480a19a3debea6b86b3c9da99ea2ad79d1f0a..118f10f3c101513a1a0427f77f35118b7088fea5 100644 (file)
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -1,6 +1,9 @@
+{-# LANGUAGE DoAndIfThenElse #-}
+
 module Configuration (
   Cfg(..),
-  get_cfg
+  get_cfg,
+  use_account
   )
 where
 
@@ -9,6 +12,7 @@ import Data.ConfigFile
 import Data.Maybe (isJust)
 import Data.Monoid (Monoid(..))
 import System.Directory (
+  doesFileExist,
   getAppUserDataDirectory
   )
 import System.Exit (ExitCode(..), exitWith)
@@ -24,37 +28,48 @@ import ExitCodes
 
 -- | Contains all of our configurable options.
 data Cfg = Cfg {
-  article  :: String,
-  output :: FilePath,
-  password :: Maybe String,
-  username :: Maybe String }
-
+  article      :: String,
+  cookie_jar   :: Maybe FilePath,
+  full_stories :: Bool,
+  output       :: FilePath,
+  password     :: Maybe String,
+  username     :: Maybe String }
 
 instance Monoid Cfg where
-  mempty = Cfg { article  = "",
-                 output   = "",
-                 password = Nothing,
-                 username = Nothing }
+  mempty = Cfg { article      = "",
+                 cookie_jar   = Nothing,
+                 full_stories = False,
+                 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
+    let article'      = (if null article1 then article2 else article1)
+        cookie_jar'   = cookie_jar1 `mplus` cookie_jar2
+        full_stories' = full_stories1 || full_stories2
+        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' }
+        Cfg { article      = article',
+              cookie_jar   = cookie_jar',
+              full_stories = full_stories',
+              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
+      article1      = article c1
+      article2      = article c2
+      cookie_jar1   = cookie_jar c1
+      cookie_jar2   = cookie_jar c2
+      full_stories1 = full_stories c1
+      full_stories2 = full_stories c2
+      output1       = output c1
+      output2       = output c2
+      password1     = password c1
+      password2     = password c2
+      username1     = username c1
+      username2     = username c2
 
 
 use_account :: Cfg -> Bool
@@ -85,33 +100,44 @@ 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]
+  let cfg_file = joinPath [cfg_dir, config_filename]
+  return $ cfg_file
 
 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 }
+  it_exists <- doesFileExist cfg_file
+  if not it_exists then do
+    return $ Right mempty
+  else do
+    parse_result <- readfile emptyCP cfg_file
+
+    return $
+      case parse_result of
+        Left err -> Left (format_cpe err)
+        Right cp ->
+            let cp_full_stories = get cp "DEFAULT" "full_stories"
+                cp_password = get cp "DEFAULT" "password"
+                cp_username = get cp "DEFAULT" "username"
+
+                cfg_password = either_to_maybe cp_password
+                cfg_full_stories = case cp_full_stories of
+                                     Left _  -> False -- default
+                                     Right f -> f
+                cfg_username = either_to_maybe cp_username
+            in
+                Right $ mempty { full_stories = cfg_full_stories,
+                                 password = cfg_password,
+                                 username = cfg_username }
 
 
 
 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 }
+  let arg_cfg = mempty { article      = Cmd.article cmd_article,
+                         full_stories = Cmd.full_stories cmd_article,
+                         output       = Cmd.output cmd_article }
 
   either_file_cfg <- parse_config
   case either_file_cfg of