diff options
Diffstat (limited to 'src/Text/Pandoc/Writers/HTML.hs')
| -rw-r--r-- | src/Text/Pandoc/Writers/HTML.hs | 38 |
1 files changed, 26 insertions, 12 deletions
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs index 8eb5092f9..d6077c63e 100644 --- a/src/Text/Pandoc/Writers/HTML.hs +++ b/src/Text/Pandoc/Writers/HTML.hs @@ -34,6 +34,7 @@ import Text.Pandoc.Definition import Text.Pandoc.CharacterReferences ( decodeCharacterReferences ) import Text.Pandoc.Shared import Text.Pandoc.Templates +import Text.Pandoc.Generic import Text.Pandoc.Readers.TeXMath import Text.Pandoc.Highlighting ( highlight, styleToHtml, formatHtmlInline, formatHtmlBlock ) @@ -80,25 +81,25 @@ nl opts = if writerWrapText opts -- | Convert Pandoc document to Html string. writeHtmlString :: WriterOptions -> Pandoc -> String writeHtmlString opts d = - let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d) - defaultWriterState + let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) + defaultWriterState in if writerStandalone opts - then inTemplate opts tit auths date toc body' newvars + then inTemplate opts tit auths authsMeta date toc body' newvars else renderHtml body' -- | Convert Pandoc document to Html structure. writeHtml :: WriterOptions -> Pandoc -> Html writeHtml opts d = - let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d) - defaultWriterState + let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d) + defaultWriterState in if writerStandalone opts - then inTemplate opts tit auths date toc body' newvars + then inTemplate opts tit auths authsMeta date toc body' newvars else body' -- result is (title, authors, date, toc, body, new variables) pandocToHtml :: WriterOptions -> Pandoc - -> State WriterState (Html, [Html], Html, Maybe Html, Html, [(String,String)]) + -> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)]) pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do let standalone = writerStandalone opts tit <- if standalone @@ -107,6 +108,9 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do auths <- if standalone then mapM (inlineListToHtml opts) authors' else return [] + authsMeta <- if standalone + then mapM (inlineListToHtml opts . prepForMeta) authors' + else return [] date <- if standalone then inlineListToHtml opts date' else return mempty @@ -158,20 +162,30 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do $ writerHighlightStyle opts) | stHighlighting st] ++ [("math", renderHtml math) | stMath st] - return (tit, auths, date, toc, thebody, newvars) + return (tit, auths, authsMeta, date, toc, thebody, newvars) + +-- | Prepare author for meta tag, converting notes into +-- bracketed text and removing links. +prepForMeta :: [Inline] -> [Inline] +prepForMeta = bottomUp (concatMap fixInline) + where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"] + fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"] + fixInline (Link lab _) = lab + fixInline (Image lab _) = lab + fixInline x = [x] inTemplate :: TemplateTarget a => WriterOptions -> Html -> [Html] + -> [Html] -> Html -> Maybe Html -> Html -> [(String,String)] -> a -inTemplate opts tit auths date toc body' newvars = +inTemplate opts tit auths authsMeta date toc body' newvars = let title' = renderHtml tit - authors = map renderHtml auths date' = renderHtml date variables = writerVariables opts ++ newvars context = variables ++ @@ -187,8 +201,8 @@ inTemplate opts tit auths date toc body' newvars = (case toc of Just t -> [ ("toc", renderHtml t)] Nothing -> []) ++ - [ ("author", a) | a <- authors ] ++ - [ ("author-meta", stripTags a) | a <- authors ] + [ ("author", renderHtml a) | a <- auths ] ++ + [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ] in renderTemplate context $ writerTemplate opts -- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix |