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 30c54b550a530777eb9ccfd818b16785c46cc0ef..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,


@@ -113,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  


@@ -147,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


@@ -286,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

 
 
 
 
 
 


@@ -401,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

 
 
 --
 
 
 --