X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FPage.hs;h=d4aeb3006cab8c331c76219a723d1a20baf6f623;hp=f0ada7cd13cfff0707904272f93fa2b4b354f9e3;hb=1d9b1f888c9dcb7c82ce35682b4e9f0210f93f0a;hpb=fc0052e451aa03675ebd9a128dfa46573b9357d7

diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs
index f0ada7c..d4aeb30 100644
--- a/src/LWN/Page.hs
+++ b/src/LWN/Page.hs
@@ -3,6 +3,7 @@
 module LWN.Page
 where
 
+import Control.Concurrent.ParallelIO (parallel)
 import qualified Data.Map as Map (lookup)
 import Data.Time (getCurrentTime)
 import qualified Data.ByteString.Lazy as B (ByteString, hPut)
@@ -41,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,
@@ -172,7 +173,7 @@ type StoryMap = Map.Map URL Article
 -- These come *before* preprocessing.
 download_full_story_urls :: Cfg -> [URL] -> IO StoryMap
 download_full_story_urls cfg story_urls = do
-  pages <- mapM (page_from_url cfg) story_urls
+  pages <- parallel $ map (page_from_url cfg) story_urls
   let pairs = zip story_urls pages
   return $ foldl my_insert empty_map pairs
   where
@@ -192,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
@@ -260,8 +264,6 @@ ap_parse_articles xml = do
   parsed_byline   <- parse_byline xml
   parsed_body     <- ap_parse_body xml
 
-  putStrLn $ fromJust parsed_headline
-
   if (isNothing parsed_headline) || (isNothing parsed_body)
   then return []
   else do
@@ -352,7 +354,6 @@ fp_parse_articles xml = do
                           []    -> []
   -- Put the separator back, it was lost during the split.
   let split_articles = map (article_separator ++) split_articles'
-  --_ <- mapM print_article split_articles
   real_articles <- mapM parse_html_article split_articles
   let just_articles = catMaybes real_articles
   return just_articles