X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Flwn-epub.git;a=blobdiff_plain;f=src%2FLWN%2FPage.hs;h=6a097cbf7714d8929a37708ddd92a29c8982bf21;hp=7419402a3af304974dac87236826b4fcd8f545ae;hb=f3321e2ce7d7645ad562dc8f6620bfd561edc75d;hpb=ebedcdb6b1b8925dcfb5700d076f25743fac8645 diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 7419402..6a097cb 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -3,22 +3,25 @@ module LWN.Page where -import qualified Data.Map as Map +import qualified Data.Map as Map (lookup) import Data.Time (getCurrentTime) -import System.IO (Handle) +import System.IO (Handle, hClose, hFlush) import qualified Data.ByteString.Lazy as B (ByteString, hPut) import Data.String.Utils (split, strip) import Data.Maybe (catMaybes, fromJust, isNothing) -import Data.Tree.NTree.TypeDefs (NTree) import Test.HUnit (Assertion, assertEqual) import Test.Framework (Test, testGroup) import Test.Framework.Providers.HUnit (testCase) -import Text.Pandoc +import Text.Pandoc ( + defaultParserState, + defaultWriterOptions, + readHtml, + writeEPUB, + writerEPUBMetadata) import Text.XML.HXT.Core ( ArrowXml, IOSArrow, XmlTree, - XNode, (>>>), (/>), (//>), @@ -36,33 +39,20 @@ import Text.XML.HXT.Core ( runX, setElemName, xshow, - when - ) + when) import Text.HandsomeSoup (css, parseHtml) import LWN.Article -import LWN.HTTP (save_image) +import LWN.HTTP (ImageMap, download_image_urls) import LWN.URI (URL, try_make_absolute_url) +import LWN.XHTML (XHTML, to_xhtml) import Misc (contains) -import XHTML - --- Map absolute image URLs to local system file paths where the image --- referenced by the URL is stored. -type ImageMap = Map.Map URL FilePath -- Should be called *after* preprocessing. -download_images :: IOSArrow XmlTree (NTree XNode) -> IO ImageMap +download_images :: IOSArrow XmlTree XmlTree -> IO ImageMap download_images xml = do image_urls <- runX $ xml >>> image_srcs - files <- mapM save_image image_urls - let pairs = zip image_urls files - return $ foldl my_insert empty_map pairs - where - empty_map = Map.empty :: ImageMap - - my_insert :: ImageMap -> (URL, Maybe FilePath) -> ImageMap - my_insert dict (_, Nothing) = dict - my_insert dict (k, Just v) = Map.insert k v dict + download_image_urls image_urls data Page = @@ -166,7 +156,7 @@ replace_remote_img_srcs image_map = processAttrl $ (change_src `when` (hasName "src")) -parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) +parse :: IOSArrow XmlTree XmlTree -> IO (Maybe Page) parse xml = do let clean_xml = xml >>> preprocess image_map <- download_images clean_xml @@ -181,7 +171,7 @@ parse xml = do -parse_headline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +parse_headline :: IOSArrow XmlTree XmlTree -> IO (Maybe String) parse_headline xml = do let element_filter = xml >>> css "div.PageHeadline h1" let element_text_filter = element_filter /> getText @@ -193,7 +183,7 @@ parse_headline xml = do _ -> error "Found more than one headline." -parse_byline :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +parse_byline :: IOSArrow XmlTree XmlTree -> IO (Maybe String) parse_byline xml = do let element_filter = xml >>> css "div.FeatureByLine" let element_text_filter = element_filter /> getText @@ -208,7 +198,7 @@ parse_byline xml = do -- -- ArticlePage Stuff -- -ap_parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) +ap_parse :: IOSArrow XmlTree XmlTree -> IO (Maybe Page) ap_parse xml = do arts <- ap_parse_articles xml case arts of @@ -216,7 +206,7 @@ ap_parse xml = do _ -> return Nothing -ap_parse_body :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +ap_parse_body :: IOSArrow XmlTree XmlTree -> IO (Maybe String) ap_parse_body xml = do let element_filter = xml >>> css "div.ArticleText" let element_html_filter = xshow element_filter @@ -227,7 +217,7 @@ ap_parse_body xml = do _ -> error "Found more than one article." -ap_parse_articles :: IOSArrow XmlTree (NTree XNode) -> IO [Article] +ap_parse_articles :: IOSArrow XmlTree XmlTree -> IO [Article] ap_parse_articles xml = do parsed_headline <- parse_headline xml parsed_byline <- parse_byline xml @@ -250,7 +240,7 @@ ap_parse_articles xml = do -- FullPage Stuff -- -fp_parse :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Page) +fp_parse :: IOSArrow XmlTree XmlTree -> IO (Maybe Page) fp_parse xml = do hl <- parse_headline xml parsed_articles <- fp_parse_articles xml @@ -260,7 +250,7 @@ fp_parse xml = do -fp_parse_article_title :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +fp_parse_article_title :: IOSArrow XmlTree XmlTree -> IO (Maybe String) fp_parse_article_title xml = do let element_filter = xml >>> css "h2.SummaryHL" let element_text_filter = element_filter //> getText @@ -300,7 +290,7 @@ remove_byline = -fp_parse_article_body :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe String) +fp_parse_article_body :: IOSArrow XmlTree XmlTree -> IO (Maybe String) fp_parse_article_body xml = do -- First, delete the article title and byline. let clean_xml' = xml >>> remove_title >>> remove_byline @@ -313,7 +303,7 @@ fp_parse_article_body xml = do [] -> Nothing _ -> error "Found more than one article body." -fp_parse_article :: IOSArrow XmlTree (NTree XNode) -> IO (Maybe Article) +fp_parse_article :: IOSArrow XmlTree XmlTree -> IO (Maybe Article) fp_parse_article xml = do parsed_article_title <- fp_parse_article_title xml parsed_article_byline <- parse_byline xml @@ -336,12 +326,12 @@ parse_html_article html = do -- | In the full page, all of the article titles and bodies are -- wrapped in one big div.ArticleText. -parse_bodies :: IOSArrow XmlTree (NTree XNode) -> IOSArrow XmlTree (NTree XNode) +parse_bodies :: IOSArrow XmlTree XmlTree -> IOSArrow XmlTree XmlTree parse_bodies xml = xml >>> css "div.ArticleText" -fp_parse_articles :: IOSArrow XmlTree (NTree XNode) -> IO [Article] +fp_parse_articles :: IOSArrow XmlTree XmlTree -> IO [Article] fp_parse_articles xml = do bodies <- runX . xshow $ parse_bodies xml let article_separator = "

" @@ -393,7 +383,8 @@ epublish obj handle = do epmd <- metadata obj epub <- xhtml_to_epub epmd xhtml B.hPut handle epub - + hFlush handle + hClose handle xhtml_to_epub :: String -> String -> IO B.ByteString xhtml_to_epub epmd =