673c044 · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

HTML writer: Better handling of authors in meta tags.

673c044John MacFarlane15 years ago

src/Text/Pandoc/Writers/HTML.hs+26−12

compare with master

unifiedsplit

@@ -34,6 +34,7 @@ import Text.Pandoc.Definition

34import Text.Pandoc.CharacterReferences ( decodeCharacterReferences )

35import Text.Pandoc.Shared

36import Text.Pandoc.Templates

37+import Text.Pandoc.Generic

37import Text.Pandoc.Readers.TeXMath

38import Text.Pandoc.Readers.TeXMath

38import Text.Pandoc.Highlighting ( highlight, styleToHtml,

39import Text.Pandoc.Highlighting ( highlight, styleToHtml,

39 formatHtmlInline, formatHtmlBlock )

40 formatHtmlInline, formatHtmlBlock )

@@ -80,25 +81,25 @@ nl opts = if writerWrapText opts

80-- | Convert Pandoc document to Html string.

81-- | Convert Pandoc document to Html string.

81writeHtmlString :: WriterOptions -> Pandoc -> String

82writeHtmlString :: WriterOptions -> Pandoc -> String

82writeHtmlString opts d =

83writeHtmlString opts d =

83− let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)

84+ let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)

84− defaultWriterState

85+ defaultWriterState

85 in if writerStandalone opts

86 in if writerStandalone opts

86− then inTemplate opts tit auths date toc body' newvars

87+ then inTemplate opts tit auths authsMeta date toc body' newvars

87 else renderHtml body'

88 else renderHtml body'

89-- | Convert Pandoc document to Html structure.

90-- | Convert Pandoc document to Html structure.

90writeHtml :: WriterOptions -> Pandoc -> Html

91writeHtml :: WriterOptions -> Pandoc -> Html

91writeHtml opts d =

92writeHtml opts d =

92− let (tit, auths, date, toc, body', newvars) = evalState (pandocToHtml opts d)

93+ let (tit, auths, authsMeta, date, toc, body', newvars) = evalState (pandocToHtml opts d)

93− defaultWriterState

94+ defaultWriterState

94 in if writerStandalone opts

95 in if writerStandalone opts

95− then inTemplate opts tit auths date toc body' newvars

96+ then inTemplate opts tit auths authsMeta date toc body' newvars

96 else body'

97 else body'

98-- result is (title, authors, date, toc, body, new variables)

99-- result is (title, authors, date, toc, body, new variables)

99pandocToHtml :: WriterOptions

100pandocToHtml :: WriterOptions

100 -> Pandoc

101 -> Pandoc

101− -> State WriterState (Html, [Html], Html, Maybe Html, Html, [(String,String)])

102+ -> State WriterState (Html, [Html], [Html], Html, Maybe Html, Html, [(String,String)])

102pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do

103pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do

103 let standalone = writerStandalone opts

104 let standalone = writerStandalone opts

104 tit <- if standalone

105 tit <- if standalone

@@ -107,6 +108,9 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do

107 auths <- if standalone

108 auths <- if standalone

108 then mapM (inlineListToHtml opts) authors'

109 then mapM (inlineListToHtml opts) authors'

109 else return []

110 else return []

111+ authsMeta <- if standalone

112+ then mapM (inlineListToHtml opts . prepForMeta) authors'

113+ else return []

110 date <- if standalone

114 date <- if standalone

111 then inlineListToHtml opts date'

115 then inlineListToHtml opts date'

112 else return mempty

116 else return mempty

@@ -158,20 +162,30 @@ pandocToHtml opts (Pandoc (Meta title' authors' date') blocks) = do

158 $ writerHighlightStyle opts) |

162 $ writerHighlightStyle opts) |

159 stHighlighting st] ++

163 stHighlighting st] ++

160 [("math", renderHtml math) | stMath st]

164 [("math", renderHtml math) | stMath st]

161− return (tit, auths, date, toc, thebody, newvars)

165+ return (tit, auths, authsMeta, date, toc, thebody, newvars)

166+

167+-- | Prepare author for meta tag, converting notes into

168+-- bracketed text and removing links.

169+prepForMeta :: [Inline] -> [Inline]

170+prepForMeta = bottomUp (concatMap fixInline)

171+ where fixInline (Note [Para xs]) = [Str " ["] ++ xs ++ [Str "]"]

172+ fixInline (Note [Plain xs]) = [Str " ["] ++ xs ++ [Str "]"]

173+ fixInline (Link lab _) = lab

174+ fixInline (Image lab _) = lab

175+ fixInline x = [x]

162

176

163inTemplate :: TemplateTarget a

177inTemplate :: TemplateTarget a

164 => WriterOptions

178 => WriterOptions

165 -> Html

179 -> Html

166 -> [Html]

180 -> [Html]

181+ -> [Html]

167 -> Html

182 -> Html

168 -> Maybe Html

183 -> Maybe Html

169 -> Html

184 -> Html

170 -> [(String,String)]

185 -> [(String,String)]

171 -> a

186 -> a

172−inTemplate opts tit auths date toc body' newvars =

187+inTemplate opts tit auths authsMeta date toc body' newvars =

173 let title' = renderHtml tit

188 let title' = renderHtml tit

174− authors = map renderHtml auths

175 date' = renderHtml date

189 date' = renderHtml date

176 variables = writerVariables opts ++ newvars

190 variables = writerVariables opts ++ newvars

177 context = variables ++

191 context = variables ++

@@ -187,8 +201,8 @@ inTemplate opts tit auths date toc body' newvars =

187 (case toc of

201 (case toc of

188 Just t -> [ ("toc", renderHtml t)]

202 Just t -> [ ("toc", renderHtml t)]

189 Nothing -> []) ++

203 Nothing -> []) ++

190− [ ("author", a) | a <- authors ] ++

204+ [ ("author", renderHtml a) | a <- auths ] ++

191− [ ("author-meta", stripTags a) | a <- authors ]

205+ [ ("author-meta", stripTags $ renderHtml a) | a <- authsMeta ]

192 in renderTemplate context $ writerTemplate opts

206 in renderTemplate context $ writerTemplate opts

193

207

194-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix

208-- | Like Text.XHtml's identifier, but adds the writerIdentifierPrefix