X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FConfiguration.hs;h=4d5604354cf51cf032e26939d81565aa5d9c2606;hp=b7915073e842136724224a76851715b742209c06;hb=a4d1f36a2dfb5db56f382d9b25ea70de7ef38633;hpb=6cb1920fc40d737b5a13fda62a75bf97a69c1ab6

diff --git a/src/Configuration.hs b/src/Configuration.hs
index b791507..4d56043 100644
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -2,15 +2,16 @@
 
 module Configuration (
   Cfg(..),
+  cj_empty,
   get_cfg,
   use_account
   )
 where
 
-import Control.Monad (mplus)
 import Data.ConfigFile
 import Data.Maybe (isJust)
 import Data.Monoid (Monoid(..))
+import Network.HTTP.Conduit (CookieJar, createCookieJar, destroyCookieJar)
 import System.Directory (
   doesFileExist,
   getAppUserDataDirectory
@@ -28,37 +29,63 @@ 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   :: CookieJar,
+  full_stories :: Bool,
+  output       :: FilePath,
+  password     :: Maybe String,
+  username     :: Maybe String }
+
+-- An empty CookieJar. See cj_append for rationale.
+cj_empty :: CookieJar
+cj_empty = createCookieJar []
+
+
+-- Defined for convenience; I would really like to use mappend but GHC
+-- bitches about the orphan instance.
+cj_append :: CookieJar -> CookieJar -> CookieJar
+cj_append cj1 cj2 =
+  createCookieJar (cookies1 ++ cookies2)
+  where
+    -- Decompose the cookie jars into lists.
+    cookies1 = destroyCookieJar cj1
+    cookies2 = destroyCookieJar cj2
 
 instance Monoid Cfg where
-  mempty = Cfg { article  = "",
-                 output   = "",
-                 password = Nothing,
-                 username = Nothing }
+  mempty = Cfg { article      = mempty,
+                 cookie_jar   = cj_empty,
+                 full_stories = False,
+                 output       = mempty,
+                 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 `cj_append` cookie_jar2
+        full_stories' = full_stories1 || full_stories2
+        output'       = (if null output1 then output2 else output1)
+        password'     = password1 `mappend` password2
+        username'     = username1 `mappend` 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
@@ -105,22 +132,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"
-  
-                cfg_username = either_to_maybe cp_username
+                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 { 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