Bump a few dependencies, fix compilation failures.

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

diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs
index 3dccf466fea98f49a8ee42dcf44a2cdebe66a42c..5f3b9ee608f42dc9895c458e3968e0363f4702bb 100644 (file)
--- a/src/LWN/Page.hs
+++ b/src/LWN/Page.hs
@@ -4,11 +4,10 @@ module LWN.Page
 where
 
 import Control.Concurrent.ParallelIO (parallel)
 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)
 import Data.String.Utils (split, strip)
 import Data.Time (getCurrentTime)
 import qualified Data.ByteString.Lazy as B (ByteString, hPut)
 import Data.String.Utils (split, strip)

-import qualified Data.Map as Map (Map, empty, insert)
+import qualified Data.Map as Map (Map, empty, insert, lookup)

 import Data.Maybe (catMaybes, fromJust, isNothing)
 import Prelude hiding (readFile)
 import System.IO (Handle, hClose, hFlush)
 import Data.Maybe (catMaybes, fromJust, isNothing)
 import Prelude hiding (readFile)
 import System.IO (Handle, hClose, hFlush)


@@ -20,7 +19,9 @@ import Text.Pandoc (
   defaultWriterOptions,
   readHtml,
   writeEPUB,
   defaultWriterOptions,
   readHtml,
   writeEPUB,

-  writerEPUBMetadata)
+  writerEPUBMetadata,
+  writerUserDataDir)
+import Text.Pandoc.Shared ( readDataFile )

 import Text.XML.HXT.Core (
   ArrowXml,
   IOSArrow,
 import Text.XML.HXT.Core (
   ArrowXml,
   IOSArrow,


@@ -34,6 +35,7 @@ import Text.XML.HXT.Core (
   getChildren,
   getText,
   hasName,
   getChildren,
   getText,
   hasName,

+  none,

   processAttrl,
   processTopDown,
   this,
   processAttrl,
   processTopDown,
   this,


@@ -58,6 +60,7 @@ import LWN.XHTML (
   is_image,
   preprocess,
   remove_byline,
   is_image,
   preprocess,
   remove_byline,

+  remove_full_story_paragraphs,

   remove_title,
   to_xhtml,
   to_xml,
   remove_title,
   to_xhtml,
   to_xml,


@@ -111,6 +114,20 @@ instance XHTML Page where
 
 
 
 
 
 

+-- | Stolen from writeEPUB.
+default_stylesheet :: IO String
+default_stylesheet =
+  -- This comes with Pandoc, I guess.
+  readDataFile (writerUserDataDir defaultWriterOptions) "epub.css"
+
+
+construct_stylesheet :: IO String
+construct_stylesheet = do
+  defaults <- default_stylesheet
+  -- Allow word-wrapping in <pre> elements.
+  let my_additions = "\n" ++ "pre { white-space: pre-wrap; }" ++ "\n"
+  return $ defaults ++ my_additions
+

 page_from_url :: Cfg -> URL -> IO (Maybe Page)
 page_from_url cfg url = do
   contents <- get_article_contents cfg url  
 page_from_url :: Cfg -> URL -> IO (Maybe Page)
 page_from_url cfg url = do
   contents <- get_article_contents cfg url  


@@ -127,8 +144,8 @@ insert_full_stories story_map =
     lookup_func :: (ArrowXml a) => URL -> a XmlTree XmlTree
     lookup_func href =
       case Map.lookup href story_map of
     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
         Just v -> to_xml v
 
     article_xml :: (ArrowXml a) => a XmlTree XmlTree


@@ -145,8 +162,9 @@ replace_remote_img_srcs image_map =
     change_src_func :: String -> String
     change_src_func old_src =
       case Map.lookup old_src image_map of
     change_src_func :: String -> String
     change_src_func old_src =
       case Map.lookup old_src image_map of

-        -- Leave it alone if we don't have the file locally
-        Nothing -> old_src
+        -- If we don't have the file, empty the src. Pandoc will crash
+        -- otherwise.
+        Nothing -> ""

         Just v -> v
 
     change_src :: (ArrowXml a) => a XmlTree XmlTree
         Just v -> v
 
     change_src :: (ArrowXml a) => a XmlTree XmlTree


@@ -196,7 +214,8 @@ parse cfg xml = do
              story_map <- download_full_stories cfg xml
              return $ xml >>> insert_full_stories story_map
            else do
              story_map <- download_full_stories cfg xml
              return $ xml >>> insert_full_stories story_map
            else do

-             return xml
+             -- 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
 
   let clean_xml = fs_xml >>> preprocess
   image_map <- download_images clean_xml


@@ -283,9 +302,9 @@ fp_parse :: IOSArrow XmlTree XmlTree -> IO (Maybe Page)
 fp_parse xml = do
     hl <- parse_headline xml
     parsed_articles <- fp_parse_articles xml
 fp_parse xml = do
     hl <- parse_headline xml
     parsed_articles <- fp_parse_articles xml

-    case parsed_articles of
-      []          -> return Nothing
-      x -> return $ Just $ FullPage (fromJust hl) x
+    return $ case parsed_articles of
+      [] -> Nothing
+      x  -> Just $ FullPage (fromJust hl) x

 
 
 
 
 
 


@@ -398,12 +417,16 @@ epublish obj handle = do
   hClose handle
 
 xhtml_to_epub :: String -> String -> IO B.ByteString
   hClose handle
 
 xhtml_to_epub :: String -> String -> IO B.ByteString

-xhtml_to_epub epmd =
-   write_epub . read_html
-   where
-     my_writer_options = defaultWriterOptions { writerEPUBMetadata = epmd }
-     write_epub = writeEPUB Nothing [] my_writer_options
-     read_html  = readHtml defaultParserState
+xhtml_to_epub epmd xhtml = do
+  stylesheet <- construct_stylesheet
+  writeEPUB
+    (Just stylesheet)
+    []
+    my_writer_options
+    (read_html xhtml)
+  where
+    my_writer_options = defaultWriterOptions { writerEPUBMetadata = epmd }
+    read_html  = readHtml defaultParserState

 
 
 --
 
 
 --