Clean up some types now that I know what I'm doing.

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

diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs
index 0307214176a82c469f1f555a056b553c05bd3b06..2bbe21ae8e918ed49d658cac3fe05b0aa4905843 100644 (file)
--- a/src/LWN/Page.hs
+++ b/src/LWN/Page.hs
@@ -5,12 +5,10 @@ where
 
 import qualified Data.Map as Map
 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.List (isInfixOf)
 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)
@@ -19,7 +17,6 @@ import Text.XML.HXT.Core (
   ArrowXml,
   IOSArrow,
   XmlTree,
-  XNode,
   (>>>),
   (/>),
   (//>),
@@ -44,16 +41,15 @@ import Text.HandsomeSoup (css, parseHtml)
 import LWN.Article
 import LWN.HTTP (save_image)
 import LWN.URI (URL, try_make_absolute_url)
+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 xml = do
-  image_urls <- runX $ xml >>> image_srcs
+download_image_urls :: [URL] -> IO ImageMap
+download_image_urls image_urls = do
   files <- mapM save_image image_urls
   let pairs = zip image_urls files
   return $ foldl my_insert empty_map pairs
@@ -64,6 +60,12 @@ download_images xml = do
     my_insert dict (_, Nothing)  = dict
     my_insert dict (k, Just v) = Map.insert k v dict
 
+-- Should be called *after* preprocessing.
+download_images :: IOSArrow XmlTree XmlTree -> IO ImageMap
+download_images xml = do
+  image_urls <- runX $ xml >>> image_srcs
+  download_image_urls image_urls
+
 
 data Page =
   -- | An LWN page with one article on it.
@@ -121,8 +123,6 @@ remove_comment_links  :: (ArrowXml a) => a XmlTree XmlTree
 remove_comment_links =
   processTopDown $ kill_comments `when` is_link
   where    
-    contains = isInfixOf
-
     is_comment_link =
       hasAttrValue "href" (contains "#Comments")
 
@@ -168,7 +168,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
@@ -183,7 +183,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
@@ -195,7 +195,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
@@ -210,7 +210,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
@@ -218,7 +218,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
@@ -229,7 +229,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
@@ -252,7 +252,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
@@ -262,7 +262,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
@@ -302,7 +302,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
@@ -315,7 +315,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
@@ -338,12 +338,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\">"
@@ -395,7 +395,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 =