X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FLWN%2FPage.hs;h=30c54b550a530777eb9ccfd818b16785c46cc0ef;hb=da4d3ce666bd8fc7a0011ecf495714bb55f0127d;hp=49faa0bb4d6d1b0c77c0b4c6eb8d00e1a9261c50;hpb=5ac7dd7f301ba633b38d7bf2361044d25204bb6e;p=dead%2Flwn-epub.git diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 49faa0b..30c54b5 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -34,6 +34,7 @@ import Text.XML.HXT.Core ( getChildren, getText, hasName, + none, processAttrl, processTopDown, this, @@ -42,7 +43,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, @@ -58,6 +59,7 @@ import LWN.XHTML ( is_image, preprocess, remove_byline, + remove_full_story_paragraphs, remove_title, to_xhtml, to_xml, @@ -127,14 +129,14 @@ insert_full_stories story_map = lookup_func :: (ArrowXml a) => URL -> a XmlTree XmlTree lookup_func href = case Map.lookup href story_map of - -- Leave it alone if we don't have the full story. - Nothing -> this + -- Drop the paragraph if we don't have the contents. + Nothing -> none Just v -> to_xml v article_xml :: (ArrowXml a) => a XmlTree XmlTree article_xml = lookup_func - $< + $< -- From HXT's Control.Arrow.ArrowList (this /> full_story_link >>> getAttrValue "href") replace_remote_img_srcs :: (ArrowXml a) => ImageMap -> a XmlTree XmlTree @@ -192,8 +194,12 @@ 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 + fs_xml <- if (full_stories cfg) then do + story_map <- download_full_stories cfg xml + return $ xml >>> insert_full_stories story_map + else do + -- Get rid of them if we don't want them. + return $ xml >>> remove_full_story_paragraphs let clean_xml = fs_xml >>> preprocess image_map <- download_images clean_xml