From 1d9b1f888c9dcb7c82ce35682b4e9f0210f93f0a Mon Sep 17 00:00:00 2001
From: Michael Orlitzky <michael@orlitzky.com>
Date: Thu, 12 Jul 2012 19:47:30 -0400
Subject: [PATCH] Add a --full-stories option which may or may not work.

---
 src/CommandLine.hs   | 11 ++++--
 src/Configuration.hs | 79 +++++++++++++++++++++++++-------------------
 src/LWN/Page.hs      |  7 ++--
 3 files changed, 58 insertions(+), 39 deletions(-)

diff --git a/src/CommandLine.hs b/src/CommandLine.hs
index 7afc7f1..2df29a5 100644
--- a/src/CommandLine.hs
+++ b/src/CommandLine.hs
@@ -40,7 +40,8 @@ import ExitCodes
 
 
 data Args =
-  Args { output :: FilePath,
+  Args { full_stories :: Bool,
+         output :: FilePath,
          article :: String }
   deriving   (Show, Data, Typeable)
 
@@ -58,11 +59,15 @@ lwn_epub_summary =
 output_help :: String
 output_help = "Output file, defaults to stdout"
 
+full_stories_help :: String
+full_stories_help = "Replace \"Full Story\" links with their content"
+
 arg_spec :: Mode (CmdArgs Args)
 arg_spec = cmdArgsMode $
              Args {
-               output = def  &= typFile &= help output_help,
-               article = def &= argPos 0 &= typ "ARTICLE"
+               full_stories = def &= help full_stories_help,
+               output       = def &= typFile  &= help output_help,
+               article      = def &= argPos 0 &= typ "ARTICLE"
              }
              &= program program_name
              &= summary lwn_epub_summary
diff --git a/src/Configuration.hs b/src/Configuration.hs
index 478d465..1941932 100644
--- a/src/Configuration.hs
+++ b/src/Configuration.hs
@@ -28,43 +28,49 @@ 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,14 +117,19 @@ 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 }
 
 
 
diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs
index 49faa0b..d4aeb30 100644
--- a/src/LWN/Page.hs
+++ b/src/LWN/Page.hs
@@ -42,7 +42,7 @@ import Text.XML.HXT.Core (
   when)
 import Text.HandsomeSoup (css, parseHtml)
 
-import Configuration (Cfg)
+import Configuration (Cfg, full_stories)
 import LWN.Article
 import LWN.HTTP (
   ImageMap,
@@ -193,7 +193,10 @@ download_full_stories cfg xml = do
 parse :: Cfg -> IOSArrow XmlTree XmlTree -> IO (Maybe Page)
 parse cfg xml = do
   story_map <- download_full_stories cfg xml
-  let fs_xml = xml >>> insert_full_stories story_map
+  let fs_xml = if (full_stories cfg) then
+                 xml >>> insert_full_stories story_map
+               else
+                 xml
 
   let clean_xml = fs_xml >>> preprocess
   image_map <- download_images clean_xml
-- 
2.44.2