Source reorganization and cleanup.

[dead/lwn-epub.git] / src / LWN / Page.hs

diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs
index 7419402a3af304974dac87236826b4fcd8f545ae..6a097cbf7714d8929a37708ddd92a29c8982bf21 100644 (file)
--- 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 = "<h2 class=\"SummaryHL\">"
@@ -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 =