HTML writer: export writeHtmlStringForEPUB.

Options: Remove writerEPUBVersion.
This commit is contained in:
John MacFarlane 2017-01-27 10:27:34 +01:00
parent b6c1d491f5
commit f5dd123819
3 changed files with 42 additions and 28 deletions

View file

@ -175,7 +175,6 @@ data WriterOptions = WriterOptions
, writerHighlightStyle :: Maybe Style -- ^ Style to use for highlighting , writerHighlightStyle :: Maybe Style -- ^ Style to use for highlighting
-- (Nothing = no highlighting) -- (Nothing = no highlighting)
, writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown , writerSetextHeaders :: Bool -- ^ Use setext headers for levels 1-2 in markdown
, writerEpubVersion :: Maybe EPUBVersion -- ^ Nothing or EPUB version
, writerEpubMetadata :: String -- ^ Metadata to include in EPUB , writerEpubMetadata :: String -- ^ Metadata to include in EPUB
, writerEpubStylesheet :: Maybe String -- ^ EPUB stylesheet specified at command line , writerEpubStylesheet :: Maybe String -- ^ EPUB stylesheet specified at command line
, writerEpubFonts :: [FilePath] -- ^ Paths to fonts to embed , writerEpubFonts :: [FilePath] -- ^ Paths to fonts to embed
@ -214,7 +213,6 @@ instance Default WriterOptions where
, writerListings = False , writerListings = False
, writerHighlightStyle = Just pygments , writerHighlightStyle = Just pygments
, writerSetextHeaders = True , writerSetextHeaders = True
, writerEpubVersion = Nothing
, writerEpubMetadata = "" , writerEpubMetadata = ""
, writerEpubStylesheet = Nothing , writerEpubStylesheet = Nothing
, writerEpubFonts = [] , writerEpubFonts = []

View file

@ -59,10 +59,9 @@ import Control.Monad (mplus, when, zipWithM)
import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs import Text.XML.Light ( unode, Element(..), unqual, Attr(..), add_attrs
, strContent, lookupAttr, Node(..), QName(..), parseXML , strContent, lookupAttr, Node(..), QName(..), parseXML
, onlyElems, node, ppElement) , onlyElems, node, ppElement)
import Text.Pandoc.Writers.HTML ( writeHtml4, writeHtml5 ) import Text.Pandoc.Writers.HTML ( writeHtmlStringForEPUB )
import Data.Char ( toLower, isDigit, isAlphaNum ) import Data.Char ( toLower, isDigit, isAlphaNum )
import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType) import Text.Pandoc.MIME (MimeType, getMimeType, extensionFromMimeType)
import Text.Blaze.Html.Renderer.Utf8 (renderHtml)
import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags) import Text.HTML.TagSoup (Tag(TagOpen), fromAttrib, parseTags)
import Control.Monad.Except (throwError, catchError) import Control.Monad.Except (throwError, catchError)
import Text.Pandoc.Error import Text.Pandoc.Error
@ -361,16 +360,18 @@ writeEPUB epubVersion opts doc =
let initState = EPUBState { stMediaPaths = [] let initState = EPUBState { stMediaPaths = []
} }
in in
evalStateT (pandocToEPUB opts{ writerEpubVersion = Just epubVersion } doc) evalStateT (pandocToEPUB epubVersion opts doc)
initState initState
pandocToEPUB :: PandocMonad m pandocToEPUB :: PandocMonad m
=> WriterOptions => EPUBVersion
-> WriterOptions
-> Pandoc -> Pandoc
-> E m B.ByteString -> E m B.ByteString
pandocToEPUB opts doc@(Pandoc meta _) = do pandocToEPUB version opts doc@(Pandoc meta _) = do
let version = fromMaybe EPUB2 (writerEpubVersion opts) let epub3 = version == EPUB3
let epub3 = writerEpubVersion opts == Just EPUB3 let writeHtml o = fmap UTF8.fromStringLazy .
writeHtmlStringForEPUB version o
epochtime <- floor <$> lift P.getPOSIXTime epochtime <- floor <$> lift P.getPOSIXTime
let mkEntry path content = toEntry path epochtime content let mkEntry path content = toEntry path epochtime content
let vars = ("epub3", if epub3 then "true" else "false") let vars = ("epub3", if epub3 then "true" else "false")
@ -384,9 +385,6 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
then MathML Nothing then MathML Nothing
else writerHTMLMathMethod opts else writerHTMLMathMethod opts
, writerWrapText = WrapAuto } , writerWrapText = WrapAuto }
let writeHtml = if epub3
then writeHtml5
else writeHtml4
metadata <- getEPUBMetadata opts' meta metadata <- getEPUBMetadata opts' meta
-- cover page -- cover page
@ -395,17 +393,17 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
Nothing -> return ([],[]) Nothing -> return ([],[])
Just img -> do Just img -> do
let coverImage = "media/" ++ takeFileName img let coverImage = "media/" ++ takeFileName img
cpContent <- renderHtml <$> (lift $ writeHtml cpContent <- lift $ writeHtml
opts'{ writerVariables = ("coverpage","true"):vars } opts'{ writerVariables = ("coverpage","true"):vars }
(Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])) (Pandoc meta [RawBlock (Format "html") $ "<div id=\"cover-image\">\n<img src=\"" ++ coverImage ++ "\" alt=\"cover image\" />\n</div>"])
imgContent <- lift $ P.readFileLazy img imgContent <- lift $ P.readFileLazy img
return ( [mkEntry "cover.xhtml" cpContent] return ( [mkEntry "cover.xhtml" cpContent]
, [mkEntry coverImage imgContent] ) , [mkEntry coverImage imgContent] )
-- title page -- title page
tpContent <- renderHtml <$> (lift $ writeHtml opts'{ tpContent <- lift $ writeHtml opts'{
writerVariables = ("titlepage","true"):vars } writerVariables = ("titlepage","true"):vars }
(Pandoc meta [])) (Pandoc meta [])
let tpEntry = mkEntry "title_page.xhtml" tpContent let tpEntry = mkEntry "title_page.xhtml" tpContent
-- handle pictures -- handle pictures
@ -504,9 +502,8 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
chapters' chapters'
let chapToEntry num (Chapter mbnum bs) = let chapToEntry num (Chapter mbnum bs) =
(mkEntry (showChapter num) . renderHtml) <$> mkEntry (showChapter num) <$>
(writeHtml opts'{ writerNumberOffset = (writeHtml opts'{ writerNumberOffset = fromMaybe [] mbnum }
fromMaybe [] mbnum }
$ case bs of $ case bs of
(Header _ _ xs : _) -> (Header _ _ xs : _) ->
-- remove notes or we get doubled footnotes -- remove notes or we get doubled footnotes
@ -702,11 +699,10 @@ pandocToEPUB opts doc@(Pandoc meta _) = do
] ]
] ]
else [] else []
navData <- renderHtml <$> (lift $ writeHtml navData <- lift $ writeHtml opts'{ writerVariables = ("navpage","true"):vars }
opts'{ writerVariables = ("navpage","true"):vars }
(Pandoc (setMeta "title" (Pandoc (setMeta "title"
(walk removeNote $ fromList $ docTitle' meta) nullMeta) (walk removeNote $ fromList $ docTitle' meta) nullMeta)
(navBlocks ++ landmarks))) (navBlocks ++ landmarks))
let navEntry = mkEntry "nav.xhtml" navData let navEntry = mkEntry "nav.xhtml" navData
-- mimetype -- mimetype

View file

@ -29,8 +29,12 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Conversion of 'Pandoc' documents to HTML. Conversion of 'Pandoc' documents to HTML.
-} -}
module Text.Pandoc.Writers.HTML ( module Text.Pandoc.Writers.HTML (
writeHtml4, writeHtml4String, writeHtml4,
writeHtml5, writeHtml5String ) where writeHtml4String,
writeHtml5,
writeHtml5String,
writeHtmlStringForEPUB
) where
import Text.Pandoc.Definition import Text.Pandoc.Definition
import Text.Pandoc.Walk import Text.Pandoc.Walk
import Data.Monoid ((<>)) import Data.Monoid ((<>))
@ -83,12 +87,14 @@ data WriterState = WriterState
, stSecNum :: [Int] -- ^ Number of current section , stSecNum :: [Int] -- ^ Number of current section
, stElement :: Bool -- ^ Processing an Element , stElement :: Bool -- ^ Processing an Element
, stHtml5 :: Bool -- ^ Use HTML5 , stHtml5 :: Bool -- ^ Use HTML5
, stEPUBVersion :: Maybe EPUBVersion -- ^ EPUB version if for epub
} }
defaultWriterState :: WriterState defaultWriterState :: WriterState
defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False, defaultWriterState = WriterState {stNotes= [], stMath = False, stQuotes = False,
stHighlighting = False, stSecNum = [], stHighlighting = False, stSecNum = [],
stElement = False, stHtml5 = False} stElement = False, stHtml5 = False,
stEPUBVersion = Nothing}
-- Helpers to render HTML with the appropriate function. -- Helpers to render HTML with the appropriate function.
@ -121,6 +127,18 @@ writeHtml4String = writeHtmlString' False
writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html writeHtml4 :: PandocMonad m => WriterOptions -> Pandoc -> m Html
writeHtml4 = writeHtml' False writeHtml4 = writeHtml' False
-- | Convert Pandoc document to Html appropriate for an epub version.
writeHtmlStringForEPUB :: PandocMonad m
=> EPUBVersion -> WriterOptions -> Pandoc -> m String
writeHtmlStringForEPUB version opts d = do
(body, context) <- evalStateT (pandocToHtml opts d)
defaultWriterState{ stHtml5 = version == EPUB3,
stEPUBVersion = Just version }
return $ case writerTemplate opts of
Nothing -> renderHtml body
Just tpl -> renderTemplate' tpl $
defField "body" (renderHtml body) context
writeHtmlString' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m String writeHtmlString' :: PandocMonad m => Bool -> WriterOptions -> Pandoc -> m String
writeHtmlString' html5 opts d = do writeHtmlString' html5 opts d = do
(body, context) <- evalStateT (pandocToHtml opts d) (body, context) <- evalStateT (pandocToHtml opts d)
@ -892,6 +910,7 @@ inlineToHtml opts inline = do
let number = (length notes) + 1 let number = (length notes) + 1
let ref = show number let ref = show number
htmlContents <- blockListToNote opts ref contents htmlContents <- blockListToNote opts ref contents
epubVersion <- gets stEPUBVersion
-- push contents onto front of notes -- push contents onto front of notes
modify $ \st -> st {stNotes = (htmlContents:notes)} modify $ \st -> st {stNotes = (htmlContents:notes)}
let revealSlash = ['/' | writerSlideVariant opts let revealSlash = ['/' | writerSlideVariant opts
@ -901,11 +920,11 @@ inlineToHtml opts inline = do
writerIdentifierPrefix opts ++ "fn" ++ ref) writerIdentifierPrefix opts ++ "fn" ++ ref)
! A.class_ "footnoteRef" ! A.class_ "footnoteRef"
! prefixedId opts ("fnref" ++ ref) ! prefixedId opts ("fnref" ++ ref)
$ (if isJust (writerEpubVersion opts) $ (if isJust epubVersion
then id then id
else H.sup) else H.sup)
$ toHtml ref $ toHtml ref
return $ case writerEpubVersion opts of return $ case epubVersion of
Just EPUB3 -> link ! customAttribute "epub:type" "noteref" Just EPUB3 -> link ! customAttribute "epub:type" "noteref"
_ -> link _ -> link
(Cite cits il)-> do contents <- inlineListToHtml opts il (Cite cits il)-> do contents <- inlineListToHtml opts il
@ -933,7 +952,8 @@ blockListToNote opts ref blocks =
Plain backlink] Plain backlink]
in do contents <- blockListToHtml opts blocks' in do contents <- blockListToHtml opts blocks'
let noteItem = H.li ! (prefixedId opts ("fn" ++ ref)) $ contents let noteItem = H.li ! (prefixedId opts ("fn" ++ ref)) $ contents
let noteItem' = case writerEpubVersion opts of epubVersion <- gets stEPUBVersion
let noteItem' = case epubVersion of
Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote" Just EPUB3 -> noteItem ! customAttribute "epub:type" "footnote"
_ -> noteItem _ -> noteItem
return $ nl opts >> noteItem' return $ nl opts >> noteItem'