X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;ds=inline;f=src%2FLWN%2FPage.hs;h=5f3b9ee608f42dc9895c458e3968e0363f4702bb;hb=HEAD;hp=30c54b550a530777eb9ccfd818b16785c46cc0ef;hpb=da4d3ce666bd8fc7a0011ecf495714bb55f0127d;p=dead%2Flwn-epub.git diff --git a/src/LWN/Page.hs b/src/LWN/Page.hs index 30c54b5..5f3b9ee 100644 --- a/src/LWN/Page.hs +++ b/src/LWN/Page.hs @@ -4,11 +4,10 @@ module LWN.Page 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 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) @@ -20,7 +19,9 @@ import Text.Pandoc ( defaultWriterOptions, readHtml, writeEPUB, - writerEPUBMetadata) + writerEPUBMetadata, + writerUserDataDir) +import Text.Pandoc.Shared ( readDataFile ) 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
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 @@ -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 - -- 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 @@ -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 - 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 -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 --