]> gitweb.michael.orlitzky.com - dead/lwn-epub.git/blobdiff - src/Configuration.hs
Fix the --full-story handling.
[dead/lwn-epub.git] / src / Configuration.hs
index 478d465ef8aefe5eb1225d60505b23bdffedeab8..118f10f3c101513a1a0427f77f35118b7088fea5 100644 (file)
@@ -28,43 +28,48 @@ import ExitCodes
 
 -- | Contains all of our configurable options.
 data Cfg = Cfg {
-  article    :: String,
-  cookie_jar :: Maybe FilePath,
-  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  = "",
-                 cookie_jar = Nothing,
-                 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)
-        cookie_jar' = cookie_jar1 `mplus` cookie_jar2
-        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',
-              cookie_jar = cookie_jar',
-              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
-      cookie_jar1 = cookie_jar c1
-      cookie_jar2 = cookie_jar 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
@@ -111,22 +116,28 @@ parse_config = do
       case parse_result of
         Left err -> Left (format_cpe err)
         Right cp ->
-            let cp_username = get cp "DEFAULT" "username"
+            let cp_full_stories = get cp "DEFAULT" "full_stories"
                 cp_password = get cp "DEFAULT" "password"
+                cp_username = get cp "DEFAULT" "username"
 
-                cfg_username = either_to_maybe cp_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 { username = cfg_username,
-                                 password = cfg_password }
+                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