git.iko.soy/typeable/pandoc
on master help sign in
Refactored math conversion in writers.

* Remove exported module `Text.Pandoc.Readers.TeXMath` * Add exported module `Text.Pandoc.Writers.Math` * The function `texMathToInlines` now lives in `Text.Pandoc.Writers.Math` * Export helper function `convertMath` from `Text.Pandoc.Writers.Math` * Use these functions in all writers that do math conversion. This ensures that warnings will always be issued for failed math conversions.

commit830be4d63204b918afd15615d965bfbc40886cbe authorJohn MacFarlane <jgm@berkeley.edu> dateSat 3 Dec 2016, 16:15 (10 years ago) parent221f878
12 files changed+489−417
compare with master
unifiedsplit
pandoc.cabal+1−1 src/Text/Pandoc/Readers/TeXMath.hs−48 src/Text/Pandoc/Writers/Docbook.hs+150−135 src/Text/Pandoc/Writers/Docx.hs+6−12 src/Text/Pandoc/Writers/HTML.hs+6−9 src/Text/Pandoc/Writers/Haddock.hs+37−26 src/Text/Pandoc/Writers/ICML.hs+3−2 src/Text/Pandoc/Writers/Man.hs+3−3 src/Text/Pandoc/Writers/Markdown.hs+13−9 src/Text/Pandoc/Writers/Math.hs+47 src/Text/Pandoc/Writers/OpenDocument.hs+76−60 src/Text/Pandoc/Writers/RTF.hs+147−112
pandoc.cabal+1−1
@@ -341,7 +341,6 @@ Library
341341 Text.Pandoc.Readers.Org,
342342 Text.Pandoc.Readers.DocBook,
343343 Text.Pandoc.Readers.OPML,
344− Text.Pandoc.Readers.TeXMath,
345344 Text.Pandoc.Readers.Textile,
346345 Text.Pandoc.Readers.Native,
347346 Text.Pandoc.Readers.Haddock,
@@ -377,6 +376,7 @@ Library
377376 Text.Pandoc.Writers.EPUB,
378377 Text.Pandoc.Writers.FB2,
379378 Text.Pandoc.Writers.TEI,
379+ Text.Pandoc.Writers.Math,
380380 Text.Pandoc.PDF,
381381 Text.Pandoc.UTF8,
382382 Text.Pandoc.Templates,
src/Text/Pandoc/Readers/TeXMath.hsdeleted−48
@@ -1,48 +0,0 @@
1−{-
2−Copyright (C) 2007-2015 John MacFarlane <jgm@berkeley.edu>
3−
4−This program is free software; you can redistribute it and/or modify
5−it under the terms of the GNU General Public License as published by
6−the Free Software Foundation; either version 2 of the License, or
7−(at your option) any later version.
8−
9−This program is distributed in the hope that it will be useful,
10−but WITHOUT ANY WARRANTY; without even the implied warranty of
11−MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12−GNU General Public License for more details.
13−
14−You should have received a copy of the GNU General Public License
15−along with this program; if not, write to the Free Software
16−Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
17−-}
18−
19−{- |
20− Module : Text.Pandoc.Readers.TeXMath
21− Copyright : Copyright (C) 2007-2015 John MacFarlane
22− License : GNU GPL, version 2 or above
23−
24− Maintainer : John MacFarlane <jgm@berkeley.edu>
25− Stability : alpha
26− Portability : portable
27−
28−Conversion of TeX math to a list of 'Pandoc' inline elements.
29−-}
30−module Text.Pandoc.Readers.TeXMath ( texMathToInlines ) where
31−
32−import Text.Pandoc.Definition
33−import Text.TeXMath
34−
35−-- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
36−-- Defaults to raw formula between @$@ or @$$@ characters if entire formula
37−-- can't be converted.
38−texMathToInlines :: MathType
39− -> String -- ^ String to parse (assumes @'\n'@ line endings)
40− -> [Inline]
41−texMathToInlines mt inp =
42− case writePandoc dt `fmap` readTeX inp of
43− Right (Just ils) -> ils
44− _ -> [Str (delim ++ inp ++ delim)]
45− where (dt, delim) = case mt of
46− DisplayMath -> (DisplayBlock, "$$")
47− InlineMath -> (DisplayInline, "$")
48−
src/Text/Pandoc/Writers/Docbook.hs+150−135
@@ -36,7 +36,7 @@ import Text.Pandoc.Walk
3636import Text.Pandoc.Writers.Shared
3737import Text.Pandoc.Options
3838import Text.Pandoc.Templates (renderTemplate')
39−import Text.Pandoc.Readers.TeXMath
39+import Text.Pandoc.Writers.Math
4040import Data.List ( stripPrefix, isPrefixOf, intercalate, isSuffixOf )
4141import Data.Char ( toLower )
4242import Data.Monoid ( Any(..) )
@@ -50,13 +50,13 @@ import Data.Generics (everywhere, mkT)
5050import Text.Pandoc.Class (PandocMonad)
5151
5252-- | Convert list of authors to a docbook <author> section
53−authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines
54−authorToDocbook opts name' =
55− let name = render Nothing $ inlinesToDocbook opts name'
56− colwidth = if writerWrapText opts == WrapAuto
53+authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> m B.Inlines
54+authorToDocbook opts name' = do
55+ name <- render Nothing <$> inlinesToDocbook opts name'
56+ let colwidth = if writerWrapText opts == WrapAuto
5757 then Just $ writerColumns opts
5858 else Nothing
59− in B.rawInline "docbook" $ render colwidth $
59+ return $ B.rawInline "docbook" $ render colwidth $
6060 if ',' `elem` name
6161 then -- last name first
6262 let (lastname, rest) = break (==',') name
@@ -75,44 +75,45 @@ authorToDocbook opts name' =
7575
7676-- | Convert Pandoc document to string in Docbook format.
7777writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> m String
78−writeDocbook opts (Pandoc meta blocks) = return $
78+writeDocbook opts (Pandoc meta blocks) = do
7979 let elements = hierarchicalize blocks
80− colwidth = if writerWrapText opts == WrapAuto
80+ let colwidth = if writerWrapText opts == WrapAuto
8181 then Just $ writerColumns opts
8282 else Nothing
83− render' = render colwidth
84− opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
83+ let render' = render colwidth
84+ let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
8585 (writerTemplate opts) &&
8686 TopLevelDefault == writerTopLevelDivision opts)
8787 then opts{ writerTopLevelDivision = TopLevelChapter }
8888 else opts
89− -- The numbering here follows LaTeX's internal numbering
90− startLvl = case writerTopLevelDivision opts' of
89+ -- The numbering here follows LaTeX's internal numbering
90+ let startLvl = case writerTopLevelDivision opts' of
9191 TopLevelPart -> -1
9292 TopLevelChapter -> 0
9393 TopLevelSection -> 1
9494 TopLevelDefault -> 1
95− auths' = map (authorToDocbook opts) $ docAuthors meta
96− meta' = B.setMeta "author" auths' meta
97− Just metadata = metaToJSON opts
98− (Just . render colwidth . (vcat .
99− (map (elementToDocbook opts' startLvl)) . hierarchicalize))
100− (Just . render colwidth . inlinesToDocbook opts')
95+ auths' <- mapM (authorToDocbook opts) $ docAuthors meta
96+ let meta' = B.setMeta "author" auths' meta
97+ metadata <- metaToJSON opts
98+ (fmap (render colwidth . vcat) .
99+ (mapM (elementToDocbook opts' startLvl) .
100+ hierarchicalize))
101+ (fmap (render colwidth) . inlinesToDocbook opts')
101102 meta'
102− main = render' $ vcat (map (elementToDocbook opts' startLvl) elements)
103− context = defField "body" main
103+ main <- (render' . vcat) <$> mapM (elementToDocbook opts' startLvl) elements
104+ let context = defField "body" main
104105 $ defField "mathml" (case writerHTMLMathMethod opts of
105106 MathML _ -> True
106107 _ -> False)
107108 $ metadata
108− in case writerTemplate opts of
109+ return $ case writerTemplate opts of
109110 Nothing -> main
110111 Just tpl -> renderTemplate' tpl context
111112
112113-- | Convert an Element to Docbook.
113−elementToDocbook :: WriterOptions -> Int -> Element -> Doc
114+elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
114115elementToDocbook opts _ (Blk block) = blockToDocbook opts block
115−elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) =
116+elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
116117 -- Docbook doesn't allow sections with no content, so insert some if needed
117118 let elements' = if null elements
118119 then [Blk (Para [])]
@@ -131,13 +132,14 @@ elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) =
131132 nsAttr = if writerDocbook5 opts && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
132133 else []
133134 attribs = nsAttr ++ idAttr
134− in inTags True tag attribs $
135− inTagsSimple "title" (inlinesToDocbook opts title) $$
136− vcat (map (elementToDocbook opts (lvl + 1)) elements')
135+ contents <- mapM (elementToDocbook opts (lvl + 1)) elements'
136+ title' <- inlinesToDocbook opts title
137+ return $ inTags True tag attribs $
138+ inTagsSimple "title" title' $$ vcat contents
137139
138140-- | Convert a list of Pandoc blocks to Docbook.
139−blocksToDocbook :: WriterOptions -> [Block] -> Doc
140−blocksToDocbook opts = vcat . map (blockToDocbook opts)
141+blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> m Doc
142+blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts)
141143
142144-- | Auxiliary function to convert Plain block to Para.
143145plainToPara :: Block -> Block
@@ -146,26 +148,29 @@ plainToPara x = x
146148
147149-- | Convert a list of pairs of terms and definitions into a list of
148150-- Docbook varlistentrys.
149−deflistItemsToDocbook :: WriterOptions -> [([Inline],[[Block]])] -> Doc
151+deflistItemsToDocbook :: PandocMonad m
152+ => WriterOptions -> [([Inline],[[Block]])] -> m Doc
150153deflistItemsToDocbook opts items =
151− vcat $ map (\(term, defs) -> deflistItemToDocbook opts term defs) items
154+ vcat <$> mapM (\(term, defs) -> deflistItemToDocbook opts term defs) items
152155
153156-- | Convert a term and a list of blocks into a Docbook varlistentry.
154−deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> Doc
155−deflistItemToDocbook opts term defs =
156− let def' = concatMap (map plainToPara) defs
157− in inTagsIndented "varlistentry" $
158− inTagsIndented "term" (inlinesToDocbook opts term) $$
159− inTagsIndented "listitem" (blocksToDocbook opts def')
157+deflistItemToDocbook :: PandocMonad m
158+ => WriterOptions -> [Inline] -> [[Block]] -> m Doc
159+deflistItemToDocbook opts term defs = do
160+ term' <- inlinesToDocbook opts term
161+ def' <- blocksToDocbook opts $ concatMap (map plainToPara) defs
162+ return $ inTagsIndented "varlistentry" $
163+ inTagsIndented "term" term' $$
164+ inTagsIndented "listitem" def'
160165
161166-- | Convert a list of lists of blocks to a list of Docbook list items.
162−listItemsToDocbook :: WriterOptions -> [[Block]] -> Doc
163−listItemsToDocbook opts items = vcat $ map (listItemToDocbook opts) items
167+listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
168+listItemsToDocbook opts items = vcat <$> mapM (listItemToDocbook opts) items
164169
165170-- | Convert a list of blocks into a Docbook list item.
166−listItemToDocbook :: WriterOptions -> [Block] -> Doc
171+listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> m Doc
167172listItemToDocbook opts item =
168− inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item
173+ inTagsIndented "listitem" <$> blocksToDocbook opts (map plainToPara item)
169174
170175imageToDocbook :: WriterOptions -> Attr -> String -> Doc
171176imageToDocbook _ attr src = selfClosingTag "imagedata" $
@@ -177,43 +182,46 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $
177182 Nothing -> []
178183
179184-- | Convert a Pandoc block element to Docbook.
180−blockToDocbook :: WriterOptions -> Block -> Doc
181−blockToDocbook _ Null = empty
185+blockToDocbook :: PandocMonad m => WriterOptions -> Block -> m Doc
186+blockToDocbook _ Null = return empty
182187-- Add ids to paragraphs in divs with ids - this is needed for
183188-- pandoc-citeproc to get link anchors in bibliographies:
184189blockToDocbook opts (Div (ident,_,_) [Para lst]) =
185190 let attribs = [("id", ident) | not (null ident)] in
186191 if hasLineBreaks lst
187− then flush $ nowrap $ inTags False "literallayout" attribs
188− $ inlinesToDocbook opts lst
189− else inTags True "para" attribs $ inlinesToDocbook opts lst
190−blockToDocbook opts (Div (ident,_,_) bs) =
191− (if null ident
192− then mempty
193− else selfClosingTag "anchor" [("id", ident)]) $$
194− blocksToDocbook opts (map plainToPara bs)
195−blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize
192+ then (flush . nowrap . inTags False "literallayout" attribs)
193+ <$> inlinesToDocbook opts lst
194+ else inTags True "para" attribs <$> inlinesToDocbook opts lst
195+blockToDocbook opts (Div (ident,_,_) bs) = do
196+ contents <- blocksToDocbook opts (map plainToPara bs)
197+ return $
198+ (if null ident
199+ then mempty
200+ else selfClosingTag "anchor" [("id", ident)]) $$ contents
201+blockToDocbook _ (Header _ _ _) =
202+ return empty -- should not occur after hierarchicalize
196203blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
197204-- title beginning with fig: indicates that the image is a figure
198−blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) =
199− let alt = inlinesToDocbook opts txt
200− capt = if null txt
205+blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do
206+ alt <- inlinesToDocbook opts txt
207+ let capt = if null txt
201208 then empty
202209 else inTagsSimple "title" alt
203− in inTagsIndented "figure" $
210+ return $ inTagsIndented "figure" $
204211 capt $$
205212 (inTagsIndented "mediaobject" $
206213 (inTagsIndented "imageobject"
207214 (imageToDocbook opts attr src)) $$
208215 inTagsSimple "textobject" (inTagsSimple "phrase" alt))
209216blockToDocbook opts (Para lst)
210− | hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst
211− | otherwise = inTagsIndented "para" $ inlinesToDocbook opts lst
217+ | hasLineBreaks lst = (flush . nowrap . inTagsSimple "literallayout")
218+ <$> inlinesToDocbook opts lst
219+ | otherwise = inTagsIndented "para" <$> inlinesToDocbook opts lst
212220blockToDocbook opts (LineBlock lns) =
213221 blockToDocbook opts $ linesToPara lns
214222blockToDocbook opts (BlockQuote blocks) =
215− inTagsIndented "blockquote" $ blocksToDocbook opts blocks
216−blockToDocbook _ (CodeBlock (_,classes,_) str) =
223+ inTagsIndented "blockquote" <$> blocksToDocbook opts blocks
224+blockToDocbook _ (CodeBlock (_,classes,_) str) = return $
217225 text ("<programlisting" ++ lang ++ ">") <> cr <>
218226 flush (text (escapeStringForXML str) <> cr <> text "</programlisting>")
219227 where lang = if null langs
@@ -225,11 +233,11 @@ blockToDocbook _ (CodeBlock (_,classes,_) str) =
225233 then [s]
226234 else languagesByExtension . map toLower $ s
227235 langs = concatMap langsFrom classes
228−blockToDocbook opts (BulletList lst) =
236+blockToDocbook opts (BulletList lst) = do
229237 let attribs = [("spacing", "compact") | isTightList lst]
230− in inTags True "itemizedlist" attribs $ listItemsToDocbook opts lst
231−blockToDocbook _ (OrderedList _ []) = empty
232−blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
238+ inTags True "itemizedlist" attribs <$> listItemsToDocbook opts lst
239+blockToDocbook _ (OrderedList _ []) = return empty
240+blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = do
233241 let numeration = case numstyle of
234242 DefaultStyle -> []
235243 Decimal -> [("numeration", "arabic")]
@@ -240,39 +248,41 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
240248 LowerRoman -> [("numeration", "lowerroman")]
241249 spacing = [("spacing", "compact") | isTightList (first:rest)]
242250 attribs = numeration ++ spacing
243− items = if start == 1
244− then listItemsToDocbook opts (first:rest)
245− else (inTags True "listitem" [("override",show start)]
246− (blocksToDocbook opts $ map plainToPara first)) $$
247− listItemsToDocbook opts rest
248− in inTags True "orderedlist" attribs items
249−blockToDocbook opts (DefinitionList lst) =
251+ items <- if start == 1
252+ then listItemsToDocbook opts (first:rest)
253+ else do
254+ first' <- blocksToDocbook opts (map plainToPara first)
255+ rest' <- listItemsToDocbook opts rest
256+ return $
257+ (inTags True "listitem" [("override",show start)] first') $$
258+ rest'
259+ return $ inTags True "orderedlist" attribs items
260+blockToDocbook opts (DefinitionList lst) = do
250261 let attribs = [("spacing", "compact") | isTightList $ concatMap snd lst]
251− in inTags True "variablelist" attribs $ deflistItemsToDocbook opts lst
262+ inTags True "variablelist" attribs <$> deflistItemsToDocbook opts lst
252263blockToDocbook opts (RawBlock f str)
253− | f == "docbook" = text str -- raw XML block
264+ | f == "docbook" = return $ text str -- raw XML block
254265 | f == "html" = if writerDocbook5 opts
255− then empty -- No html in Docbook5
256− else text str -- allow html for backwards compatibility
257− | otherwise = empty
258−blockToDocbook _ HorizontalRule = empty -- not semantic
259−blockToDocbook opts (Table caption aligns widths headers rows) =
260− let captionDoc = if null caption
261− then empty
262− else inTagsIndented "title"
263− (inlinesToDocbook opts caption)
264− tableType = if isEmpty captionDoc then "informaltable" else "table"
266+ then return empty -- No html in Docbook5
267+ else return $ text str -- allow html for backwards compatibility
268+ | otherwise = return empty
269+blockToDocbook _ HorizontalRule = return empty -- not semantic
270+blockToDocbook opts (Table caption aligns widths headers rows) = do
271+ captionDoc <- if null caption
272+ then return empty
273+ else inTagsIndented "title" <$>
274+ inlinesToDocbook opts caption
275+ let tableType = if isEmpty captionDoc then "informaltable" else "table"
265276 percent w = show (truncate (100*w) :: Integer) ++ "*"
266277 coltags = vcat $ zipWith (\w al -> selfClosingTag "colspec"
267278 ([("colwidth", percent w) | w > 0] ++
268279 [("align", alignmentToString al)])) widths aligns
269− head' = if all null headers
270− then empty
271− else inTagsIndented "thead" $
272− tableRowToDocbook opts headers
273− body' = inTagsIndented "tbody" $
274− vcat $ map (tableRowToDocbook opts) rows
275− in inTagsIndented tableType $ captionDoc $$
280+ head' <- if all null headers
281+ then return empty
282+ else inTagsIndented "thead" <$> tableRowToDocbook opts headers
283+ body' <- (inTagsIndented "tbody" . vcat) <$>
284+ mapM (tableRowToDocbook opts) rows
285+ return $ inTagsIndented tableType $ captionDoc $$
276286 (inTags True "tgroup" [("cols", show (length headers))] $
277287 coltags $$ head' $$ body')
278288
@@ -293,92 +303,97 @@ alignmentToString alignment = case alignment of
293303 AlignCenter -> "center"
294304 AlignDefault -> "left"
295305
296−tableRowToDocbook :: WriterOptions
306+tableRowToDocbook :: PandocMonad m
307+ => WriterOptions
297308 -> [[Block]]
298− -> Doc
309+ -> m Doc
299310tableRowToDocbook opts cols =
300− inTagsIndented "row" $ vcat $ map (tableItemToDocbook opts) cols
311+ (inTagsIndented "row" . vcat) <$> mapM (tableItemToDocbook opts) cols
301312
302−tableItemToDocbook :: WriterOptions
313+tableItemToDocbook :: PandocMonad m
314+ => WriterOptions
303315 -> [Block]
304− -> Doc
316+ -> m Doc
305317tableItemToDocbook opts item =
306− inTags True "entry" [] $ vcat $ map (blockToDocbook opts) item
318+ (inTags True "entry" [] . vcat) <$> mapM (blockToDocbook opts) item
307319
308320-- | Convert a list of inline elements to Docbook.
309−inlinesToDocbook :: WriterOptions -> [Inline] -> Doc
310−inlinesToDocbook opts lst = hcat $ map (inlineToDocbook opts) lst
321+inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
322+inlinesToDocbook opts lst = hcat <$> mapM (inlineToDocbook opts) lst
311323
312324-- | Convert an inline element to Docbook.
313−inlineToDocbook :: WriterOptions -> Inline -> Doc
314−inlineToDocbook _ (Str str) = text $ escapeStringForXML str
325+inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> m Doc
326+inlineToDocbook _ (Str str) = return $ text $ escapeStringForXML str
315327inlineToDocbook opts (Emph lst) =
316− inTagsSimple "emphasis" $ inlinesToDocbook opts lst
328+ inTagsSimple "emphasis" <$> inlinesToDocbook opts lst
317329inlineToDocbook opts (Strong lst) =
318− inTags False "emphasis" [("role", "strong")] $ inlinesToDocbook opts lst
330+ inTags False "emphasis" [("role", "strong")] <$> inlinesToDocbook opts lst
319331inlineToDocbook opts (Strikeout lst) =
320− inTags False "emphasis" [("role", "strikethrough")] $
332+ inTags False "emphasis" [("role", "strikethrough")] <$>
321333 inlinesToDocbook opts lst
322334inlineToDocbook opts (Superscript lst) =
323− inTagsSimple "superscript" $ inlinesToDocbook opts lst
335+ inTagsSimple "superscript" <$> inlinesToDocbook opts lst
324336inlineToDocbook opts (Subscript lst) =
325− inTagsSimple "subscript" $ inlinesToDocbook opts lst
337+ inTagsSimple "subscript" <$> inlinesToDocbook opts lst
326338inlineToDocbook opts (SmallCaps lst) =
327− inTags False "emphasis" [("role", "smallcaps")] $
339+ inTags False "emphasis" [("role", "smallcaps")] <$>
328340 inlinesToDocbook opts lst
329341inlineToDocbook opts (Quoted _ lst) =
330− inTagsSimple "quote" $ inlinesToDocbook opts lst
342+ inTagsSimple "quote" <$> inlinesToDocbook opts lst
331343inlineToDocbook opts (Cite _ lst) =
332344 inlinesToDocbook opts lst
333345inlineToDocbook opts (Span (ident,_,_) ils) =
334− (if null ident
335− then mempty
336− else selfClosingTag "anchor" [("id", ident)]) <>
346+ ((if null ident
347+ then mempty
348+ else selfClosingTag "anchor" [("id", ident)]) <>) <$>
337349 inlinesToDocbook opts ils
338350inlineToDocbook _ (Code _ str) =
339− inTagsSimple "literal" $ text (escapeStringForXML str)
351+ return $ inTagsSimple "literal" $ text (escapeStringForXML str)
340352inlineToDocbook opts (Math t str)
341− | isMathML (writerHTMLMathMethod opts) =
342− case writeMathML dt <$> readTeX str of
343− Right r -> inTagsSimple tagtype
344− $ text $ Xml.ppcElement conf
345− $ fixNS
346− $ removeAttr r
347− Left _ -> inlinesToDocbook opts
348− $ texMathToInlines t str
349− | otherwise = inlinesToDocbook opts $ texMathToInlines t str
350− where (dt, tagtype) = case t of
351− InlineMath -> (DisplayInline,"inlineequation")
352− DisplayMath -> (DisplayBlock,"informalequation")
353+ | isMathML (writerHTMLMathMethod opts) = do
354+ res <- convertMath writeMathML t str
355+ case res of
356+ Right r -> return $ inTagsSimple tagtype
357+ $ text $ Xml.ppcElement conf
358+ $ fixNS
359+ $ removeAttr r
360+ Left il -> inlineToDocbook opts il
361+ | otherwise =
362+ texMathToInlines t str >>= inlinesToDocbook opts
363+ where tagtype = case t of
364+ InlineMath -> "inlineequation"
365+ DisplayMath -> "informalequation"
353366 conf = Xml.useShortEmptyTags (const False) Xml.defaultConfigPP
354367 removeAttr e = e{ Xml.elAttribs = [] }
355368 fixNS' qname = qname{ Xml.qPrefix = Just "mml" }
356369 fixNS = everywhere (mkT fixNS')
357−inlineToDocbook _ (RawInline f x) | f == "html" || f == "docbook" = text x
358− | otherwise = empty
359−inlineToDocbook _ LineBreak = text "\n"
370+inlineToDocbook _ (RawInline f x)
371+ | f == "html" || f == "docbook" = return $ text x
372+ | otherwise = return empty
373+inlineToDocbook _ LineBreak = return $ text "\n"
360374-- currently ignore, would require the option to add custom
361375-- styles to the document
362−inlineToDocbook _ PageBreak = empty
363−inlineToDocbook _ Space = space
376+inlineToDocbook _ PageBreak = return empty
377+inlineToDocbook _ Space = return space
364378-- because we use \n for LineBreak, we can't do soft breaks:
365−inlineToDocbook _ SoftBreak = space
379+inlineToDocbook _ SoftBreak = return space
366380inlineToDocbook opts (Link attr txt (src, _))
367381 | Just email <- stripPrefix "mailto:" src =
368382 let emailLink = inTagsSimple "email" $ text $
369383 escapeStringForXML $ email
370384 in case txt of
371− [Str s] | escapeURI s == email -> emailLink
372− _ -> inlinesToDocbook opts txt <+>
373− char '(' <> emailLink <> char ')'
385+ [Str s] | escapeURI s == email -> return emailLink
386+ _ -> do contents <- inlinesToDocbook opts txt
387+ return $ contents <+>
388+ char '(' <> emailLink <> char ')'
374389 | otherwise =
375390 (if isPrefixOf "#" src
376391 then inTags False "link" $ ("linkend", drop 1 src) : idAndRole attr
377392 else if writerDocbook5 opts
378393 then inTags False "link" $ ("xlink:href", src) : idAndRole attr
379− else inTags False "ulink" $ ("url", src) : idAndRole attr ) $
380− inlinesToDocbook opts txt
381−inlineToDocbook opts (Image attr _ (src, tit)) =
394+ else inTags False "ulink" $ ("url", src) : idAndRole attr )
395+ <$> inlinesToDocbook opts txt
396+inlineToDocbook opts (Image attr _ (src, tit)) = return $
382397 let titleDoc = if null tit
383398 then empty
384399 else inTagsIndented "objectinfo" $
@@ -386,7 +401,7 @@ inlineToDocbook opts (Image attr _ (src, tit)) =
386401 in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $
387402 titleDoc $$ imageToDocbook opts attr src
388403inlineToDocbook opts (Note contents) =
389− inTagsIndented "footnote" $ blocksToDocbook opts contents
404+ inTagsIndented "footnote" <$> blocksToDocbook opts contents
390405
391406isMathML :: HTMLMathMethod -> Bool
392407isMathML (MathML _) = True
src/Text/Pandoc/Writers/Docx.hs+6−12
@@ -45,7 +45,7 @@ import Text.Pandoc.ImageSize
4545import Text.Pandoc.Shared hiding (Element)
4646import Text.Pandoc.Writers.Shared (fixDisplayMath)
4747import Text.Pandoc.Options
48−import Text.Pandoc.Readers.TeXMath
48+import Text.Pandoc.Writers.Math
4949import Text.Pandoc.Highlighting ( highlight )
5050import Text.Pandoc.Walk
5151import Text.XML.Light as XML
@@ -1114,17 +1114,11 @@ inlineToOpenXML' opts (Quoted quoteType lst) =
11141114 SingleQuote -> ("\x2018", "\x2019")
11151115 DoubleQuote -> ("\x201C", "\x201D")
11161116inlineToOpenXML' opts (Math mathType str) = do
1117− let displayType = if mathType == DisplayMath
1118− then DisplayBlock
1119− else DisplayInline
1120− when (displayType == DisplayBlock) setFirstPara
1121− case writeOMML displayType <$> readTeX str of
1122− Right r -> return [r]
1123− Left e -> do
1124− (lift . lift) $ P.warn $
1125− "Cannot convert the following TeX math, skipping:\n" ++ str ++
1126− "\n" ++ e
1127− inlinesToOpenXML opts (texMathToInlines mathType str)
1117+ when (mathType == DisplayMath) setFirstPara
1118+ res <- (lift . lift) (convertMath writeOMML mathType str)
1119+ case res of
1120+ Right r -> return [r]
1121+ Left il -> inlineToOpenXML' opts il
11281122inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst
11291123inlineToOpenXML' opts (Code attrs str) = do
11301124 let unhighlighted = intercalate [br] `fmap`
src/Text/Pandoc/Writers/HTML.hs+6−9
@@ -36,7 +36,7 @@ import Text.Pandoc.Writers.Shared
3636import Text.Pandoc.Options
3737import Text.Pandoc.ImageSize
3838import Text.Pandoc.Templates
39−import Text.Pandoc.Readers.TeXMath
39+import Text.Pandoc.Writers.Math
4040import Text.Pandoc.Slides
4141import Text.Pandoc.Highlighting ( highlight, styleToCss,
4242 formatHtmlInline, formatHtmlBlock )
@@ -794,17 +794,14 @@ inlineToHtml opts inline =
794794 InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
795795 DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
796796 MathML _ -> do
797− let dt = if t == InlineMath
798− then DisplayInline
799− else DisplayBlock
800797 let conf = useShortEmptyTags (const False)
801798 defaultConfigPP
802− case writeMathML dt <$> readTeX str of
799+ res <- lift $ convertMath writeMathML t str
800+ case res of
803801 Right r -> return $ preEscapedString $
804802 ppcElement conf (annotateMML r str)
805− Left _ -> inlineListToHtml opts
806− (texMathToInlines t str) >>=
807− return . (H.span ! A.class_ mathClass)
803+ Left il -> (H.span ! A.class_ mathClass) <$>
804+ inlineToHtml opts il
808805 MathJax _ -> return $ H.span ! A.class_ mathClass $ toHtml $
809806 case t of
810807 InlineMath -> "\\(" ++ str ++ "\\)"
@@ -814,7 +811,7 @@ inlineToHtml opts inline =
814811 InlineMath -> str
815812 DisplayMath -> "\\displaystyle " ++ str)
816813 PlainMath -> do
817− x <- inlineListToHtml opts (texMathToInlines t str)
814+ x <- lift (texMathToInlines t str) >>= inlineListToHtml opts
818815 let m = H.span ! A.class_ mathClass $ x
819816 let brtag = if writerHtml5 opts then H5.br else H.br
820817 return $ case t of
src/Text/Pandoc/Writers/Haddock.hs+37−26
@@ -39,7 +39,7 @@ import Text.Pandoc.Options
3939import Data.List ( intersperse, transpose )
4040import Text.Pandoc.Pretty
4141import Control.Monad.State
42−import Text.Pandoc.Readers.TeXMath (texMathToInlines)
42+import Text.Pandoc.Writers.Math (texMathToInlines)
4343import Network.URI (isURI)
4444import Data.Default
4545import Text.Pandoc.Class (PandocMonad)
@@ -51,12 +51,13 @@ instance Default WriterState
5151
5252-- | Convert Pandoc to Haddock.
5353writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m String
54−writeHaddock opts document = return $
55− evalState (pandocToHaddock opts{
54+writeHaddock opts document =
55+ evalStateT (pandocToHaddock opts{
5656 writerWrapText = writerWrapText opts } document) def
5757
5858-- | Return haddock representation of document.
59−pandocToHaddock :: WriterOptions -> Pandoc -> State WriterState String
59+pandocToHaddock :: PandocMonad m
60+ => WriterOptions -> Pandoc -> StateT WriterState m String
6061pandocToHaddock opts (Pandoc meta blocks) = do
6162 let colwidth = if writerWrapText opts == WrapAuto
6263 then Just $ writerColumns opts
@@ -79,7 +80,8 @@ pandocToHaddock opts (Pandoc meta blocks) = do
7980 Just tpl -> return $ renderTemplate' tpl context
8081
8182-- | Return haddock representation of notes.
82−notesToHaddock :: WriterOptions -> [[Block]] -> State WriterState Doc
83+notesToHaddock :: PandocMonad m
84+ => WriterOptions -> [[Block]] -> StateT WriterState m Doc
8385notesToHaddock opts notes =
8486 if null notes
8587 then return empty
@@ -93,9 +95,10 @@ escapeString = escapeStringUsing haddockEscapes
9395 where haddockEscapes = backslashEscapes "\\/'`\"@<"
9496
9597-- | Convert Pandoc block element to haddock.
96−blockToHaddock :: WriterOptions -- ^ Options
97− -> Block -- ^ Block element
98− -> State WriterState Doc
98+blockToHaddock :: PandocMonad m
99+ => WriterOptions -- ^ Options
100+ -> Block -- ^ Block element
101+ -> StateT WriterState m Doc
99102blockToHaddock _ Null = return empty
100103blockToHaddock opts (Div _ ils) = do
101104 contents <- blockListToHaddock opts ils
@@ -168,8 +171,9 @@ blockToHaddock opts (DefinitionList items) = do
168171 contents <- mapM (definitionListItemToHaddock opts) items
169172 return $ cat contents <> blankline
170173
171−pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
172− -> [Doc] -> [[Doc]] -> State WriterState Doc
174+pandocTable :: PandocMonad m
175+ => WriterOptions -> Bool -> [Alignment] -> [Double]
176+ -> [Doc] -> [[Doc]] -> StateT WriterState m Doc
173177pandocTable opts headless aligns widths rawHeaders rawRows = do
174178 let isSimple = all (==0) widths
175179 let alignHeader alignment = case alignment of
@@ -208,8 +212,9 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
208212 else border
209213 return $ head'' $$ underline $$ body $$ bottom
210214
211−gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
212− -> [Doc] -> [[Doc]] -> State WriterState Doc
215+gridTable :: PandocMonad m
216+ => WriterOptions -> Bool -> [Alignment] -> [Double]
217+ -> [Doc] -> [[Doc]] -> StateT WriterState m Doc
213218gridTable opts headless _aligns widths headers' rawRows = do
214219 let numcols = length headers'
215220 let widths' = if all (==0) widths
@@ -236,7 +241,8 @@ gridTable opts headless _aligns widths headers' rawRows = do
236241 return $ border '-' $$ head'' $$ body $$ border '-'
237242
238243-- | Convert bullet list item (list of blocks) to haddock
239−bulletListItemToHaddock :: WriterOptions -> [Block] -> State WriterState Doc
244+bulletListItemToHaddock :: PandocMonad m
245+ => WriterOptions -> [Block] -> StateT WriterState m Doc
240246bulletListItemToHaddock opts items = do
241247 contents <- blockListToHaddock opts items
242248 let sps = replicate (writerTabStop opts - 2) ' '
@@ -251,10 +257,11 @@ bulletListItemToHaddock opts items = do
251257 return $ hang (writerTabStop opts) start $ contents' <> cr
252258
253259-- | Convert ordered list item (a list of blocks) to haddock
254−orderedListItemToHaddock :: WriterOptions -- ^ options
255− -> String -- ^ list item marker
256− -> [Block] -- ^ list item (list of blocks)
257− -> State WriterState Doc
260+orderedListItemToHaddock :: PandocMonad m
261+ => WriterOptions -- ^ options
262+ -> String -- ^ list item marker
263+ -> [Block] -- ^ list item (list of blocks)
264+ -> StateT WriterState m Doc
258265orderedListItemToHaddock opts marker items = do
259266 contents <- blockListToHaddock opts items
260267 let sps = case length marker - writerTabStop opts of
@@ -264,9 +271,10 @@ orderedListItemToHaddock opts marker items = do
264271 return $ hang (writerTabStop opts) start $ contents <> cr
265272
266273-- | Convert definition list item (label, list of blocks) to haddock
267−definitionListItemToHaddock :: WriterOptions
268− -> ([Inline],[[Block]])
269− -> State WriterState Doc
274+definitionListItemToHaddock :: PandocMonad m
275+ => WriterOptions
276+ -> ([Inline],[[Block]])
277+ -> StateT WriterState m Doc
270278definitionListItemToHaddock opts (label, defs) = do
271279 labelText <- inlineListToHaddock opts label
272280 defs' <- mapM (mapM (blockToHaddock opts)) defs
@@ -274,19 +282,22 @@ definitionListItemToHaddock opts (label, defs) = do
274282 return $ nowrap (brackets labelText) <> cr <> contents <> cr
275283
276284-- | Convert list of Pandoc block elements to haddock
277−blockListToHaddock :: WriterOptions -- ^ Options
278− -> [Block] -- ^ List of block elements
279− -> State WriterState Doc
285+blockListToHaddock :: PandocMonad m
286+ => WriterOptions -- ^ Options
287+ -> [Block] -- ^ List of block elements
288+ -> StateT WriterState m Doc
280289blockListToHaddock opts blocks =
281290 mapM (blockToHaddock opts) blocks >>= return . cat
282291
283292-- | Convert list of Pandoc inline elements to haddock.
284−inlineListToHaddock :: WriterOptions -> [Inline] -> State WriterState Doc
293+inlineListToHaddock :: PandocMonad m
294+ => WriterOptions -> [Inline] -> StateT WriterState m Doc
285295inlineListToHaddock opts lst =
286296 mapM (inlineToHaddock opts) lst >>= return . cat
287297
288298-- | Convert Pandoc inline element to haddock.
289−inlineToHaddock :: WriterOptions -> Inline -> State WriterState Doc
299+inlineToHaddock :: PandocMonad m
300+ => WriterOptions -> Inline -> StateT WriterState m Doc
290301inlineToHaddock opts (Span (ident,_,_) ils) = do
291302 contents <- inlineListToHaddock opts ils
292303 if not (null ident) && null ils
@@ -322,7 +333,7 @@ inlineToHaddock opts (Math mt str) = do
322333 let adjust x = case mt of
323334 DisplayMath -> cr <> x <> cr
324335 InlineMath -> x
325− adjust `fmap` (inlineListToHaddock opts $ texMathToInlines mt str)
336+ adjust <$> (lift (texMathToInlines mt str) >>= inlineListToHaddock opts)
326337inlineToHaddock _ (RawInline f str)
327338 | f == "haddock" = return $ text str
328339 | otherwise = return empty
src/Text/Pandoc/Writers/ICML.hs+3−2
@@ -16,7 +16,7 @@ into InDesign with File -> Place.
1616module Text.Pandoc.Writers.ICML (writeICML) where
1717import Text.Pandoc.Definition
1818import Text.Pandoc.XML
19−import Text.Pandoc.Readers.TeXMath (texMathToInlines)
19+import Text.Pandoc.Writers.Math (texMathToInlines)
2020import Text.Pandoc.Writers.Shared
2121import Text.Pandoc.Shared (linesToPara, splitBy)
2222import Text.Pandoc.Options
@@ -435,7 +435,8 @@ inlineToICML opts style SoftBreak =
435435inlineToICML _ style LineBreak = charStyle style $ text lineSeparator
436436inlineToICML _ _ PageBreak = return empty
437437inlineToICML opts style (Math mt str) =
438− cat <$> mapM (inlineToICML opts style) (texMathToInlines mt str)
438+ lift (texMathToInlines mt str) >>=
439+ (fmap cat . mapM (inlineToICML opts style))
439440inlineToICML _ _ (RawInline f str)
440441 | f == Format "icml" = return $ text str
441442 | otherwise = return empty
src/Text/Pandoc/Writers/Man.hs+3−3
@@ -34,7 +34,7 @@ import Text.Pandoc.Templates
3434import Text.Pandoc.Shared
3535import Text.Pandoc.Writers.Shared
3636import Text.Pandoc.Options
37−import Text.Pandoc.Readers.TeXMath
37+import Text.Pandoc.Writers.Math
3838import Text.Printf ( printf )
3939import Data.List ( stripPrefix, intersperse, intercalate )
4040import Data.Maybe (fromMaybe)
@@ -342,9 +342,9 @@ inlineToMan _ (Str str@('.':_)) =
342342 return $ afterBreak "\\&" <> text (escapeString str)
343343inlineToMan _ (Str str) = return $ text $ escapeString str
344344inlineToMan opts (Math InlineMath str) =
345− inlineListToMan opts $ texMathToInlines InlineMath str
345+ lift (texMathToInlines InlineMath str) >>= inlineListToMan opts
346346inlineToMan opts (Math DisplayMath str) = do
347− contents <- inlineListToMan opts $ texMathToInlines DisplayMath str
347+ contents <- lift (texMathToInlines DisplayMath str) >>= inlineListToMan opts
348348 return $ cr <> text ".RS" $$ contents $$ text ".RE"
349349inlineToMan _ (RawInline f str)
350350 | f == Format "man" = return $ text str
src/Text/Pandoc/Writers/Markdown.hs+13−9
@@ -48,7 +48,7 @@ import Control.Monad.Reader
4848import Control.Monad.State
4949import Control.Monad.Except (throwError)
5050import Text.Pandoc.Writers.HTML (writeHtmlString)
51−import Text.Pandoc.Readers.TeXMath (texMathToInlines)
51+import Text.Pandoc.Writers.Math (texMathToInlines)
5252import Text.HTML.TagSoup (parseTags, isTagText, Tag(..))
5353import Network.URI (isURI)
5454import Data.Default
@@ -200,7 +200,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
200200 Nothing -> empty
201201 let headerBlocks = filter isHeaderBlock blocks
202202 toc <- if writerTableOfContents opts
203− then lift $ lift $ tableOfContents opts headerBlocks
203+ then liftPandoc $ tableOfContents opts headerBlocks
204204 else return empty
205205 -- Strip off final 'references' header if markdown citations enabled
206206 let blocks' = if isEnabled Ext_citations opts
@@ -533,7 +533,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
533533 rawHeaders rawRows
534534 | isEnabled Ext_raw_html opts -> fmap (id,) $
535535 text <$>
536− (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [t])
536+ (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [t])
537537 | otherwise -> return $ (id, text "[TABLE]")
538538 return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
539539blockToMarkdown' opts (BulletList items) = do
@@ -985,9 +985,9 @@ inlineToMarkdown opts (Math InlineMath str) =
985985 return $ "\\\\(" <> text str <> "\\\\)"
986986 | otherwise -> do
987987 plain <- asks envPlain
988− inlineListToMarkdown opts $
989− (if plain then makeMathPlainer else id) $
990− texMathToInlines InlineMath str
988+ (liftPandoc (texMathToInlines InlineMath str)) >>=
989+ inlineListToMarkdown opts .
990+ (if plain then makeMathPlainer else id)
991991inlineToMarkdown opts (Math DisplayMath str) =
992992 case writerHTMLMathMethod opts of
993993 WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`
@@ -1000,7 +1000,8 @@ inlineToMarkdown opts (Math DisplayMath str) =
10001000 | isEnabled Ext_tex_math_double_backslash opts ->
10011001 return $ "\\\\[" <> text str <> "\\\\]"
10021002 | otherwise -> (\x -> cr <> x <> cr) `fmap`
1003− inlineListToMarkdown opts (texMathToInlines DisplayMath str)
1003+ (liftPandoc (texMathToInlines DisplayMath str) >>=
1004+ inlineListToMarkdown opts)
10041005inlineToMarkdown opts (RawInline f str) = do
10051006 plain <- asks envPlain
10061007 if not plain &&
@@ -1062,7 +1063,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
10621063 | isEnabled Ext_raw_html opts &&
10631064 not (isEnabled Ext_link_attributes opts) &&
10641065 attr /= nullAttr = -- use raw HTML
1065− (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]])
1066+ (text . trim) <$> (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]])
10661067 | otherwise = do
10671068 plain <- asks envPlain
10681069 linktext <- inlineListToMarkdown opts txt
@@ -1101,7 +1102,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
11011102 | isEnabled Ext_raw_html opts &&
11021103 not (isEnabled Ext_link_attributes opts) &&
11031104 attr /= nullAttr = -- use raw HTML
1104− (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [img]])
1105+ (text . trim) <$> (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [Plain [img]])
11051106 | otherwise = do
11061107 plain <- asks envPlain
11071108 let txt = if null alternate || alternate == [Str source]
@@ -1125,3 +1126,6 @@ makeMathPlainer = walk go
11251126 where
11261127 go (Emph xs) = Span nullAttr xs
11271128 go x = x
1129+
1130+liftPandoc :: PandocMonad m => m a -> MD m a
1131+liftPandoc = lift . lift
src/Text/Pandoc/Writers/Math.hsnew file+47
@@ -0,0 +1,47 @@
1+module Text.Pandoc.Writers.Math
2+ ( texMathToInlines
3+ , convertMath
4+ )
5+where
6+
7+import Text.Pandoc.Class
8+import Text.Pandoc.Definition
9+import Text.TeXMath (Exp, writePandoc, DisplayType(..), readTeX)
10+
11+-- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
12+-- Defaults to raw formula between @$@ or @$$@ characters if entire formula
13+-- can't be converted.
14+texMathToInlines :: PandocMonad m
15+ => MathType
16+ -> String -- ^ String to parse (assumes @'\n'@ line endings)
17+ -> m [Inline]
18+texMathToInlines mt inp = do
19+ res <- convertMath writePandoc mt inp
20+ case res of
21+ Right (Just ils) -> return ils
22+ Right (Nothing) -> return [mkFallback mt inp]
23+ Left il -> return [il]
24+
25+mkFallback :: MathType -> String -> Inline
26+mkFallback mt str = Str (delim ++ str ++ delim)
27+ where delim = case mt of
28+ DisplayMath -> "$$"
29+ InlineMath -> "$"
30+
31+-- | Converts a raw TeX math formula using a writer function,
32+-- issuing a warning and producing a fallback (a raw string)
33+-- on failure.
34+convertMath :: PandocMonad m
35+ => (DisplayType -> [Exp] -> a) -> MathType -> String
36+ -> m (Either Inline a)
37+convertMath writer mt str = do
38+ case writer dt <$> readTeX str of
39+ Right r -> return (Right r)
40+ Left e -> do
41+ warn $ "Could not convert TeX math, rendering as raw TeX:\n" ++
42+ str ++ "\n" ++ e
43+ return (Left $ mkFallback mt str)
44+ where dt = case mt of
45+ DisplayMath -> DisplayBlock
46+ InlineMath -> DisplayInline
47+
src/Text/Pandoc/Writers/OpenDocument.hs+76−60
@@ -35,8 +35,8 @@ import Text.Pandoc.Options
3535import Text.Pandoc.XML
3636import Text.Pandoc.Shared (linesToPara)
3737import Text.Pandoc.Templates (renderTemplate')
38−import Text.Pandoc.Readers.TeXMath
3938import Text.Pandoc.Readers.Odt.StyleReader
39+import Text.Pandoc.Writers.Math
4040import Text.Pandoc.Pretty
4141import Text.Printf ( printf )
4242import Control.Arrow ( (***), (>>>) )
@@ -58,6 +58,8 @@ plainToPara x = x
5858-- OpenDocument writer
5959--
6060
61+type OD m = StateT WriterState m
62+
6163data WriterState =
6264 WriterState { stNotes :: [Doc]
6365 , stTableStyles :: [Doc]
@@ -90,40 +92,40 @@ defaultWriterState =
9092when :: Bool -> Doc -> Doc
9193when p a = if p then a else empty
9294
93−addTableStyle :: Doc -> State WriterState ()
95+addTableStyle :: PandocMonad m => Doc -> OD m ()
9496addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s }
9597
96−addNote :: Doc -> State WriterState ()
98+addNote :: PandocMonad m => Doc -> OD m ()
9799addNote i = modify $ \s -> s { stNotes = i : stNotes s }
98100
99−addParaStyle :: Doc -> State WriterState ()
101+addParaStyle :: PandocMonad m => Doc -> OD m ()
100102addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
101103
102−addTextStyle :: Set.Set TextStyle -> (String, Doc) -> State WriterState ()
104+addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m ()
103105addTextStyle attrs i = modify $ \s ->
104106 s { stTextStyles = Map.insert attrs i (stTextStyles s) }
105107
106−addTextStyleAttr :: TextStyle -> State WriterState ()
108+addTextStyleAttr :: PandocMonad m => TextStyle -> OD m ()
107109addTextStyleAttr t = modify $ \s ->
108110 s { stTextStyleAttr = Set.insert t (stTextStyleAttr s) }
109111
110−increaseIndent :: State WriterState ()
112+increaseIndent :: PandocMonad m => OD m ()
111113increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
112114
113−resetIndent :: State WriterState ()
115+resetIndent :: PandocMonad m => OD m ()
114116resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
115117
116−inTightList :: State WriterState a -> State WriterState a
118+inTightList :: PandocMonad m => OD m a -> OD m a
117119inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
118120 modify (\s -> s { stTight = False }) >> return r
119121
120−setInDefinitionList :: Bool -> State WriterState ()
122+setInDefinitionList :: PandocMonad m => Bool -> OD m ()
121123setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
122124
123−setFirstPara :: State WriterState ()
125+setFirstPara :: PandocMonad m => OD m ()
124126setFirstPara = modify $ \s -> s { stFirstPara = True }
125127
126−inParagraphTags :: Doc -> State WriterState Doc
128+inParagraphTags :: PandocMonad m => Doc -> OD m Doc
127129inParagraphTags d | isEmpty d = return empty
128130inParagraphTags d = do
129131 b <- gets stFirstPara
@@ -139,7 +141,7 @@ inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
139141inSpanTags :: String -> Doc -> Doc
140142inSpanTags s = inTags False "text:span" [("text:style-name",s)]
141143
142−withTextStyle :: TextStyle -> State WriterState a -> State WriterState a
144+withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
143145withTextStyle s f = do
144146 oldTextStyleAttr <- gets stTextStyleAttr
145147 addTextStyleAttr s
@@ -147,7 +149,7 @@ withTextStyle s f = do
147149 modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr }
148150 return res
149151
150−inTextStyle :: Doc -> State WriterState Doc
152+inTextStyle :: PandocMonad m => Doc -> OD m Doc
151153inTextStyle d = do
152154 at <- gets stTextStyleAttr
153155 if Set.null at
@@ -168,7 +170,7 @@ inTextStyle d = do
168170 return $ inTags False
169171 "text:span" [("text:style-name",styleName)] d
170172
171−inHeaderTags :: Int -> Doc -> State WriterState Doc
173+inHeaderTags :: PandocMonad m => Int -> Doc -> OD m Doc
172174inHeaderTags i d =
173175 return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
174176 , ("text:outline-level", show i)] d
@@ -192,12 +194,12 @@ handleSpaces s
192194
193195-- | Convert Pandoc document to string in OpenDocument format.
194196writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String
195−writeOpenDocument opts (Pandoc meta blocks) = return $
197+writeOpenDocument opts (Pandoc meta blocks) = do
196198 let colwidth = if writerWrapText opts == WrapAuto
197199 then Just $ writerColumns opts
198200 else Nothing
199− render' = render colwidth
200− ((body, metadata),s) = flip runState
201+ let render' = render colwidth
202+ ((body, metadata),s) <- flip runStateT
201203 defaultWriterState $ do
202204 m <- metaToJSON opts
203205 (fmap (render colwidth) . blocksToOpenDocument opts)
@@ -210,33 +212,36 @@ writeOpenDocument opts (Pandoc meta blocks) = return $
210212 Map.elems (stTextStyles s))
211213 listStyle (n,l) = inTags True "text:list-style"
212214 [("style:name", "L" ++ show n)] (vcat l)
213− listStyles = map listStyle (stListStyles s)
214− automaticStyles = vcat $ reverse $ styles ++ listStyles
215− context = defField "body" body
215+ let listStyles = map listStyle (stListStyles s)
216+ let automaticStyles = vcat $ reverse $ styles ++ listStyles
217+ let context = defField "body" body
216218 $ defField "automatic-styles" (render' automaticStyles)
217219 $ metadata
218− in case writerTemplate opts of
219− Nothing -> body
220− Just tpl -> renderTemplate' tpl context
220+ return $ case writerTemplate opts of
221+ Nothing -> body
222+ Just tpl -> renderTemplate' tpl context
221223
222−withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
224+withParagraphStyle :: PandocMonad m
225+ => WriterOptions -> String -> [Block] -> OD m Doc
223226withParagraphStyle o s (b:bs)
224227 | Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l
225228 | otherwise = go =<< blockToOpenDocument o b
226229 where go i = (<>) i <$> withParagraphStyle o s bs
227230withParagraphStyle _ _ [] = return empty
228231
229−inPreformattedTags :: String -> State WriterState Doc
232+inPreformattedTags :: PandocMonad m => String -> OD m Doc
230233inPreformattedTags s = do
231234 n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")]
232235 return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s
233236
234−orderedListToOpenDocument :: WriterOptions -> Int -> [[Block]] -> State WriterState Doc
237+orderedListToOpenDocument :: PandocMonad m
238+ => WriterOptions -> Int -> [[Block]] -> OD m Doc
235239orderedListToOpenDocument o pn bs =
236240 vcat . map (inTagsIndented "text:list-item") <$>
237241 mapM (orderedItemToOpenDocument o pn . map plainToPara) bs
238242
239−orderedItemToOpenDocument :: WriterOptions -> Int -> [Block] -> State WriterState Doc
243+orderedItemToOpenDocument :: PandocMonad m
244+ => WriterOptions -> Int -> [Block] -> OD m Doc
240245orderedItemToOpenDocument o n (b:bs)
241246 | OrderedList a l <- b = newLevel a l
242247 | Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show n) <$> inlinesToOpenDocument o l
@@ -256,7 +261,8 @@ isTightList (b:_)
256261 | Plain {} : _ <- b = True
257262 | otherwise = False
258263
259−newOrderedListStyle :: Bool -> ListAttributes -> State WriterState (Int,Int)
264+newOrderedListStyle :: PandocMonad m
265+ => Bool -> ListAttributes -> OD m (Int,Int)
260266newOrderedListStyle b a = do
261267 ln <- (+) 1 . length <$> gets stListStyles
262268 let nbs = orderedListLevelStyle a (ln, [])
@@ -264,7 +270,8 @@ newOrderedListStyle b a = do
264270 modify $ \s -> s { stListStyles = nbs : stListStyles s }
265271 return (ln,pn)
266272
267−bulletListToOpenDocument :: WriterOptions -> [[Block]] -> State WriterState Doc
273+bulletListToOpenDocument :: PandocMonad m
274+ => WriterOptions -> [[Block]] -> OD m Doc
268275bulletListToOpenDocument o b = do
269276 ln <- (+) 1 . length <$> gets stListStyles
270277 (pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln
@@ -272,11 +279,13 @@ bulletListToOpenDocument o b = do
272279 is <- listItemsToOpenDocument ("P" ++ show pn) o b
273280 return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is
274281
275−listItemsToOpenDocument :: String -> WriterOptions -> [[Block]] -> State WriterState Doc
282+listItemsToOpenDocument :: PandocMonad m
283+ => String -> WriterOptions -> [[Block]] -> OD m Doc
276284listItemsToOpenDocument s o is =
277285 vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
278286
279−deflistItemToOpenDocument :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState Doc
287+deflistItemToOpenDocument :: PandocMonad m
288+ => WriterOptions -> ([Inline],[[Block]]) -> OD m Doc
280289deflistItemToOpenDocument o (t,d) = do
281290 let ts = if isTightList d
282291 then "Definition_20_Term_20_Tight" else "Definition_20_Term"
@@ -286,7 +295,8 @@ deflistItemToOpenDocument o (t,d) = do
286295 d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d
287296 return $ t' $$ d'
288297
289−inBlockQuote :: WriterOptions -> Int -> [Block] -> State WriterState Doc
298+inBlockQuote :: PandocMonad m
299+ => WriterOptions -> Int -> [Block] -> OD m Doc
290300inBlockQuote o i (b:bs)
291301 | BlockQuote l <- b = do increaseIndent
292302 ni <- paraStyle
@@ -298,11 +308,11 @@ inBlockQuote o i (b:bs)
298308inBlockQuote _ _ [] = resetIndent >> return empty
299309
300310-- | Convert a list of Pandoc blocks to OpenDocument.
301−blocksToOpenDocument :: WriterOptions -> [Block] -> State WriterState Doc
311+blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc
302312blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
303313
304314-- | Convert a Pandoc block element to OpenDocument.
305−blockToOpenDocument :: WriterOptions -> Block -> State WriterState Doc
315+blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc
306316blockToOpenDocument o bs
307317 | Plain b <- bs = if null b
308318 then return empty
@@ -374,29 +384,35 @@ blockToOpenDocument o bs
374384 endsWithPageBreak [PageBreak] = True
375385 endsWithPageBreak (_ : xs) = endsWithPageBreak xs
376386
377− paragraph :: [Inline] -> State WriterState Doc
387+ paragraph :: PandocMonad m => [Inline] -> OD m Doc
378388 paragraph [] = return empty
379389 paragraph (PageBreak : rest) | endsWithPageBreak rest = paraWithBreak PageBoth rest
380390 paragraph (PageBreak : rest) = paraWithBreak PageBefore rest
381391 paragraph inlines | endsWithPageBreak inlines = paraWithBreak PageAfter inlines
382392 paragraph inlines = inParagraphTags =<< inlinesToOpenDocument o inlines
383393
384− paraWithBreak :: ParaBreak -> [Inline] -> State WriterState Doc
394+ paraWithBreak :: PandocMonad m => ParaBreak -> [Inline] -> OD m Doc
385395 paraWithBreak breakKind bs = do
386396 pn <- paraBreakStyle breakKind
387397 withParagraphStyle o ("P" ++ show pn) [Para bs]
388398
389−colHeadsToOpenDocument :: WriterOptions -> String -> [String] -> [[Block]] -> State WriterState Doc
399+colHeadsToOpenDocument :: PandocMonad m
400+ => WriterOptions -> String -> [String] -> [[Block]]
401+ -> OD m Doc
390402colHeadsToOpenDocument o tn ns hs =
391403 inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$>
392404 mapM (tableItemToOpenDocument o tn) (zip ns hs)
393405
394−tableRowToOpenDocument :: WriterOptions -> String -> [String] -> [[Block]] -> State WriterState Doc
406+tableRowToOpenDocument :: PandocMonad m
407+ => WriterOptions -> String -> [String] -> [[Block]]
408+ -> OD m Doc
395409tableRowToOpenDocument o tn ns cs =
396410 inTagsIndented "table:table-row" . vcat <$>
397411 mapM (tableItemToOpenDocument o tn) (zip ns cs)
398412
399−tableItemToOpenDocument :: WriterOptions -> String -> (String,[Block])-> State WriterState Doc
413+tableItemToOpenDocument :: PandocMonad m
414+ => WriterOptions -> String -> (String,[Block])
415+ -> OD m Doc
400416tableItemToOpenDocument o tn (n,i) =
401417 let a = [ ("table:style-name" , tn ++ ".A1" )
402418 , ("office:value-type", "string" )
@@ -405,10 +421,10 @@ tableItemToOpenDocument o tn (n,i) =
405421 withParagraphStyle o n (map plainToPara i)
406422
407423-- | Convert a list of inline elements to OpenDocument.
408−inlinesToOpenDocument :: WriterOptions -> [Inline] -> State WriterState Doc
424+inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc
409425inlinesToOpenDocument o l = hcat <$> toChunks o l
410426
411−toChunks :: WriterOptions -> [Inline] -> State WriterState [Doc]
427+toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc]
412428toChunks _ [] = return []
413429toChunks o (x : xs)
414430 | isChunkable x = do
@@ -429,7 +445,7 @@ isChunkable SoftBreak = True
429445isChunkable _ = False
430446
431447-- | Convert an inline element to OpenDocument.
432−inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
448+inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc
433449inlineToOpenDocument o ils
434450 = case ils of
435451 Space -> return space
@@ -448,7 +464,8 @@ inlineToOpenDocument o ils
448464 SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l
449465 Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l
450466 Code _ s -> inlinedCode $ preformatted s
451− Math t s -> inlinesToOpenDocument o (texMathToInlines t s)
467+ Math t s -> lift (texMathToInlines t s) >>=
468+ inlinesToOpenDocument o
452469 Cite _ l -> inlinesToOpenDocument o l
453470 RawInline f s -> if f == Format "opendocument"
454471 then return $ text s
@@ -489,18 +506,18 @@ inlineToOpenDocument o ils
489506 addNote nn
490507 return nn
491508
492−bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))
493−bulletListStyle l =
494− let doStyles i = inTags True "text:list-level-style-bullet"
495− [ ("text:level" , show (i + 1) )
496− , ("text:style-name" , "Bullet_20_Symbols")
497− , ("style:num-suffix", "." )
498− , ("text:bullet-char", [bulletList !! i] )
499− ] (listLevelStyle (1 + i))
500− bulletList = map chr $ cycle [8226,8227,8259]
501− listElStyle = map doStyles [0..9]
502− in do pn <- paraListStyle l
503− return (pn, (l, listElStyle))
509+bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc]))
510+bulletListStyle l = do
511+ let doStyles i = inTags True "text:list-level-style-bullet"
512+ [ ("text:level" , show (i + 1) )
513+ , ("text:style-name" , "Bullet_20_Symbols")
514+ , ("style:num-suffix", "." )
515+ , ("text:bullet-char", [bulletList !! i] )
516+ ] (listLevelStyle (1 + i))
517+ bulletList = map chr $ cycle [8226,8227,8259]
518+ listElStyle = map doStyles [0..9]
519+ pn <- paraListStyle l
520+ return (pn, (l, listElStyle))
504521
505522orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc])
506523orderedListLevelStyle (s,n, d) (l,ls) =
@@ -554,7 +571,7 @@ tableStyle num wcs =
554571 columnStyles = map colStyle wcs
555572 in table $$ vcat columnStyles $$ cellStyle
556573
557−paraStyle :: [(String,String)] -> State WriterState Int
574+paraStyle :: PandocMonad m => [(String,String)] -> OD m Int
558575paraStyle attrs = do
559576 pn <- (+) 1 . length <$> gets stParaStyles
560577 i <- (*) 0.5 . fromIntegral <$> gets stIndentPara :: State WriterState Double
@@ -578,14 +595,13 @@ paraStyle attrs = do
578595 addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps
579596 return pn
580597
581−paraBreakStyle :: ParaBreak -> State WriterState Int
598+paraBreakStyle :: PandocMonad m => ParaBreak -> OD m Int
582599paraBreakStyle PageBefore = paraStyle "Text_20_body" [("fo:break-before", "page")]
583600paraBreakStyle PageAfter = paraStyle "Text_20_body" [("fo:break-after", "page")]
584601paraBreakStyle PageBoth = paraStyle "Text_20_body" [("fo:break-before", "page"), ("fo:break-after", "page")]
585602paraBreakStyle AutoNone = paraStyle "Text_20_body" []
586603
587−
588−paraListStyle :: Int -> State WriterState Int
604+paraListStyle :: PandocMonad m => Int -> OD m Int
589605paraListStyle l = paraStyle
590606 [("style:parent-style-name","Text_20_body")
591607 ,("style:list-style-name", "L" ++ show l )]
src/Text/Pandoc/Writers/RTF.hs+147−112
@@ -34,7 +34,7 @@ import Text.Pandoc.Definition
3434import Text.Pandoc.Options
3535import Text.Pandoc.Shared
3636import Text.Pandoc.Writers.Shared
37−import Text.Pandoc.Readers.TeXMath
37+import Text.Pandoc.Writers.Math
3838import Text.Pandoc.Templates (renderTemplate')
3939import Text.Pandoc.Walk
4040import Data.List ( isSuffixOf, intercalate )
@@ -83,49 +83,50 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
8383rtfEmbedImage _ x = return x
8484
8585-- | Convert Pandoc to a string in rich text format, with
86−-- images embedded as encoded binary data.
87−writeRTFWithEmbeddedImages :: PandocMonad m => WriterOptions -> Pandoc -> m String
86+-- images embedded as encoded binary data. TODO get rid of this,
87+-- we don't need it now that we have writeRTF in PandocMonad.
88+writeRTFWithEmbeddedImages :: PandocMonad m
89+ => WriterOptions -> Pandoc -> m String
8890writeRTFWithEmbeddedImages options doc =
89− writeRTF options `fmap` walkM (rtfEmbedImage options) doc
91+ writeRTF options =<< walkM (rtfEmbedImage options) doc
9092
9193-- | Convert Pandoc to a string in rich text format.
92−writeRTF :: WriterOptions -> Pandoc -> String
93−writeRTF options (Pandoc meta@(Meta metamap) blocks) =
94+writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m String
95+writeRTF options (Pandoc meta@(Meta metamap) blocks) = do
9496 let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
95− toPlain (MetaBlocks [Para ils]) = MetaInlines ils
97+ let toPlain (MetaBlocks [Para ils]) = MetaInlines ils
9698 toPlain x = x
97− -- adjust title, author, date so we don't get para inside para
98− meta' = Meta $ M.adjust toPlain "title"
99+ -- adjust title, author, date so we don't get para inside para
100+ let meta' = Meta $ M.adjust toPlain "title"
99101 . M.adjust toPlain "author"
100102 . M.adjust toPlain "date"
101103 $ metamap
102− Just metadata = metaToJSON options
103− (Just . concatMap (blockToRTF 0 AlignDefault))
104− (Just . inlineListToRTF)
104+ metadata <- metaToJSON options
105+ (fmap concat . mapM (blockToRTF 0 AlignDefault))
106+ (inlinesToRTF)
105107 meta'
106− body = concatMap (blockToRTF 0 AlignDefault) blocks
107− isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
108+ body <- blocksToRTF 0 AlignDefault blocks
109+ let isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
108110 isTOCHeader _ = False
109− context = defField "body" body
111+ toc <- tableOfContents $ filter isTOCHeader blocks
112+ let context = defField "body" body
110113 $ defField "spacer" spacer
111114 $ (if writerTableOfContents options
112− then defField "toc"
113− (tableOfContents $ filter isTOCHeader blocks)
115+ then defField "toc" toc
114116 else id)
115117 $ metadata
116− in case writerTemplate options of
118+ return $ case writerTemplate options of
117119 Just tpl -> renderTemplate' tpl context
118120 Nothing -> case reverse body of
119121 ('\n':_) -> body
120122 _ -> body ++ "\n"
121123
122124-- | Construct table of contents from list of header blocks.
123−tableOfContents :: [Block] -> String
124−tableOfContents headers =
125− let contentsTree = hierarchicalize headers
126− in concatMap (blockToRTF 0 AlignDefault) $
127− [Header 1 nullAttr [Str "Contents"],
128− BulletList (map elementToListItem contentsTree)]
125+tableOfContents :: PandocMonad m => [Block] -> m String
126+tableOfContents headers = do
127+ let contents = map elementToListItem $ hierarchicalize headers
128+ blocksToRTF 0 AlignDefault $
129+ [Header 1 nullAttr [Str "Contents"], BulletList contents]
129130
130131elementToListItem :: Element -> [Block]
131132elementToListItem (Blk _) = []
@@ -227,66 +228,81 @@ orderedMarkers indent (start, style, delim) =
227228 _ -> orderedListMarkers (start, LowerAlpha, Period)
228229 else orderedListMarkers (start, style, delim)
229230
231+blocksToRTF :: PandocMonad m
232+ => Int
233+ -> Alignment
234+ -> [Block]
235+ -> m String
236+blocksToRTF indent align = fmap concat . mapM (blockToRTF indent align)
237+
230238-- | Convert Pandoc block element to RTF.
231−blockToRTF :: Int -- ^ indent level
239+blockToRTF :: PandocMonad m
240+ => Int -- ^ indent level
232241 -> Alignment -- ^ alignment
233242 -> Block -- ^ block to convert
234− -> String
235−blockToRTF _ _ Null = ""
243+ -> m String
244+blockToRTF _ _ Null = return ""
236245blockToRTF indent alignment (Div _ bs) =
237− concatMap (blockToRTF indent alignment) bs
246+ blocksToRTF indent alignment bs
238247blockToRTF indent alignment (Plain lst) =
239− rtfCompact indent 0 alignment $ inlineListToRTF lst
248+ rtfCompact indent 0 alignment <$> inlinesToRTF lst
240249blockToRTF indent alignment (Para lst) =
241− rtfPar indent 0 alignment $ inlineListToRTF lst
250+ rtfPar indent 0 alignment <$> inlinesToRTF lst
242251blockToRTF indent alignment (LineBlock lns) =
243252 blockToRTF indent alignment $ linesToPara lns
244253blockToRTF indent alignment (BlockQuote lst) =
245− concatMap (blockToRTF (indent + indentIncrement) alignment) lst
254+ blocksToRTF (indent + indentIncrement) alignment lst
246255blockToRTF indent _ (CodeBlock _ str) =
247− rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
256+ return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
248257blockToRTF _ _ (RawBlock f str)
249− | f == Format "rtf" = str
250− | otherwise = ""
251−blockToRTF indent alignment (BulletList lst) = spaceAtEnd $
252− concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
253−blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $
254− zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
255−blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $
256− concatMap (definitionListItemToRTF alignment indent) lst
257−blockToRTF indent _ HorizontalRule =
258+ | f == Format "rtf" = return str
259+ | otherwise = return ""
260+blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$>
261+ mapM (listItemToRTF alignment indent (bulletMarker indent)) lst
262+blockToRTF indent alignment (OrderedList attribs lst) =
263+ (spaceAtEnd . concat) <$>
264+ mapM (\(x,y) -> listItemToRTF alignment indent x y)
265+ (zip (orderedMarkers indent attribs) lst)
266+blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$>
267+ mapM (definitionListItemToRTF alignment indent) lst
268+blockToRTF indent _ HorizontalRule = return $
258269 rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash"
259−blockToRTF indent alignment (Header level _ lst) = rtfPar indent 0 alignment $
260− "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst
261−blockToRTF indent alignment (Table caption aligns sizes headers rows) =
262− (if all null headers
263− then ""
264− else tableRowToRTF True indent aligns sizes headers) ++
265− concatMap (tableRowToRTF False indent aligns sizes) rows ++
266− rtfPar indent 0 alignment (inlineListToRTF caption)
270+blockToRTF indent alignment (Header level _ lst) = do
271+ contents <- inlinesToRTF lst
272+ return $ rtfPar indent 0 alignment $
273+ "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ contents
274+blockToRTF indent alignment (Table caption aligns sizes headers rows) = do
275+ caption' <- inlinesToRTF caption
276+ header' <- if all null headers
277+ then return ""
278+ else tableRowToRTF True indent aligns sizes headers
279+ rows' <- concat <$> mapM (tableRowToRTF False indent aligns sizes) rows
280+ return $ header' ++ rows' ++ rtfPar indent 0 alignment caption'
267281
268−tableRowToRTF :: Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> String
269−tableRowToRTF header indent aligns sizes' cols =
282+tableRowToRTF :: PandocMonad m
283+ => Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m String
284+tableRowToRTF header indent aligns sizes' cols = do
270285 let totalTwips = 6 * 1440 -- 6 inches
271− sizes = if all (== 0) sizes'
286+ let sizes = if all (== 0) sizes'
272287 then take (length cols) $ repeat (1.0 / fromIntegral (length cols))
273288 else sizes'
274− columns = concat $ zipWith (tableItemToRTF indent) aligns cols
275− rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
289+ columns <- concat <$> mapM (\(x,y) -> tableItemToRTF indent x y)
290+ (zip aligns cols)
291+ let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
276292 (0 :: Integer) sizes
277− cellDefs = map (\edge -> (if header
293+ let cellDefs = map (\edge -> (if header
278294 then "\\clbrdrb\\brdrs"
279295 else "") ++ "\\cellx" ++ show edge)
280296 rightEdges
281− start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
297+ let start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
282298 "\\trkeep\\intbl\n{\n"
283− end = "}\n\\intbl\\row}\n"
284− in start ++ columns ++ end
299+ let end = "}\n\\intbl\\row}\n"
300+ return $ start ++ columns ++ end
285301
286−tableItemToRTF :: Int -> Alignment -> [Block] -> String
287−tableItemToRTF indent alignment item =
288− let contents = concatMap (blockToRTF indent alignment) item
289− in "{" ++ substitute "\\pard" "\\pard\\intbl" contents ++ "\\cell}\n"
302+tableItemToRTF :: PandocMonad m => Int -> Alignment -> [Block] -> m String
303+tableItemToRTF indent alignment item = do
304+ contents <- blocksToRTF indent alignment item
305+ return $ "{" ++ substitute "\\pard" "\\pard\\intbl" contents ++ "\\cell}\n"
290306
291307-- | Ensure that there's the same amount of space after compact
292308-- lists as after regular lists.
@@ -297,74 +313,93 @@ spaceAtEnd str =
297313 else str
298314
299315-- | Convert list item (list of blocks) to RTF.
300−listItemToRTF :: Alignment -- ^ alignment
316+listItemToRTF :: PandocMonad m
317+ => Alignment -- ^ alignment
301318 -> Int -- ^ indent level
302319 -> String -- ^ list start marker
303320 -> [Block] -- ^ list item (list of blocks)
304− -> [Char]
305−listItemToRTF alignment indent marker [] =
321+ -> m String
322+listItemToRTF alignment indent marker [] = return $
306323 rtfCompact (indent + listIncrement) (0 - listIncrement) alignment
307324 (marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
308−listItemToRTF alignment indent marker list =
309− let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list
310− listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++ "\\tx" ++
311− show listIncrement ++ "\\tab"
312− insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d =
325+listItemToRTF alignment indent marker list = do
326+ (first:rest) <- mapM (blockToRTF (indent + listIncrement) alignment) list
327+ let listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++
328+ "\\tx" ++ show listIncrement ++ "\\tab"
329+ let insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d =
313330 listMarker ++ dropWhile isDigit xs
314331 insertListMarker ('\\':'f':'i':d:xs) | isDigit d =
315332 listMarker ++ dropWhile isDigit xs
316333 insertListMarker (x:xs) =
317334 x : insertListMarker xs
318335 insertListMarker [] = []
319− -- insert the list marker into the (processed) first block
320− in insertListMarker first ++ concat rest
336+ -- insert the list marker into the (processed) first block
337+ return $ insertListMarker first ++ concat rest
321338
322339-- | Convert definition list item (label, list of blocks) to RTF.
323−definitionListItemToRTF :: Alignment -- ^ alignment
340+definitionListItemToRTF :: PandocMonad m
341+ => Alignment -- ^ alignment
324342 -> Int -- ^ indent level
325343 -> ([Inline],[[Block]]) -- ^ list item (list of blocks)
326− -> [Char]
327−definitionListItemToRTF alignment indent (label, defs) =
328− let labelText = blockToRTF indent alignment (Plain label)
329− itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) $
330− concat defs
331− in labelText ++ itemsText
344+ -> m String
345+definitionListItemToRTF alignment indent (label, defs) = do
346+ labelText <- blockToRTF indent alignment (Plain label)
347+ itemsText <- blocksToRTF (indent + listIncrement) alignment (concat defs)
348+ return $ labelText ++ itemsText
332349
333350-- | Convert list of inline items to RTF.
334−inlineListToRTF :: [Inline] -- ^ list of inlines to convert
335− -> String
336−inlineListToRTF lst = concatMap inlineToRTF lst
351+inlinesToRTF :: PandocMonad m
352+ => [Inline] -- ^ list of inlines to convert
353+ -> m String
354+inlinesToRTF lst = concat <$> mapM inlineToRTF lst
337355
338356-- | Convert inline item to RTF.
339−inlineToRTF :: Inline -- ^ inline to convert
340− -> String
341−inlineToRTF (Span _ lst) = inlineListToRTF lst
342−inlineToRTF (Emph lst) = "{\\i " ++ (inlineListToRTF lst) ++ "}"
343−inlineToRTF (Strong lst) = "{\\b " ++ (inlineListToRTF lst) ++ "}"
344−inlineToRTF (Strikeout lst) = "{\\strike " ++ (inlineListToRTF lst) ++ "}"
345−inlineToRTF (Superscript lst) = "{\\super " ++ (inlineListToRTF lst) ++ "}"
346−inlineToRTF (Subscript lst) = "{\\sub " ++ (inlineListToRTF lst) ++ "}"
347−inlineToRTF (SmallCaps lst) = "{\\scaps " ++ (inlineListToRTF lst) ++ "}"
348−inlineToRTF (Quoted SingleQuote lst) =
349− "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'"
350−inlineToRTF (Quoted DoubleQuote lst) =
351− "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\""
352−inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}"
353−inlineToRTF (Str str) = stringToRTF str
354−inlineToRTF (Math t str) = inlineListToRTF $ texMathToInlines t str
355−inlineToRTF (Cite _ lst) = inlineListToRTF lst
357+inlineToRTF :: PandocMonad m
358+ => Inline -- ^ inline to convert
359+ -> m String
360+inlineToRTF (Span _ lst) = inlinesToRTF lst
361+inlineToRTF (Emph lst) = do
362+ contents <- inlinesToRTF lst
363+ return $ "{\\i " ++ contents ++ "}"
364+inlineToRTF (Strong lst) = do
365+ contents <- inlinesToRTF lst
366+ return $ "{\\b " ++ contents ++ "}"
367+inlineToRTF (Strikeout lst) = do
368+ contents <- inlinesToRTF lst
369+ return $ "{\\strike " ++ contents ++ "}"
370+inlineToRTF (Superscript lst) = do
371+ contents <- inlinesToRTF lst
372+ return $ "{\\super " ++ contents ++ "}"
373+inlineToRTF (Subscript lst) = do
374+ contents <- inlinesToRTF lst
375+ return $ "{\\sub " ++ contents ++ "}"
376+inlineToRTF (SmallCaps lst) = do
377+ contents <- inlinesToRTF lst
378+ return $ "{\\scaps " ++ contents ++ "}"
379+inlineToRTF (Quoted SingleQuote lst) = do
380+ contents <- inlinesToRTF lst
381+ return $ "\\u8216'" ++ contents ++ "\\u8217'"
382+inlineToRTF (Quoted DoubleQuote lst) = do
383+ contents <- inlinesToRTF lst
384+ return $ "\\u8220\"" ++ contents ++ "\\u8221\""
385+inlineToRTF (Code _ str) = return $ "{\\f1 " ++ (codeStringToRTF str) ++ "}"
386+inlineToRTF (Str str) = return $ stringToRTF str
387+inlineToRTF (Math t str) = texMathToInlines t str >>= inlinesToRTF
388+inlineToRTF (Cite _ lst) = inlinesToRTF lst
356389inlineToRTF (RawInline f str)
357− | f == Format "rtf" = str
358− | otherwise = ""
359−inlineToRTF LineBreak = "\\line "
360−inlineToRTF SoftBreak = " "
361−inlineToRTF PageBreak = "\\page "
362−inlineToRTF Space = " "
363−inlineToRTF (Link _ text (src, _)) =
364− "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
365− "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n"
390+ | f == Format "rtf" = return str
391+ | otherwise = return ""
392+inlineToRTF (LineBreak) = return "\\line "
393+inlineToRTF SoftBreak = return " "
394+inlineToRTF PageBreak = return "\\page "
395+inlineToRTF Space = return " "
396+inlineToRTF (Link _ text (src, _)) = do
397+ contents <- inlinesToRTF text
398+ return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
399+ "\"}}{\\fldrslt{\\ul\n" ++ contents ++ "\n}}}\n"
366400inlineToRTF (Image _ _ (source, _)) =
367− "{\\cf1 [image: " ++ source ++ "]\\cf0}"
368−inlineToRTF (Note contents) =
369− "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
370− (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}"
401+ return $ "{\\cf1 [image: " ++ source ++ "]\\cf0}"
402+inlineToRTF (Note contents) = do
403+ body <- concat <$> mapM (blockToRTF 0 AlignDefault) contents
404+ return $ "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
405+ body ++ "}"