From 830be4d63204b918afd15615d965bfbc40886cbe Mon Sep 17 00:00:00 2001
From: John MacFarlane <jgm@berkeley.edu>
Date: Sat, 3 Dec 2016 16:15:13 +0100
Subject: [PATCH] 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.
---
pandoc.cabal | 2 +-
src/Text/Pandoc/Readers/TeXMath.hs | 48 ----
src/Text/Pandoc/Writers/Docbook.hs | 285 +++++++++++++-----------
src/Text/Pandoc/Writers/Docx.hs | 18 +-
src/Text/Pandoc/Writers/HTML.hs | 15 +-
src/Text/Pandoc/Writers/Haddock.hs | 63 +++---
src/Text/Pandoc/Writers/ICML.hs | 5 +-
src/Text/Pandoc/Writers/Man.hs | 6 +-
src/Text/Pandoc/Writers/Markdown.hs | 22 +-
src/Text/Pandoc/Writers/Math.hs | 47 ++++
src/Text/Pandoc/Writers/OpenDocument.hs | 136 ++++++-----
src/Text/Pandoc/Writers/RTF.hs | 259 +++++++++++----------
12 files changed, 489 insertions(+), 417 deletions(-)
delete mode 100644 src/Text/Pandoc/Readers/TeXMath.hs
create mode 100644 src/Text/Pandoc/Writers/Math.hs
diff --git a/pandoc.cabal b/pandoc.cabal
index dbd0a4d1c..691c83099 100644
--- a/pandoc.cabal
+++ b/pandoc.cabal
@@ -341,7 +341,6 @@ Library
Text.Pandoc.Readers.Org,
Text.Pandoc.Readers.DocBook,
Text.Pandoc.Readers.OPML,
- Text.Pandoc.Readers.TeXMath,
Text.Pandoc.Readers.Textile,
Text.Pandoc.Readers.Native,
Text.Pandoc.Readers.Haddock,
@@ -377,6 +376,7 @@ Library
Text.Pandoc.Writers.EPUB,
Text.Pandoc.Writers.FB2,
Text.Pandoc.Writers.TEI,
+ Text.Pandoc.Writers.Math,
Text.Pandoc.PDF,
Text.Pandoc.UTF8,
Text.Pandoc.Templates,
diff --git a/src/Text/Pandoc/Readers/TeXMath.hs b/src/Text/Pandoc/Readers/TeXMath.hs
deleted file mode 100644
index e5778b123..000000000
--- a/src/Text/Pandoc/Readers/TeXMath.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{-
-Copyright (C) 2007-2015 John MacFarlane <jgm@berkeley.edu>
-
-This program is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or
-(at your option) any later version.
-
-This program is distributed in the hope that it will be useful,
-but WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-GNU General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with this program; if not, write to the Free Software
-Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
--}
-
-{- |
- Module : Text.Pandoc.Readers.TeXMath
- Copyright : Copyright (C) 2007-2015 John MacFarlane
- License : GNU GPL, version 2 or above
-
- Maintainer : John MacFarlane <jgm@berkeley.edu>
- Stability : alpha
- Portability : portable
-
-Conversion of TeX math to a list of 'Pandoc' inline elements.
--}
-module Text.Pandoc.Readers.TeXMath ( texMathToInlines ) where
-
-import Text.Pandoc.Definition
-import Text.TeXMath
-
--- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
--- Defaults to raw formula between @$@ or @$$@ characters if entire formula
--- can't be converted.
-texMathToInlines :: MathType
- -> String -- ^ String to parse (assumes @'\n'@ line endings)
- -> [Inline]
-texMathToInlines mt inp =
- case writePandoc dt `fmap` readTeX inp of
- Right (Just ils) -> ils
- _ -> [Str (delim ++ inp ++ delim)]
- where (dt, delim) = case mt of
- DisplayMath -> (DisplayBlock, "$$")
- InlineMath -> (DisplayInline, "$")
-
diff --git a/src/Text/Pandoc/Writers/Docbook.hs b/src/Text/Pandoc/Writers/Docbook.hs
index 74e3bff3d..0ec7445be 100644
--- a/src/Text/Pandoc/Writers/Docbook.hs
+++ b/src/Text/Pandoc/Writers/Docbook.hs
@@ -36,7 +36,7 @@ import Text.Pandoc.Walk
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
import Text.Pandoc.Templates (renderTemplate')
-import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Writers.Math
import Data.List ( stripPrefix, isPrefixOf, intercalate, isSuffixOf )
import Data.Char ( toLower )
import Data.Monoid ( Any(..) )
@@ -50,13 +50,13 @@ import Data.Generics (everywhere, mkT)
import Text.Pandoc.Class (PandocMonad)
-- | Convert list of authors to a docbook <author> section
-authorToDocbook :: WriterOptions -> [Inline] -> B.Inlines
-authorToDocbook opts name' =
- let name = render Nothing $ inlinesToDocbook opts name'
- colwidth = if writerWrapText opts == WrapAuto
+authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> m B.Inlines
+authorToDocbook opts name' = do
+ name <- render Nothing <$> inlinesToDocbook opts name'
+ let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- in B.rawInline "docbook" $ render colwidth $
+ return $ B.rawInline "docbook" $ render colwidth $
if ',' `elem` name
then -- last name first
let (lastname, rest) = break (==',') name
@@ -75,44 +75,45 @@ authorToDocbook opts name' =
-- | Convert Pandoc document to string in Docbook format.
writeDocbook :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeDocbook opts (Pandoc meta blocks) = return $
+writeDocbook opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
- colwidth = if writerWrapText opts == WrapAuto
+ let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- render' = render colwidth
- opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
+ let render' = render colwidth
+ let opts' = if (maybe False (("/book>" `isSuffixOf`) . trimr)
(writerTemplate opts) &&
TopLevelDefault == writerTopLevelDivision opts)
then opts{ writerTopLevelDivision = TopLevelChapter }
else opts
- -- The numbering here follows LaTeX's internal numbering
- startLvl = case writerTopLevelDivision opts' of
+ -- The numbering here follows LaTeX's internal numbering
+ let startLvl = case writerTopLevelDivision opts' of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
- auths' = map (authorToDocbook opts) $ docAuthors meta
- meta' = B.setMeta "author" auths' meta
- Just metadata = metaToJSON opts
- (Just . render colwidth . (vcat .
- (map (elementToDocbook opts' startLvl)) . hierarchicalize))
- (Just . render colwidth . inlinesToDocbook opts')
+ auths' <- mapM (authorToDocbook opts) $ docAuthors meta
+ let meta' = B.setMeta "author" auths' meta
+ metadata <- metaToJSON opts
+ (fmap (render colwidth . vcat) .
+ (mapM (elementToDocbook opts' startLvl) .
+ hierarchicalize))
+ (fmap (render colwidth) . inlinesToDocbook opts')
meta'
- main = render' $ vcat (map (elementToDocbook opts' startLvl) elements)
- context = defField "body" main
+ main <- (render' . vcat) <$> mapM (elementToDocbook opts' startLvl) elements
+ let context = defField "body" main
$ defField "mathml" (case writerHTMLMathMethod opts of
MathML _ -> True
_ -> False)
$ metadata
- in case writerTemplate opts of
+ return $ case writerTemplate opts of
Nothing -> main
Just tpl -> renderTemplate' tpl context
-- | Convert an Element to Docbook.
-elementToDocbook :: WriterOptions -> Int -> Element -> Doc
+elementToDocbook :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
elementToDocbook opts _ (Blk block) = blockToDocbook opts block
-elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) =
+elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) = do
-- Docbook doesn't allow sections with no content, so insert some if needed
let elements' = if null elements
then [Blk (Para [])]
@@ -131,13 +132,14 @@ elementToDocbook opts lvl (Sec _ _num (id',_,_) title elements) =
nsAttr = if writerDocbook5 opts && lvl == 0 then [("xmlns", "http://docbook.org/ns/docbook"),("xmlns:xlink", "http://www.w3.org/1999/xlink")]
else []
attribs = nsAttr ++ idAttr
- in inTags True tag attribs $
- inTagsSimple "title" (inlinesToDocbook opts title) $$
- vcat (map (elementToDocbook opts (lvl + 1)) elements')
+ contents <- mapM (elementToDocbook opts (lvl + 1)) elements'
+ title' <- inlinesToDocbook opts title
+ return $ inTags True tag attribs $
+ inTagsSimple "title" title' $$ vcat contents
-- | Convert a list of Pandoc blocks to Docbook.
-blocksToDocbook :: WriterOptions -> [Block] -> Doc
-blocksToDocbook opts = vcat . map (blockToDocbook opts)
+blocksToDocbook :: PandocMonad m => WriterOptions -> [Block] -> m Doc
+blocksToDocbook opts = fmap vcat . mapM (blockToDocbook opts)
-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
@@ -146,26 +148,29 @@ plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a list of
-- Docbook varlistentrys.
-deflistItemsToDocbook :: WriterOptions -> [([Inline],[[Block]])] -> Doc
+deflistItemsToDocbook :: PandocMonad m
+ => WriterOptions -> [([Inline],[[Block]])] -> m Doc
deflistItemsToDocbook opts items =
- vcat $ map (\(term, defs) -> deflistItemToDocbook opts term defs) items
+ vcat <$> mapM (\(term, defs) -> deflistItemToDocbook opts term defs) items
-- | Convert a term and a list of blocks into a Docbook varlistentry.
-deflistItemToDocbook :: WriterOptions -> [Inline] -> [[Block]] -> Doc
-deflistItemToDocbook opts term defs =
- let def' = concatMap (map plainToPara) defs
- in inTagsIndented "varlistentry" $
- inTagsIndented "term" (inlinesToDocbook opts term) $$
- inTagsIndented "listitem" (blocksToDocbook opts def')
+deflistItemToDocbook :: PandocMonad m
+ => WriterOptions -> [Inline] -> [[Block]] -> m Doc
+deflistItemToDocbook opts term defs = do
+ term' <- inlinesToDocbook opts term
+ def' <- blocksToDocbook opts $ concatMap (map plainToPara) defs
+ return $ inTagsIndented "varlistentry" $
+ inTagsIndented "term" term' $$
+ inTagsIndented "listitem" def'
-- | Convert a list of lists of blocks to a list of Docbook list items.
-listItemsToDocbook :: WriterOptions -> [[Block]] -> Doc
-listItemsToDocbook opts items = vcat $ map (listItemToDocbook opts) items
+listItemsToDocbook :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
+listItemsToDocbook opts items = vcat <$> mapM (listItemToDocbook opts) items
-- | Convert a list of blocks into a Docbook list item.
-listItemToDocbook :: WriterOptions -> [Block] -> Doc
+listItemToDocbook :: PandocMonad m => WriterOptions -> [Block] -> m Doc
listItemToDocbook opts item =
- inTagsIndented "listitem" $ blocksToDocbook opts $ map plainToPara item
+ inTagsIndented "listitem" <$> blocksToDocbook opts (map plainToPara item)
imageToDocbook :: WriterOptions -> Attr -> String -> Doc
imageToDocbook _ attr src = selfClosingTag "imagedata" $
@@ -177,43 +182,46 @@ imageToDocbook _ attr src = selfClosingTag "imagedata" $
Nothing -> []
-- | Convert a Pandoc block element to Docbook.
-blockToDocbook :: WriterOptions -> Block -> Doc
-blockToDocbook _ Null = empty
+blockToDocbook :: PandocMonad m => WriterOptions -> Block -> m Doc
+blockToDocbook _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
blockToDocbook opts (Div (ident,_,_) [Para lst]) =
let attribs = [("id", ident) | not (null ident)] in
if hasLineBreaks lst
- then flush $ nowrap $ inTags False "literallayout" attribs
- $ inlinesToDocbook opts lst
- else inTags True "para" attribs $ inlinesToDocbook opts lst
-blockToDocbook opts (Div (ident,_,_) bs) =
- (if null ident
- then mempty
- else selfClosingTag "anchor" [("id", ident)]) $$
- blocksToDocbook opts (map plainToPara bs)
-blockToDocbook _ (Header _ _ _) = empty -- should not occur after hierarchicalize
+ then (flush . nowrap . inTags False "literallayout" attribs)
+ <$> inlinesToDocbook opts lst
+ else inTags True "para" attribs <$> inlinesToDocbook opts lst
+blockToDocbook opts (Div (ident,_,_) bs) = do
+ contents <- blocksToDocbook opts (map plainToPara bs)
+ return $
+ (if null ident
+ then mempty
+ else selfClosingTag "anchor" [("id", ident)]) $$ contents
+blockToDocbook _ (Header _ _ _) =
+ return empty -- should not occur after hierarchicalize
blockToDocbook opts (Plain lst) = inlinesToDocbook opts lst
-- title beginning with fig: indicates that the image is a figure
-blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) =
- let alt = inlinesToDocbook opts txt
- capt = if null txt
+blockToDocbook opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) = do
+ alt <- inlinesToDocbook opts txt
+ let capt = if null txt
then empty
else inTagsSimple "title" alt
- in inTagsIndented "figure" $
+ return $ inTagsIndented "figure" $
capt $$
(inTagsIndented "mediaobject" $
(inTagsIndented "imageobject"
(imageToDocbook opts attr src)) $$
inTagsSimple "textobject" (inTagsSimple "phrase" alt))
blockToDocbook opts (Para lst)
- | hasLineBreaks lst = flush $ nowrap $ inTagsSimple "literallayout" $ inlinesToDocbook opts lst
- | otherwise = inTagsIndented "para" $ inlinesToDocbook opts lst
+ | hasLineBreaks lst = (flush . nowrap . inTagsSimple "literallayout")
+ <$> inlinesToDocbook opts lst
+ | otherwise = inTagsIndented "para" <$> inlinesToDocbook opts lst
blockToDocbook opts (LineBlock lns) =
blockToDocbook opts $ linesToPara lns
blockToDocbook opts (BlockQuote blocks) =
- inTagsIndented "blockquote" $ blocksToDocbook opts blocks
-blockToDocbook _ (CodeBlock (_,classes,_) str) =
+ inTagsIndented "blockquote" <$> blocksToDocbook opts blocks
+blockToDocbook _ (CodeBlock (_,classes,_) str) = return $
text ("<programlisting" ++ lang ++ ">") <> cr <>
flush (text (escapeStringForXML str) <> cr <> text "</programlisting>")
where lang = if null langs
@@ -225,11 +233,11 @@ blockToDocbook _ (CodeBlock (_,classes,_) str) =
then [s]
else languagesByExtension . map toLower $ s
langs = concatMap langsFrom classes
-blockToDocbook opts (BulletList lst) =
+blockToDocbook opts (BulletList lst) = do
let attribs = [("spacing", "compact") | isTightList lst]
- in inTags True "itemizedlist" attribs $ listItemsToDocbook opts lst
-blockToDocbook _ (OrderedList _ []) = empty
-blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
+ inTags True "itemizedlist" attribs <$> listItemsToDocbook opts lst
+blockToDocbook _ (OrderedList _ []) = return empty
+blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) = do
let numeration = case numstyle of
DefaultStyle -> []
Decimal -> [("numeration", "arabic")]
@@ -240,39 +248,41 @@ blockToDocbook opts (OrderedList (start, numstyle, _) (first:rest)) =
LowerRoman -> [("numeration", "lowerroman")]
spacing = [("spacing", "compact") | isTightList (first:rest)]
attribs = numeration ++ spacing
- items = if start == 1
- then listItemsToDocbook opts (first:rest)
- else (inTags True "listitem" [("override",show start)]
- (blocksToDocbook opts $ map plainToPara first)) $$
- listItemsToDocbook opts rest
- in inTags True "orderedlist" attribs items
-blockToDocbook opts (DefinitionList lst) =
+ items <- if start == 1
+ then listItemsToDocbook opts (first:rest)
+ else do
+ first' <- blocksToDocbook opts (map plainToPara first)
+ rest' <- listItemsToDocbook opts rest
+ return $
+ (inTags True "listitem" [("override",show start)] first') $$
+ rest'
+ return $ inTags True "orderedlist" attribs items
+blockToDocbook opts (DefinitionList lst) = do
let attribs = [("spacing", "compact") | isTightList $ concatMap snd lst]
- in inTags True "variablelist" attribs $ deflistItemsToDocbook opts lst
+ inTags True "variablelist" attribs <$> deflistItemsToDocbook opts lst
blockToDocbook opts (RawBlock f str)
- | f == "docbook" = text str -- raw XML block
+ | f == "docbook" = return $ text str -- raw XML block
| f == "html" = if writerDocbook5 opts
- then empty -- No html in Docbook5
- else text str -- allow html for backwards compatibility
- | otherwise = empty
-blockToDocbook _ HorizontalRule = empty -- not semantic
-blockToDocbook opts (Table caption aligns widths headers rows) =
- let captionDoc = if null caption
- then empty
- else inTagsIndented "title"
- (inlinesToDocbook opts caption)
- tableType = if isEmpty captionDoc then "informaltable" else "table"
+ then return empty -- No html in Docbook5
+ else return $ text str -- allow html for backwards compatibility
+ | otherwise = return empty
+blockToDocbook _ HorizontalRule = return empty -- not semantic
+blockToDocbook opts (Table caption aligns widths headers rows) = do
+ captionDoc <- if null caption
+ then return empty
+ else inTagsIndented "title" <$>
+ inlinesToDocbook opts caption
+ let tableType = if isEmpty captionDoc then "informaltable" else "table"
percent w = show (truncate (100*w) :: Integer) ++ "*"
coltags = vcat $ zipWith (\w al -> selfClosingTag "colspec"
([("colwidth", percent w) | w > 0] ++
[("align", alignmentToString al)])) widths aligns
- head' = if all null headers
- then empty
- else inTagsIndented "thead" $
- tableRowToDocbook opts headers
- body' = inTagsIndented "tbody" $
- vcat $ map (tableRowToDocbook opts) rows
- in inTagsIndented tableType $ captionDoc $$
+ head' <- if all null headers
+ then return empty
+ else inTagsIndented "thead" <$> tableRowToDocbook opts headers
+ body' <- (inTagsIndented "tbody" . vcat) <$>
+ mapM (tableRowToDocbook opts) rows
+ return $ inTagsIndented tableType $ captionDoc $$
(inTags True "tgroup" [("cols", show (length headers))] $
coltags $$ head' $$ body')
@@ -293,92 +303,97 @@ alignmentToString alignment = case alignment of
AlignCenter -> "center"
AlignDefault -> "left"
-tableRowToDocbook :: WriterOptions
+tableRowToDocbook :: PandocMonad m
+ => WriterOptions
-> [[Block]]
- -> Doc
+ -> m Doc
tableRowToDocbook opts cols =
- inTagsIndented "row" $ vcat $ map (tableItemToDocbook opts) cols
+ (inTagsIndented "row" . vcat) <$> mapM (tableItemToDocbook opts) cols
-tableItemToDocbook :: WriterOptions
+tableItemToDocbook :: PandocMonad m
+ => WriterOptions
-> [Block]
- -> Doc
+ -> m Doc
tableItemToDocbook opts item =
- inTags True "entry" [] $ vcat $ map (blockToDocbook opts) item
+ (inTags True "entry" [] . vcat) <$> mapM (blockToDocbook opts) item
-- | Convert a list of inline elements to Docbook.
-inlinesToDocbook :: WriterOptions -> [Inline] -> Doc
-inlinesToDocbook opts lst = hcat $ map (inlineToDocbook opts) lst
+inlinesToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
+inlinesToDocbook opts lst = hcat <$> mapM (inlineToDocbook opts) lst
-- | Convert an inline element to Docbook.
-inlineToDocbook :: WriterOptions -> Inline -> Doc
-inlineToDocbook _ (Str str) = text $ escapeStringForXML str
+inlineToDocbook :: PandocMonad m => WriterOptions -> Inline -> m Doc
+inlineToDocbook _ (Str str) = return $ text $ escapeStringForXML str
inlineToDocbook opts (Emph lst) =
- inTagsSimple "emphasis" $ inlinesToDocbook opts lst
+ inTagsSimple "emphasis" <$> inlinesToDocbook opts lst
inlineToDocbook opts (Strong lst) =
- inTags False "emphasis" [("role", "strong")] $ inlinesToDocbook opts lst
+ inTags False "emphasis" [("role", "strong")] <$> inlinesToDocbook opts lst
inlineToDocbook opts (Strikeout lst) =
- inTags False "emphasis" [("role", "strikethrough")] $
+ inTags False "emphasis" [("role", "strikethrough")] <$>
inlinesToDocbook opts lst
inlineToDocbook opts (Superscript lst) =
- inTagsSimple "superscript" $ inlinesToDocbook opts lst
+ inTagsSimple "superscript" <$> inlinesToDocbook opts lst
inlineToDocbook opts (Subscript lst) =
- inTagsSimple "subscript" $ inlinesToDocbook opts lst
+ inTagsSimple "subscript" <$> inlinesToDocbook opts lst
inlineToDocbook opts (SmallCaps lst) =
- inTags False "emphasis" [("role", "smallcaps")] $
+ inTags False "emphasis" [("role", "smallcaps")] <$>
inlinesToDocbook opts lst
inlineToDocbook opts (Quoted _ lst) =
- inTagsSimple "quote" $ inlinesToDocbook opts lst
+ inTagsSimple "quote" <$> inlinesToDocbook opts lst
inlineToDocbook opts (Cite _ lst) =
inlinesToDocbook opts lst
inlineToDocbook opts (Span (ident,_,_) ils) =
- (if null ident
- then mempty
- else selfClosingTag "anchor" [("id", ident)]) <>
+ ((if null ident
+ then mempty
+ else selfClosingTag "anchor" [("id", ident)]) <>) <$>
inlinesToDocbook opts ils
inlineToDocbook _ (Code _ str) =
- inTagsSimple "literal" $ text (escapeStringForXML str)
+ return $ inTagsSimple "literal" $ text (escapeStringForXML str)
inlineToDocbook opts (Math t str)
- | isMathML (writerHTMLMathMethod opts) =
- case writeMathML dt <$> readTeX str of
- Right r -> inTagsSimple tagtype
- $ text $ Xml.ppcElement conf
- $ fixNS
- $ removeAttr r
- Left _ -> inlinesToDocbook opts
- $ texMathToInlines t str
- | otherwise = inlinesToDocbook opts $ texMathToInlines t str
- where (dt, tagtype) = case t of
- InlineMath -> (DisplayInline,"inlineequation")
- DisplayMath -> (DisplayBlock,"informalequation")
+ | isMathML (writerHTMLMathMethod opts) = do
+ res <- convertMath writeMathML t str
+ case res of
+ Right r -> return $ inTagsSimple tagtype
+ $ text $ Xml.ppcElement conf
+ $ fixNS
+ $ removeAttr r
+ Left il -> inlineToDocbook opts il
+ | otherwise =
+ texMathToInlines t str >>= inlinesToDocbook opts
+ where tagtype = case t of
+ InlineMath -> "inlineequation"
+ DisplayMath -> "informalequation"
conf = Xml.useShortEmptyTags (const False) Xml.defaultConfigPP
removeAttr e = e{ Xml.elAttribs = [] }
fixNS' qname = qname{ Xml.qPrefix = Just "mml" }
fixNS = everywhere (mkT fixNS')
-inlineToDocbook _ (RawInline f x) | f == "html" || f == "docbook" = text x
- | otherwise = empty
-inlineToDocbook _ LineBreak = text "\n"
+inlineToDocbook _ (RawInline f x)
+ | f == "html" || f == "docbook" = return $ text x
+ | otherwise = return empty
+inlineToDocbook _ LineBreak = return $ text "\n"
-- currently ignore, would require the option to add custom
-- styles to the document
-inlineToDocbook _ PageBreak = empty
-inlineToDocbook _ Space = space
+inlineToDocbook _ PageBreak = return empty
+inlineToDocbook _ Space = return space
-- because we use \n for LineBreak, we can't do soft breaks:
-inlineToDocbook _ SoftBreak = space
+inlineToDocbook _ SoftBreak = return space
inlineToDocbook opts (Link attr txt (src, _))
| Just email <- stripPrefix "mailto:" src =
let emailLink = inTagsSimple "email" $ text $
escapeStringForXML $ email
in case txt of
- [Str s] | escapeURI s == email -> emailLink
- _ -> inlinesToDocbook opts txt <+>
- char '(' <> emailLink <> char ')'
+ [Str s] | escapeURI s == email -> return emailLink
+ _ -> do contents <- inlinesToDocbook opts txt
+ return $ contents <+>
+ char '(' <> emailLink <> char ')'
| otherwise =
(if isPrefixOf "#" src
then inTags False "link" $ ("linkend", drop 1 src) : idAndRole attr
else if writerDocbook5 opts
then inTags False "link" $ ("xlink:href", src) : idAndRole attr
- else inTags False "ulink" $ ("url", src) : idAndRole attr ) $
- inlinesToDocbook opts txt
-inlineToDocbook opts (Image attr _ (src, tit)) =
+ else inTags False "ulink" $ ("url", src) : idAndRole attr )
+ <$> inlinesToDocbook opts txt
+inlineToDocbook opts (Image attr _ (src, tit)) = return $
let titleDoc = if null tit
then empty
else inTagsIndented "objectinfo" $
@@ -386,7 +401,7 @@ inlineToDocbook opts (Image attr _ (src, tit)) =
in inTagsIndented "inlinemediaobject" $ inTagsIndented "imageobject" $
titleDoc $$ imageToDocbook opts attr src
inlineToDocbook opts (Note contents) =
- inTagsIndented "footnote" $ blocksToDocbook opts contents
+ inTagsIndented "footnote" <$> blocksToDocbook opts contents
isMathML :: HTMLMathMethod -> Bool
isMathML (MathML _) = True
diff --git a/src/Text/Pandoc/Writers/Docx.hs b/src/Text/Pandoc/Writers/Docx.hs
index cc0c180f2..90261dede 100644
--- a/src/Text/Pandoc/Writers/Docx.hs
+++ b/src/Text/Pandoc/Writers/Docx.hs
@@ -45,7 +45,7 @@ import Text.Pandoc.ImageSize
import Text.Pandoc.Shared hiding (Element)
import Text.Pandoc.Writers.Shared (fixDisplayMath)
import Text.Pandoc.Options
-import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Writers.Math
import Text.Pandoc.Highlighting ( highlight )
import Text.Pandoc.Walk
import Text.XML.Light as XML
@@ -1114,17 +1114,11 @@ inlineToOpenXML' opts (Quoted quoteType lst) =
SingleQuote -> ("\x2018", "\x2019")
DoubleQuote -> ("\x201C", "\x201D")
inlineToOpenXML' opts (Math mathType str) = do
- let displayType = if mathType == DisplayMath
- then DisplayBlock
- else DisplayInline
- when (displayType == DisplayBlock) setFirstPara
- case writeOMML displayType <$> readTeX str of
- Right r -> return [r]
- Left e -> do
- (lift . lift) $ P.warn $
- "Cannot convert the following TeX math, skipping:\n" ++ str ++
- "\n" ++ e
- inlinesToOpenXML opts (texMathToInlines mathType str)
+ when (mathType == DisplayMath) setFirstPara
+ res <- (lift . lift) (convertMath writeOMML mathType str)
+ case res of
+ Right r -> return [r]
+ Left il -> inlineToOpenXML' opts il
inlineToOpenXML' opts (Cite _ lst) = inlinesToOpenXML opts lst
inlineToOpenXML' opts (Code attrs str) = do
let unhighlighted = intercalate [br] `fmap`
diff --git a/src/Text/Pandoc/Writers/HTML.hs b/src/Text/Pandoc/Writers/HTML.hs
index b2b0865bf..40658eaa8 100644
--- a/src/Text/Pandoc/Writers/HTML.hs
+++ b/src/Text/Pandoc/Writers/HTML.hs
@@ -36,7 +36,7 @@ import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
import Text.Pandoc.ImageSize
import Text.Pandoc.Templates
-import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Writers.Math
import Text.Pandoc.Slides
import Text.Pandoc.Highlighting ( highlight, styleToCss,
formatHtmlInline, formatHtmlBlock )
@@ -794,17 +794,14 @@ inlineToHtml opts inline =
InlineMath -> preEscapedString $ "<EQ ENV=\"math\">" ++ str ++ "</EQ>"
DisplayMath -> preEscapedString $ "<EQ ENV=\"displaymath\">" ++ str ++ "</EQ>"
MathML _ -> do
- let dt = if t == InlineMath
- then DisplayInline
- else DisplayBlock
let conf = useShortEmptyTags (const False)
defaultConfigPP
- case writeMathML dt <$> readTeX str of
+ res <- lift $ convertMath writeMathML t str
+ case res of
Right r -> return $ preEscapedString $
ppcElement conf (annotateMML r str)
- Left _ -> inlineListToHtml opts
- (texMathToInlines t str) >>=
- return . (H.span ! A.class_ mathClass)
+ Left il -> (H.span ! A.class_ mathClass) <$>
+ inlineToHtml opts il
MathJax _ -> return $ H.span ! A.class_ mathClass $ toHtml $
case t of
InlineMath -> "\\(" ++ str ++ "\\)"
@@ -814,7 +811,7 @@ inlineToHtml opts inline =
InlineMath -> str
DisplayMath -> "\\displaystyle " ++ str)
PlainMath -> do
- x <- inlineListToHtml opts (texMathToInlines t str)
+ x <- lift (texMathToInlines t str) >>= inlineListToHtml opts
let m = H.span ! A.class_ mathClass $ x
let brtag = if writerHtml5 opts then H5.br else H.br
return $ case t of
diff --git a/src/Text/Pandoc/Writers/Haddock.hs b/src/Text/Pandoc/Writers/Haddock.hs
index 03ce8c0eb..115d5d8d8 100644
--- a/src/Text/Pandoc/Writers/Haddock.hs
+++ b/src/Text/Pandoc/Writers/Haddock.hs
@@ -39,7 +39,7 @@ import Text.Pandoc.Options
import Data.List ( intersperse, transpose )
import Text.Pandoc.Pretty
import Control.Monad.State
-import Text.Pandoc.Readers.TeXMath (texMathToInlines)
+import Text.Pandoc.Writers.Math (texMathToInlines)
import Network.URI (isURI)
import Data.Default
import Text.Pandoc.Class (PandocMonad)
@@ -51,12 +51,13 @@ instance Default WriterState
-- | Convert Pandoc to Haddock.
writeHaddock :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeHaddock opts document = return $
- evalState (pandocToHaddock opts{
+writeHaddock opts document =
+ evalStateT (pandocToHaddock opts{
writerWrapText = writerWrapText opts } document) def
-- | Return haddock representation of document.
-pandocToHaddock :: WriterOptions -> Pandoc -> State WriterState String
+pandocToHaddock :: PandocMonad m
+ => WriterOptions -> Pandoc -> StateT WriterState m String
pandocToHaddock opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
@@ -79,7 +80,8 @@ pandocToHaddock opts (Pandoc meta blocks) = do
Just tpl -> return $ renderTemplate' tpl context
-- | Return haddock representation of notes.
-notesToHaddock :: WriterOptions -> [[Block]] -> State WriterState Doc
+notesToHaddock :: PandocMonad m
+ => WriterOptions -> [[Block]] -> StateT WriterState m Doc
notesToHaddock opts notes =
if null notes
then return empty
@@ -93,9 +95,10 @@ escapeString = escapeStringUsing haddockEscapes
where haddockEscapes = backslashEscapes "\\/'`\"@<"
-- | Convert Pandoc block element to haddock.
-blockToHaddock :: WriterOptions -- ^ Options
- -> Block -- ^ Block element
- -> State WriterState Doc
+blockToHaddock :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> Block -- ^ Block element
+ -> StateT WriterState m Doc
blockToHaddock _ Null = return empty
blockToHaddock opts (Div _ ils) = do
contents <- blockListToHaddock opts ils
@@ -168,8 +171,9 @@ blockToHaddock opts (DefinitionList items) = do
contents <- mapM (definitionListItemToHaddock opts) items
return $ cat contents <> blankline
-pandocTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+pandocTable :: PandocMonad m
+ => WriterOptions -> Bool -> [Alignment] -> [Double]
+ -> [Doc] -> [[Doc]] -> StateT WriterState m Doc
pandocTable opts headless aligns widths rawHeaders rawRows = do
let isSimple = all (==0) widths
let alignHeader alignment = case alignment of
@@ -208,8 +212,9 @@ pandocTable opts headless aligns widths rawHeaders rawRows = do
else border
return $ head'' $$ underline $$ body $$ bottom
-gridTable :: WriterOptions -> Bool -> [Alignment] -> [Double]
- -> [Doc] -> [[Doc]] -> State WriterState Doc
+gridTable :: PandocMonad m
+ => WriterOptions -> Bool -> [Alignment] -> [Double]
+ -> [Doc] -> [[Doc]] -> StateT WriterState m Doc
gridTable opts headless _aligns widths headers' rawRows = do
let numcols = length headers'
let widths' = if all (==0) widths
@@ -236,7 +241,8 @@ gridTable opts headless _aligns widths headers' rawRows = do
return $ border '-' $$ head'' $$ body $$ border '-'
-- | Convert bullet list item (list of blocks) to haddock
-bulletListItemToHaddock :: WriterOptions -> [Block] -> State WriterState Doc
+bulletListItemToHaddock :: PandocMonad m
+ => WriterOptions -> [Block] -> StateT WriterState m Doc
bulletListItemToHaddock opts items = do
contents <- blockListToHaddock opts items
let sps = replicate (writerTabStop opts - 2) ' '
@@ -251,10 +257,11 @@ bulletListItemToHaddock opts items = do
return $ hang (writerTabStop opts) start $ contents' <> cr
-- | Convert ordered list item (a list of blocks) to haddock
-orderedListItemToHaddock :: WriterOptions -- ^ options
- -> String -- ^ list item marker
- -> [Block] -- ^ list item (list of blocks)
- -> State WriterState Doc
+orderedListItemToHaddock :: PandocMonad m
+ => WriterOptions -- ^ options
+ -> String -- ^ list item marker
+ -> [Block] -- ^ list item (list of blocks)
+ -> StateT WriterState m Doc
orderedListItemToHaddock opts marker items = do
contents <- blockListToHaddock opts items
let sps = case length marker - writerTabStop opts of
@@ -264,9 +271,10 @@ orderedListItemToHaddock opts marker items = do
return $ hang (writerTabStop opts) start $ contents <> cr
-- | Convert definition list item (label, list of blocks) to haddock
-definitionListItemToHaddock :: WriterOptions
- -> ([Inline],[[Block]])
- -> State WriterState Doc
+definitionListItemToHaddock :: PandocMonad m
+ => WriterOptions
+ -> ([Inline],[[Block]])
+ -> StateT WriterState m Doc
definitionListItemToHaddock opts (label, defs) = do
labelText <- inlineListToHaddock opts label
defs' <- mapM (mapM (blockToHaddock opts)) defs
@@ -274,19 +282,22 @@ definitionListItemToHaddock opts (label, defs) = do
return $ nowrap (brackets labelText) <> cr <> contents <> cr
-- | Convert list of Pandoc block elements to haddock
-blockListToHaddock :: WriterOptions -- ^ Options
- -> [Block] -- ^ List of block elements
- -> State WriterState Doc
+blockListToHaddock :: PandocMonad m
+ => WriterOptions -- ^ Options
+ -> [Block] -- ^ List of block elements
+ -> StateT WriterState m Doc
blockListToHaddock opts blocks =
mapM (blockToHaddock opts) blocks >>= return . cat
-- | Convert list of Pandoc inline elements to haddock.
-inlineListToHaddock :: WriterOptions -> [Inline] -> State WriterState Doc
+inlineListToHaddock :: PandocMonad m
+ => WriterOptions -> [Inline] -> StateT WriterState m Doc
inlineListToHaddock opts lst =
mapM (inlineToHaddock opts) lst >>= return . cat
-- | Convert Pandoc inline element to haddock.
-inlineToHaddock :: WriterOptions -> Inline -> State WriterState Doc
+inlineToHaddock :: PandocMonad m
+ => WriterOptions -> Inline -> StateT WriterState m Doc
inlineToHaddock opts (Span (ident,_,_) ils) = do
contents <- inlineListToHaddock opts ils
if not (null ident) && null ils
@@ -322,7 +333,7 @@ inlineToHaddock opts (Math mt str) = do
let adjust x = case mt of
DisplayMath -> cr <> x <> cr
InlineMath -> x
- adjust `fmap` (inlineListToHaddock opts $ texMathToInlines mt str)
+ adjust <$> (lift (texMathToInlines mt str) >>= inlineListToHaddock opts)
inlineToHaddock _ (RawInline f str)
| f == "haddock" = return $ text str
| otherwise = return empty
diff --git a/src/Text/Pandoc/Writers/ICML.hs b/src/Text/Pandoc/Writers/ICML.hs
index f624b7dec..7c42671f1 100644
--- a/src/Text/Pandoc/Writers/ICML.hs
+++ b/src/Text/Pandoc/Writers/ICML.hs
@@ -16,7 +16,7 @@ into InDesign with File -> Place.
module Text.Pandoc.Writers.ICML (writeICML) where
import Text.Pandoc.Definition
import Text.Pandoc.XML
-import Text.Pandoc.Readers.TeXMath (texMathToInlines)
+import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Shared (linesToPara, splitBy)
import Text.Pandoc.Options
@@ -435,7 +435,8 @@ inlineToICML opts style SoftBreak =
inlineToICML _ style LineBreak = charStyle style $ text lineSeparator
inlineToICML _ _ PageBreak = return empty
inlineToICML opts style (Math mt str) =
- cat <$> mapM (inlineToICML opts style) (texMathToInlines mt str)
+ lift (texMathToInlines mt str) >>=
+ (fmap cat . mapM (inlineToICML opts style))
inlineToICML _ _ (RawInline f str)
| f == Format "icml" = return $ text str
| otherwise = return empty
diff --git a/src/Text/Pandoc/Writers/Man.hs b/src/Text/Pandoc/Writers/Man.hs
index 27cf22b41..a9a30fd45 100644
--- a/src/Text/Pandoc/Writers/Man.hs
+++ b/src/Text/Pandoc/Writers/Man.hs
@@ -34,7 +34,7 @@ import Text.Pandoc.Templates
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
import Text.Pandoc.Options
-import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Writers.Math
import Text.Printf ( printf )
import Data.List ( stripPrefix, intersperse, intercalate )
import Data.Maybe (fromMaybe)
@@ -342,9 +342,9 @@ inlineToMan _ (Str str@('.':_)) =
return $ afterBreak "\\&" <> text (escapeString str)
inlineToMan _ (Str str) = return $ text $ escapeString str
inlineToMan opts (Math InlineMath str) =
- inlineListToMan opts $ texMathToInlines InlineMath str
+ lift (texMathToInlines InlineMath str) >>= inlineListToMan opts
inlineToMan opts (Math DisplayMath str) = do
- contents <- inlineListToMan opts $ texMathToInlines DisplayMath str
+ contents <- lift (texMathToInlines DisplayMath str) >>= inlineListToMan opts
return $ cr <> text ".RS" $$ contents $$ text ".RE"
inlineToMan _ (RawInline f str)
| f == Format "man" = return $ text str
diff --git a/src/Text/Pandoc/Writers/Markdown.hs b/src/Text/Pandoc/Writers/Markdown.hs
index 092693ea4..66e0365d8 100644
--- a/src/Text/Pandoc/Writers/Markdown.hs
+++ b/src/Text/Pandoc/Writers/Markdown.hs
@@ -48,7 +48,7 @@ import Control.Monad.Reader
import Control.Monad.State
import Control.Monad.Except (throwError)
import Text.Pandoc.Writers.HTML (writeHtmlString)
-import Text.Pandoc.Readers.TeXMath (texMathToInlines)
+import Text.Pandoc.Writers.Math (texMathToInlines)
import Text.HTML.TagSoup (parseTags, isTagText, Tag(..))
import Network.URI (isURI)
import Data.Default
@@ -200,7 +200,7 @@ pandocToMarkdown opts (Pandoc meta blocks) = do
Nothing -> empty
let headerBlocks = filter isHeaderBlock blocks
toc <- if writerTableOfContents opts
- then lift $ lift $ tableOfContents opts headerBlocks
+ then liftPandoc $ tableOfContents opts headerBlocks
else return empty
-- Strip off final 'references' header if markdown citations enabled
let blocks' = if isEnabled Ext_citations opts
@@ -533,7 +533,7 @@ blockToMarkdown' opts t@(Table caption aligns widths headers rows) = do
rawHeaders rawRows
| isEnabled Ext_raw_html opts -> fmap (id,) $
text <$>
- (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [t])
+ (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [t])
| otherwise -> return $ (id, text "[TABLE]")
return $ nst $ tbl $$ blankline $$ caption'' $$ blankline
blockToMarkdown' opts (BulletList items) = do
@@ -985,9 +985,9 @@ inlineToMarkdown opts (Math InlineMath str) =
return $ "\\\\(" <> text str <> "\\\\)"
| otherwise -> do
plain <- asks envPlain
- inlineListToMarkdown opts $
- (if plain then makeMathPlainer else id) $
- texMathToInlines InlineMath str
+ (liftPandoc (texMathToInlines InlineMath str)) >>=
+ inlineListToMarkdown opts .
+ (if plain then makeMathPlainer else id)
inlineToMarkdown opts (Math DisplayMath str) =
case writerHTMLMathMethod opts of
WebTeX url -> (\x -> blankline <> x <> blankline) `fmap`
@@ -1000,7 +1000,8 @@ inlineToMarkdown opts (Math DisplayMath str) =
| isEnabled Ext_tex_math_double_backslash opts ->
return $ "\\\\[" <> text str <> "\\\\]"
| otherwise -> (\x -> cr <> x <> cr) `fmap`
- inlineListToMarkdown opts (texMathToInlines DisplayMath str)
+ (liftPandoc (texMathToInlines DisplayMath str) >>=
+ inlineListToMarkdown opts)
inlineToMarkdown opts (RawInline f str) = do
plain <- asks envPlain
if not plain &&
@@ -1062,7 +1063,7 @@ inlineToMarkdown opts lnk@(Link attr txt (src, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
- (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]])
+ (text . trim) <$> (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [Plain [lnk]])
| otherwise = do
plain <- asks envPlain
linktext <- inlineListToMarkdown opts txt
@@ -1101,7 +1102,7 @@ inlineToMarkdown opts img@(Image attr alternate (source, tit))
| isEnabled Ext_raw_html opts &&
not (isEnabled Ext_link_attributes opts) &&
attr /= nullAttr = -- use raw HTML
- (text . trim) <$> (lift $ lift $ writeHtmlString def $ Pandoc nullMeta [Plain [img]])
+ (text . trim) <$> (liftPandoc $ writeHtmlString def $ Pandoc nullMeta [Plain [img]])
| otherwise = do
plain <- asks envPlain
let txt = if null alternate || alternate == [Str source]
@@ -1125,3 +1126,6 @@ makeMathPlainer = walk go
where
go (Emph xs) = Span nullAttr xs
go x = x
+
+liftPandoc :: PandocMonad m => m a -> MD m a
+liftPandoc = lift . lift
diff --git a/src/Text/Pandoc/Writers/Math.hs b/src/Text/Pandoc/Writers/Math.hs
new file mode 100644
index 000000000..4540a2479
--- /dev/null
+++ b/src/Text/Pandoc/Writers/Math.hs
@@ -0,0 +1,47 @@
+module Text.Pandoc.Writers.Math
+ ( texMathToInlines
+ , convertMath
+ )
+where
+
+import Text.Pandoc.Class
+import Text.Pandoc.Definition
+import Text.TeXMath (Exp, writePandoc, DisplayType(..), readTeX)
+
+-- | Converts a raw TeX math formula to a list of 'Pandoc' inlines.
+-- Defaults to raw formula between @$@ or @$$@ characters if entire formula
+-- can't be converted.
+texMathToInlines :: PandocMonad m
+ => MathType
+ -> String -- ^ String to parse (assumes @'\n'@ line endings)
+ -> m [Inline]
+texMathToInlines mt inp = do
+ res <- convertMath writePandoc mt inp
+ case res of
+ Right (Just ils) -> return ils
+ Right (Nothing) -> return [mkFallback mt inp]
+ Left il -> return [il]
+
+mkFallback :: MathType -> String -> Inline
+mkFallback mt str = Str (delim ++ str ++ delim)
+ where delim = case mt of
+ DisplayMath -> "$$"
+ InlineMath -> "$"
+
+-- | Converts a raw TeX math formula using a writer function,
+-- issuing a warning and producing a fallback (a raw string)
+-- on failure.
+convertMath :: PandocMonad m
+ => (DisplayType -> [Exp] -> a) -> MathType -> String
+ -> m (Either Inline a)
+convertMath writer mt str = do
+ case writer dt <$> readTeX str of
+ Right r -> return (Right r)
+ Left e -> do
+ warn $ "Could not convert TeX math, rendering as raw TeX:\n" ++
+ str ++ "\n" ++ e
+ return (Left $ mkFallback mt str)
+ where dt = case mt of
+ DisplayMath -> DisplayBlock
+ InlineMath -> DisplayInline
+
diff --git a/src/Text/Pandoc/Writers/OpenDocument.hs b/src/Text/Pandoc/Writers/OpenDocument.hs
index 903c94828..1a758193a 100644
--- a/src/Text/Pandoc/Writers/OpenDocument.hs
+++ b/src/Text/Pandoc/Writers/OpenDocument.hs
@@ -35,8 +35,8 @@ import Text.Pandoc.Options
import Text.Pandoc.XML
import Text.Pandoc.Shared (linesToPara)
import Text.Pandoc.Templates (renderTemplate')
-import Text.Pandoc.Readers.TeXMath
import Text.Pandoc.Readers.Odt.StyleReader
+import Text.Pandoc.Writers.Math
import Text.Pandoc.Pretty
import Text.Printf ( printf )
import Control.Arrow ( (***), (>>>) )
@@ -58,6 +58,8 @@ plainToPara x = x
-- OpenDocument writer
--
+type OD m = StateT WriterState m
+
data WriterState =
WriterState { stNotes :: [Doc]
, stTableStyles :: [Doc]
@@ -90,40 +92,40 @@ defaultWriterState =
when :: Bool -> Doc -> Doc
when p a = if p then a else empty
-addTableStyle :: Doc -> State WriterState ()
+addTableStyle :: PandocMonad m => Doc -> OD m ()
addTableStyle i = modify $ \s -> s { stTableStyles = i : stTableStyles s }
-addNote :: Doc -> State WriterState ()
+addNote :: PandocMonad m => Doc -> OD m ()
addNote i = modify $ \s -> s { stNotes = i : stNotes s }
-addParaStyle :: Doc -> State WriterState ()
+addParaStyle :: PandocMonad m => Doc -> OD m ()
addParaStyle i = modify $ \s -> s { stParaStyles = i : stParaStyles s }
-addTextStyle :: Set.Set TextStyle -> (String, Doc) -> State WriterState ()
+addTextStyle :: PandocMonad m => Set.Set TextStyle -> (String, Doc) -> OD m ()
addTextStyle attrs i = modify $ \s ->
s { stTextStyles = Map.insert attrs i (stTextStyles s) }
-addTextStyleAttr :: TextStyle -> State WriterState ()
+addTextStyleAttr :: PandocMonad m => TextStyle -> OD m ()
addTextStyleAttr t = modify $ \s ->
s { stTextStyleAttr = Set.insert t (stTextStyleAttr s) }
-increaseIndent :: State WriterState ()
+increaseIndent :: PandocMonad m => OD m ()
increaseIndent = modify $ \s -> s { stIndentPara = 1 + stIndentPara s }
-resetIndent :: State WriterState ()
+resetIndent :: PandocMonad m => OD m ()
resetIndent = modify $ \s -> s { stIndentPara = (stIndentPara s) - 1 }
-inTightList :: State WriterState a -> State WriterState a
+inTightList :: PandocMonad m => OD m a -> OD m a
inTightList f = modify (\s -> s { stTight = True }) >> f >>= \r ->
modify (\s -> s { stTight = False }) >> return r
-setInDefinitionList :: Bool -> State WriterState ()
+setInDefinitionList :: PandocMonad m => Bool -> OD m ()
setInDefinitionList b = modify $ \s -> s { stInDefinition = b }
-setFirstPara :: State WriterState ()
+setFirstPara :: PandocMonad m => OD m ()
setFirstPara = modify $ \s -> s { stFirstPara = True }
-inParagraphTags :: Doc -> State WriterState Doc
+inParagraphTags :: PandocMonad m => Doc -> OD m Doc
inParagraphTags d | isEmpty d = return empty
inParagraphTags d = do
b <- gets stFirstPara
@@ -139,7 +141,7 @@ inParagraphTagsWithStyle sty = inTags False "text:p" [("text:style-name", sty)]
inSpanTags :: String -> Doc -> Doc
inSpanTags s = inTags False "text:span" [("text:style-name",s)]
-withTextStyle :: TextStyle -> State WriterState a -> State WriterState a
+withTextStyle :: PandocMonad m => TextStyle -> OD m a -> OD m a
withTextStyle s f = do
oldTextStyleAttr <- gets stTextStyleAttr
addTextStyleAttr s
@@ -147,7 +149,7 @@ withTextStyle s f = do
modify $ \st -> st{ stTextStyleAttr = oldTextStyleAttr }
return res
-inTextStyle :: Doc -> State WriterState Doc
+inTextStyle :: PandocMonad m => Doc -> OD m Doc
inTextStyle d = do
at <- gets stTextStyleAttr
if Set.null at
@@ -168,7 +170,7 @@ inTextStyle d = do
return $ inTags False
"text:span" [("text:style-name",styleName)] d
-inHeaderTags :: Int -> Doc -> State WriterState Doc
+inHeaderTags :: PandocMonad m => Int -> Doc -> OD m Doc
inHeaderTags i d =
return $ inTags False "text:h" [ ("text:style-name", "Heading_20_" ++ show i)
, ("text:outline-level", show i)] d
@@ -192,12 +194,12 @@ handleSpaces s
-- | Convert Pandoc document to string in OpenDocument format.
writeOpenDocument :: PandocMonad m => WriterOptions -> Pandoc -> m String
-writeOpenDocument opts (Pandoc meta blocks) = return $
+writeOpenDocument opts (Pandoc meta blocks) = do
let colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
- render' = render colwidth
- ((body, metadata),s) = flip runState
+ let render' = render colwidth
+ ((body, metadata),s) <- flip runStateT
defaultWriterState $ do
m <- metaToJSON opts
(fmap (render colwidth) . blocksToOpenDocument opts)
@@ -210,33 +212,36 @@ writeOpenDocument opts (Pandoc meta blocks) = return $
Map.elems (stTextStyles s))
listStyle (n,l) = inTags True "text:list-style"
[("style:name", "L" ++ show n)] (vcat l)
- listStyles = map listStyle (stListStyles s)
- automaticStyles = vcat $ reverse $ styles ++ listStyles
- context = defField "body" body
+ let listStyles = map listStyle (stListStyles s)
+ let automaticStyles = vcat $ reverse $ styles ++ listStyles
+ let context = defField "body" body
$ defField "automatic-styles" (render' automaticStyles)
$ metadata
- in case writerTemplate opts of
- Nothing -> body
- Just tpl -> renderTemplate' tpl context
+ return $ case writerTemplate opts of
+ Nothing -> body
+ Just tpl -> renderTemplate' tpl context
-withParagraphStyle :: WriterOptions -> String -> [Block] -> State WriterState Doc
+withParagraphStyle :: PandocMonad m
+ => WriterOptions -> String -> [Block] -> OD m Doc
withParagraphStyle o s (b:bs)
| Para l <- b = go =<< inParagraphTagsWithStyle s <$> inlinesToOpenDocument o l
| otherwise = go =<< blockToOpenDocument o b
where go i = (<>) i <$> withParagraphStyle o s bs
withParagraphStyle _ _ [] = return empty
-inPreformattedTags :: String -> State WriterState Doc
+inPreformattedTags :: PandocMonad m => String -> OD m Doc
inPreformattedTags s = do
n <- paraStyle [("style:parent-style-name","Preformatted_20_Text")]
return . inParagraphTagsWithStyle ("P" ++ show n) . handleSpaces $ s
-orderedListToOpenDocument :: WriterOptions -> Int -> [[Block]] -> State WriterState Doc
+orderedListToOpenDocument :: PandocMonad m
+ => WriterOptions -> Int -> [[Block]] -> OD m Doc
orderedListToOpenDocument o pn bs =
vcat . map (inTagsIndented "text:list-item") <$>
mapM (orderedItemToOpenDocument o pn . map plainToPara) bs
-orderedItemToOpenDocument :: WriterOptions -> Int -> [Block] -> State WriterState Doc
+orderedItemToOpenDocument :: PandocMonad m
+ => WriterOptions -> Int -> [Block] -> OD m Doc
orderedItemToOpenDocument o n (b:bs)
| OrderedList a l <- b = newLevel a l
| Para l <- b = go =<< inParagraphTagsWithStyle ("P" ++ show n) <$> inlinesToOpenDocument o l
@@ -256,7 +261,8 @@ isTightList (b:_)
| Plain {} : _ <- b = True
| otherwise = False
-newOrderedListStyle :: Bool -> ListAttributes -> State WriterState (Int,Int)
+newOrderedListStyle :: PandocMonad m
+ => Bool -> ListAttributes -> OD m (Int,Int)
newOrderedListStyle b a = do
ln <- (+) 1 . length <$> gets stListStyles
let nbs = orderedListLevelStyle a (ln, [])
@@ -264,7 +270,8 @@ newOrderedListStyle b a = do
modify $ \s -> s { stListStyles = nbs : stListStyles s }
return (ln,pn)
-bulletListToOpenDocument :: WriterOptions -> [[Block]] -> State WriterState Doc
+bulletListToOpenDocument :: PandocMonad m
+ => WriterOptions -> [[Block]] -> OD m Doc
bulletListToOpenDocument o b = do
ln <- (+) 1 . length <$> gets stListStyles
(pn,ns) <- if isTightList b then inTightList (bulletListStyle ln) else bulletListStyle ln
@@ -272,11 +279,13 @@ bulletListToOpenDocument o b = do
is <- listItemsToOpenDocument ("P" ++ show pn) o b
return $ inTags True "text:list" [("text:style-name", "L" ++ show ln)] is
-listItemsToOpenDocument :: String -> WriterOptions -> [[Block]] -> State WriterState Doc
+listItemsToOpenDocument :: PandocMonad m
+ => String -> WriterOptions -> [[Block]] -> OD m Doc
listItemsToOpenDocument s o is =
vcat . map (inTagsIndented "text:list-item") <$> mapM (withParagraphStyle o s . map plainToPara) is
-deflistItemToOpenDocument :: WriterOptions -> ([Inline],[[Block]]) -> State WriterState Doc
+deflistItemToOpenDocument :: PandocMonad m
+ => WriterOptions -> ([Inline],[[Block]]) -> OD m Doc
deflistItemToOpenDocument o (t,d) = do
let ts = if isTightList d
then "Definition_20_Term_20_Tight" else "Definition_20_Term"
@@ -286,7 +295,8 @@ deflistItemToOpenDocument o (t,d) = do
d' <- liftM vcat $ mapM (withParagraphStyle o ds . (map plainToPara)) d
return $ t' $$ d'
-inBlockQuote :: WriterOptions -> Int -> [Block] -> State WriterState Doc
+inBlockQuote :: PandocMonad m
+ => WriterOptions -> Int -> [Block] -> OD m Doc
inBlockQuote o i (b:bs)
| BlockQuote l <- b = do increaseIndent
ni <- paraStyle
@@ -298,11 +308,11 @@ inBlockQuote o i (b:bs)
inBlockQuote _ _ [] = resetIndent >> return empty
-- | Convert a list of Pandoc blocks to OpenDocument.
-blocksToOpenDocument :: WriterOptions -> [Block] -> State WriterState Doc
+blocksToOpenDocument :: PandocMonad m => WriterOptions -> [Block] -> OD m Doc
blocksToOpenDocument o b = vcat <$> mapM (blockToOpenDocument o) b
-- | Convert a Pandoc block element to OpenDocument.
-blockToOpenDocument :: WriterOptions -> Block -> State WriterState Doc
+blockToOpenDocument :: PandocMonad m => WriterOptions -> Block -> OD m Doc
blockToOpenDocument o bs
| Plain b <- bs = if null b
then return empty
@@ -374,29 +384,35 @@ blockToOpenDocument o bs
endsWithPageBreak [PageBreak] = True
endsWithPageBreak (_ : xs) = endsWithPageBreak xs
- paragraph :: [Inline] -> State WriterState Doc
+ paragraph :: PandocMonad m => [Inline] -> OD m Doc
paragraph [] = return empty
paragraph (PageBreak : rest) | endsWithPageBreak rest = paraWithBreak PageBoth rest
paragraph (PageBreak : rest) = paraWithBreak PageBefore rest
paragraph inlines | endsWithPageBreak inlines = paraWithBreak PageAfter inlines
paragraph inlines = inParagraphTags =<< inlinesToOpenDocument o inlines
- paraWithBreak :: ParaBreak -> [Inline] -> State WriterState Doc
+ paraWithBreak :: PandocMonad m => ParaBreak -> [Inline] -> OD m Doc
paraWithBreak breakKind bs = do
pn <- paraBreakStyle breakKind
withParagraphStyle o ("P" ++ show pn) [Para bs]
-colHeadsToOpenDocument :: WriterOptions -> String -> [String] -> [[Block]] -> State WriterState Doc
+colHeadsToOpenDocument :: PandocMonad m
+ => WriterOptions -> String -> [String] -> [[Block]]
+ -> OD m Doc
colHeadsToOpenDocument o tn ns hs =
inTagsIndented "table:table-header-rows" . inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o tn) (zip ns hs)
-tableRowToOpenDocument :: WriterOptions -> String -> [String] -> [[Block]] -> State WriterState Doc
+tableRowToOpenDocument :: PandocMonad m
+ => WriterOptions -> String -> [String] -> [[Block]]
+ -> OD m Doc
tableRowToOpenDocument o tn ns cs =
inTagsIndented "table:table-row" . vcat <$>
mapM (tableItemToOpenDocument o tn) (zip ns cs)
-tableItemToOpenDocument :: WriterOptions -> String -> (String,[Block])-> State WriterState Doc
+tableItemToOpenDocument :: PandocMonad m
+ => WriterOptions -> String -> (String,[Block])
+ -> OD m Doc
tableItemToOpenDocument o tn (n,i) =
let a = [ ("table:style-name" , tn ++ ".A1" )
, ("office:value-type", "string" )
@@ -405,10 +421,10 @@ tableItemToOpenDocument o tn (n,i) =
withParagraphStyle o n (map plainToPara i)
-- | Convert a list of inline elements to OpenDocument.
-inlinesToOpenDocument :: WriterOptions -> [Inline] -> State WriterState Doc
+inlinesToOpenDocument :: PandocMonad m => WriterOptions -> [Inline] -> OD m Doc
inlinesToOpenDocument o l = hcat <$> toChunks o l
-toChunks :: WriterOptions -> [Inline] -> State WriterState [Doc]
+toChunks :: PandocMonad m => WriterOptions -> [Inline] -> OD m [Doc]
toChunks _ [] = return []
toChunks o (x : xs)
| isChunkable x = do
@@ -429,7 +445,7 @@ isChunkable SoftBreak = True
isChunkable _ = False
-- | Convert an inline element to OpenDocument.
-inlineToOpenDocument :: WriterOptions -> Inline -> State WriterState Doc
+inlineToOpenDocument :: PandocMonad m => WriterOptions -> Inline -> OD m Doc
inlineToOpenDocument o ils
= case ils of
Space -> return space
@@ -448,7 +464,8 @@ inlineToOpenDocument o ils
SmallCaps l -> withTextStyle SmallC $ inlinesToOpenDocument o l
Quoted t l -> inQuotes t <$> inlinesToOpenDocument o l
Code _ s -> inlinedCode $ preformatted s
- Math t s -> inlinesToOpenDocument o (texMathToInlines t s)
+ Math t s -> lift (texMathToInlines t s) >>=
+ inlinesToOpenDocument o
Cite _ l -> inlinesToOpenDocument o l
RawInline f s -> if f == Format "opendocument"
then return $ text s
@@ -489,18 +506,18 @@ inlineToOpenDocument o ils
addNote nn
return nn
-bulletListStyle :: Int -> State WriterState (Int,(Int,[Doc]))
-bulletListStyle l =
- let doStyles i = inTags True "text:list-level-style-bullet"
- [ ("text:level" , show (i + 1) )
- , ("text:style-name" , "Bullet_20_Symbols")
- , ("style:num-suffix", "." )
- , ("text:bullet-char", [bulletList !! i] )
- ] (listLevelStyle (1 + i))
- bulletList = map chr $ cycle [8226,8227,8259]
- listElStyle = map doStyles [0..9]
- in do pn <- paraListStyle l
- return (pn, (l, listElStyle))
+bulletListStyle :: PandocMonad m => Int -> OD m (Int,(Int,[Doc]))
+bulletListStyle l = do
+ let doStyles i = inTags True "text:list-level-style-bullet"
+ [ ("text:level" , show (i + 1) )
+ , ("text:style-name" , "Bullet_20_Symbols")
+ , ("style:num-suffix", "." )
+ , ("text:bullet-char", [bulletList !! i] )
+ ] (listLevelStyle (1 + i))
+ bulletList = map chr $ cycle [8226,8227,8259]
+ listElStyle = map doStyles [0..9]
+ pn <- paraListStyle l
+ return (pn, (l, listElStyle))
orderedListLevelStyle :: ListAttributes -> (Int, [Doc]) -> (Int,[Doc])
orderedListLevelStyle (s,n, d) (l,ls) =
@@ -554,7 +571,7 @@ tableStyle num wcs =
columnStyles = map colStyle wcs
in table $$ vcat columnStyles $$ cellStyle
-paraStyle :: [(String,String)] -> State WriterState Int
+paraStyle :: PandocMonad m => [(String,String)] -> OD m Int
paraStyle attrs = do
pn <- (+) 1 . length <$> gets stParaStyles
i <- (*) 0.5 . fromIntegral <$> gets stIndentPara :: State WriterState Double
@@ -578,14 +595,13 @@ paraStyle attrs = do
addParaStyle $ inTags True "style:style" (styleAttr ++ attrs) paraProps
return pn
-paraBreakStyle :: ParaBreak -> State WriterState Int
+paraBreakStyle :: PandocMonad m => ParaBreak -> OD m Int
paraBreakStyle PageBefore = paraStyle "Text_20_body" [("fo:break-before", "page")]
paraBreakStyle PageAfter = paraStyle "Text_20_body" [("fo:break-after", "page")]
paraBreakStyle PageBoth = paraStyle "Text_20_body" [("fo:break-before", "page"), ("fo:break-after", "page")]
paraBreakStyle AutoNone = paraStyle "Text_20_body" []
-
-paraListStyle :: Int -> State WriterState Int
+paraListStyle :: PandocMonad m => Int -> OD m Int
paraListStyle l = paraStyle
[("style:parent-style-name","Text_20_body")
,("style:list-style-name", "L" ++ show l )]
diff --git a/src/Text/Pandoc/Writers/RTF.hs b/src/Text/Pandoc/Writers/RTF.hs
index f5d56d021..f71c97334 100644
--- a/src/Text/Pandoc/Writers/RTF.hs
+++ b/src/Text/Pandoc/Writers/RTF.hs
@@ -34,7 +34,7 @@ import Text.Pandoc.Definition
import Text.Pandoc.Options
import Text.Pandoc.Shared
import Text.Pandoc.Writers.Shared
-import Text.Pandoc.Readers.TeXMath
+import Text.Pandoc.Writers.Math
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Walk
import Data.List ( isSuffixOf, intercalate )
@@ -83,49 +83,50 @@ rtfEmbedImage opts x@(Image attr _ (src,_)) = do
rtfEmbedImage _ x = return x
-- | Convert Pandoc to a string in rich text format, with
--- images embedded as encoded binary data.
-writeRTFWithEmbeddedImages :: PandocMonad m => WriterOptions -> Pandoc -> m String
+-- images embedded as encoded binary data. TODO get rid of this,
+-- we don't need it now that we have writeRTF in PandocMonad.
+writeRTFWithEmbeddedImages :: PandocMonad m
+ => WriterOptions -> Pandoc -> m String
writeRTFWithEmbeddedImages options doc =
- writeRTF options `fmap` walkM (rtfEmbedImage options) doc
+ writeRTF options =<< walkM (rtfEmbedImage options) doc
-- | Convert Pandoc to a string in rich text format.
-writeRTF :: WriterOptions -> Pandoc -> String
-writeRTF options (Pandoc meta@(Meta metamap) blocks) =
+writeRTF :: PandocMonad m => WriterOptions -> Pandoc -> m String
+writeRTF options (Pandoc meta@(Meta metamap) blocks) = do
let spacer = not $ all null $ docTitle meta : docDate meta : docAuthors meta
- toPlain (MetaBlocks [Para ils]) = MetaInlines ils
+ let toPlain (MetaBlocks [Para ils]) = MetaInlines ils
toPlain x = x
- -- adjust title, author, date so we don't get para inside para
- meta' = Meta $ M.adjust toPlain "title"
+ -- adjust title, author, date so we don't get para inside para
+ let meta' = Meta $ M.adjust toPlain "title"
. M.adjust toPlain "author"
. M.adjust toPlain "date"
$ metamap
- Just metadata = metaToJSON options
- (Just . concatMap (blockToRTF 0 AlignDefault))
- (Just . inlineListToRTF)
+ metadata <- metaToJSON options
+ (fmap concat . mapM (blockToRTF 0 AlignDefault))
+ (inlinesToRTF)
meta'
- body = concatMap (blockToRTF 0 AlignDefault) blocks
- isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
+ body <- blocksToRTF 0 AlignDefault blocks
+ let isTOCHeader (Header lev _ _) = lev <= writerTOCDepth options
isTOCHeader _ = False
- context = defField "body" body
+ toc <- tableOfContents $ filter isTOCHeader blocks
+ let context = defField "body" body
$ defField "spacer" spacer
$ (if writerTableOfContents options
- then defField "toc"
- (tableOfContents $ filter isTOCHeader blocks)
+ then defField "toc" toc
else id)
$ metadata
- in case writerTemplate options of
+ return $ case writerTemplate options of
Just tpl -> renderTemplate' tpl context
Nothing -> case reverse body of
('\n':_) -> body
_ -> body ++ "\n"
-- | Construct table of contents from list of header blocks.
-tableOfContents :: [Block] -> String
-tableOfContents headers =
- let contentsTree = hierarchicalize headers
- in concatMap (blockToRTF 0 AlignDefault) $
- [Header 1 nullAttr [Str "Contents"],
- BulletList (map elementToListItem contentsTree)]
+tableOfContents :: PandocMonad m => [Block] -> m String
+tableOfContents headers = do
+ let contents = map elementToListItem $ hierarchicalize headers
+ blocksToRTF 0 AlignDefault $
+ [Header 1 nullAttr [Str "Contents"], BulletList contents]
elementToListItem :: Element -> [Block]
elementToListItem (Blk _) = []
@@ -227,66 +228,81 @@ orderedMarkers indent (start, style, delim) =
_ -> orderedListMarkers (start, LowerAlpha, Period)
else orderedListMarkers (start, style, delim)
+blocksToRTF :: PandocMonad m
+ => Int
+ -> Alignment
+ -> [Block]
+ -> m String
+blocksToRTF indent align = fmap concat . mapM (blockToRTF indent align)
+
-- | Convert Pandoc block element to RTF.
-blockToRTF :: Int -- ^ indent level
+blockToRTF :: PandocMonad m
+ => Int -- ^ indent level
-> Alignment -- ^ alignment
-> Block -- ^ block to convert
- -> String
-blockToRTF _ _ Null = ""
+ -> m String
+blockToRTF _ _ Null = return ""
blockToRTF indent alignment (Div _ bs) =
- concatMap (blockToRTF indent alignment) bs
+ blocksToRTF indent alignment bs
blockToRTF indent alignment (Plain lst) =
- rtfCompact indent 0 alignment $ inlineListToRTF lst
+ rtfCompact indent 0 alignment <$> inlinesToRTF lst
blockToRTF indent alignment (Para lst) =
- rtfPar indent 0 alignment $ inlineListToRTF lst
+ rtfPar indent 0 alignment <$> inlinesToRTF lst
blockToRTF indent alignment (LineBlock lns) =
blockToRTF indent alignment $ linesToPara lns
blockToRTF indent alignment (BlockQuote lst) =
- concatMap (blockToRTF (indent + indentIncrement) alignment) lst
+ blocksToRTF (indent + indentIncrement) alignment lst
blockToRTF indent _ (CodeBlock _ str) =
- rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
+ return $ rtfPar indent 0 AlignLeft ("\\f1 " ++ (codeStringToRTF str))
blockToRTF _ _ (RawBlock f str)
- | f == Format "rtf" = str
- | otherwise = ""
-blockToRTF indent alignment (BulletList lst) = spaceAtEnd $
- concatMap (listItemToRTF alignment indent (bulletMarker indent)) lst
-blockToRTF indent alignment (OrderedList attribs lst) = spaceAtEnd $ concat $
- zipWith (listItemToRTF alignment indent) (orderedMarkers indent attribs) lst
-blockToRTF indent alignment (DefinitionList lst) = spaceAtEnd $
- concatMap (definitionListItemToRTF alignment indent) lst
-blockToRTF indent _ HorizontalRule =
+ | f == Format "rtf" = return str
+ | otherwise = return ""
+blockToRTF indent alignment (BulletList lst) = (spaceAtEnd . concat) <$>
+ mapM (listItemToRTF alignment indent (bulletMarker indent)) lst
+blockToRTF indent alignment (OrderedList attribs lst) =
+ (spaceAtEnd . concat) <$>
+ mapM (\(x,y) -> listItemToRTF alignment indent x y)
+ (zip (orderedMarkers indent attribs) lst)
+blockToRTF indent alignment (DefinitionList lst) = (spaceAtEnd . concat) <$>
+ mapM (definitionListItemToRTF alignment indent) lst
+blockToRTF indent _ HorizontalRule = return $
rtfPar indent 0 AlignCenter "\\emdash\\emdash\\emdash\\emdash\\emdash"
-blockToRTF indent alignment (Header level _ lst) = rtfPar indent 0 alignment $
- "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ inlineListToRTF lst
-blockToRTF indent alignment (Table caption aligns sizes headers rows) =
- (if all null headers
- then ""
- else tableRowToRTF True indent aligns sizes headers) ++
- concatMap (tableRowToRTF False indent aligns sizes) rows ++
- rtfPar indent 0 alignment (inlineListToRTF caption)
+blockToRTF indent alignment (Header level _ lst) = do
+ contents <- inlinesToRTF lst
+ return $ rtfPar indent 0 alignment $
+ "\\b \\fs" ++ (show (40 - (level * 4))) ++ " " ++ contents
+blockToRTF indent alignment (Table caption aligns sizes headers rows) = do
+ caption' <- inlinesToRTF caption
+ header' <- if all null headers
+ then return ""
+ else tableRowToRTF True indent aligns sizes headers
+ rows' <- concat <$> mapM (tableRowToRTF False indent aligns sizes) rows
+ return $ header' ++ rows' ++ rtfPar indent 0 alignment caption'
-tableRowToRTF :: Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> String
-tableRowToRTF header indent aligns sizes' cols =
+tableRowToRTF :: PandocMonad m
+ => Bool -> Int -> [Alignment] -> [Double] -> [[Block]] -> m String
+tableRowToRTF header indent aligns sizes' cols = do
let totalTwips = 6 * 1440 -- 6 inches
- sizes = if all (== 0) sizes'
+ let sizes = if all (== 0) sizes'
then take (length cols) $ repeat (1.0 / fromIntegral (length cols))
else sizes'
- columns = concat $ zipWith (tableItemToRTF indent) aligns cols
- rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
+ columns <- concat <$> mapM (\(x,y) -> tableItemToRTF indent x y)
+ (zip aligns cols)
+ let rightEdges = tail $ scanl (\sofar new -> sofar + floor (new * totalTwips))
(0 :: Integer) sizes
- cellDefs = map (\edge -> (if header
+ let cellDefs = map (\edge -> (if header
then "\\clbrdrb\\brdrs"
else "") ++ "\\cellx" ++ show edge)
rightEdges
- start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
+ let start = "{\n\\trowd \\trgaph120\n" ++ concat cellDefs ++ "\n" ++
"\\trkeep\\intbl\n{\n"
- end = "}\n\\intbl\\row}\n"
- in start ++ columns ++ end
+ let end = "}\n\\intbl\\row}\n"
+ return $ start ++ columns ++ end
-tableItemToRTF :: Int -> Alignment -> [Block] -> String
-tableItemToRTF indent alignment item =
- let contents = concatMap (blockToRTF indent alignment) item
- in "{" ++ substitute "\\pard" "\\pard\\intbl" contents ++ "\\cell}\n"
+tableItemToRTF :: PandocMonad m => Int -> Alignment -> [Block] -> m String
+tableItemToRTF indent alignment item = do
+ contents <- blocksToRTF indent alignment item
+ return $ "{" ++ substitute "\\pard" "\\pard\\intbl" contents ++ "\\cell}\n"
-- | Ensure that there's the same amount of space after compact
-- lists as after regular lists.
@@ -297,74 +313,93 @@ spaceAtEnd str =
else str
-- | Convert list item (list of blocks) to RTF.
-listItemToRTF :: Alignment -- ^ alignment
+listItemToRTF :: PandocMonad m
+ => Alignment -- ^ alignment
-> Int -- ^ indent level
-> String -- ^ list start marker
-> [Block] -- ^ list item (list of blocks)
- -> [Char]
-listItemToRTF alignment indent marker [] =
+ -> m String
+listItemToRTF alignment indent marker [] = return $
rtfCompact (indent + listIncrement) (0 - listIncrement) alignment
(marker ++ "\\tx" ++ (show listIncrement) ++ "\\tab ")
-listItemToRTF alignment indent marker list =
- let (first:rest) = map (blockToRTF (indent + listIncrement) alignment) list
- listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++ "\\tx" ++
- show listIncrement ++ "\\tab"
- insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d =
+listItemToRTF alignment indent marker list = do
+ (first:rest) <- mapM (blockToRTF (indent + listIncrement) alignment) list
+ let listMarker = "\\fi" ++ show (0 - listIncrement) ++ " " ++ marker ++
+ "\\tx" ++ show listIncrement ++ "\\tab"
+ let insertListMarker ('\\':'f':'i':'-':d:xs) | isDigit d =
listMarker ++ dropWhile isDigit xs
insertListMarker ('\\':'f':'i':d:xs) | isDigit d =
listMarker ++ dropWhile isDigit xs
insertListMarker (x:xs) =
x : insertListMarker xs
insertListMarker [] = []
- -- insert the list marker into the (processed) first block
- in insertListMarker first ++ concat rest
+ -- insert the list marker into the (processed) first block
+ return $ insertListMarker first ++ concat rest
-- | Convert definition list item (label, list of blocks) to RTF.
-definitionListItemToRTF :: Alignment -- ^ alignment
+definitionListItemToRTF :: PandocMonad m
+ => Alignment -- ^ alignment
-> Int -- ^ indent level
-> ([Inline],[[Block]]) -- ^ list item (list of blocks)
- -> [Char]
-definitionListItemToRTF alignment indent (label, defs) =
- let labelText = blockToRTF indent alignment (Plain label)
- itemsText = concatMap (blockToRTF (indent + listIncrement) alignment) $
- concat defs
- in labelText ++ itemsText
+ -> m String
+definitionListItemToRTF alignment indent (label, defs) = do
+ labelText <- blockToRTF indent alignment (Plain label)
+ itemsText <- blocksToRTF (indent + listIncrement) alignment (concat defs)
+ return $ labelText ++ itemsText
-- | Convert list of inline items to RTF.
-inlineListToRTF :: [Inline] -- ^ list of inlines to convert
- -> String
-inlineListToRTF lst = concatMap inlineToRTF lst
+inlinesToRTF :: PandocMonad m
+ => [Inline] -- ^ list of inlines to convert
+ -> m String
+inlinesToRTF lst = concat <$> mapM inlineToRTF lst
-- | Convert inline item to RTF.
-inlineToRTF :: Inline -- ^ inline to convert
- -> String
-inlineToRTF (Span _ lst) = inlineListToRTF lst
-inlineToRTF (Emph lst) = "{\\i " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (Strong lst) = "{\\b " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (Strikeout lst) = "{\\strike " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (Superscript lst) = "{\\super " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (Subscript lst) = "{\\sub " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (SmallCaps lst) = "{\\scaps " ++ (inlineListToRTF lst) ++ "}"
-inlineToRTF (Quoted SingleQuote lst) =
- "\\u8216'" ++ (inlineListToRTF lst) ++ "\\u8217'"
-inlineToRTF (Quoted DoubleQuote lst) =
- "\\u8220\"" ++ (inlineListToRTF lst) ++ "\\u8221\""
-inlineToRTF (Code _ str) = "{\\f1 " ++ (codeStringToRTF str) ++ "}"
-inlineToRTF (Str str) = stringToRTF str
-inlineToRTF (Math t str) = inlineListToRTF $ texMathToInlines t str
-inlineToRTF (Cite _ lst) = inlineListToRTF lst
+inlineToRTF :: PandocMonad m
+ => Inline -- ^ inline to convert
+ -> m String
+inlineToRTF (Span _ lst) = inlinesToRTF lst
+inlineToRTF (Emph lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\i " ++ contents ++ "}"
+inlineToRTF (Strong lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\b " ++ contents ++ "}"
+inlineToRTF (Strikeout lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\strike " ++ contents ++ "}"
+inlineToRTF (Superscript lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\super " ++ contents ++ "}"
+inlineToRTF (Subscript lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\sub " ++ contents ++ "}"
+inlineToRTF (SmallCaps lst) = do
+ contents <- inlinesToRTF lst
+ return $ "{\\scaps " ++ contents ++ "}"
+inlineToRTF (Quoted SingleQuote lst) = do
+ contents <- inlinesToRTF lst
+ return $ "\\u8216'" ++ contents ++ "\\u8217'"
+inlineToRTF (Quoted DoubleQuote lst) = do
+ contents <- inlinesToRTF lst
+ return $ "\\u8220\"" ++ contents ++ "\\u8221\""
+inlineToRTF (Code _ str) = return $ "{\\f1 " ++ (codeStringToRTF str) ++ "}"
+inlineToRTF (Str str) = return $ stringToRTF str
+inlineToRTF (Math t str) = texMathToInlines t str >>= inlinesToRTF
+inlineToRTF (Cite _ lst) = inlinesToRTF lst
inlineToRTF (RawInline f str)
- | f == Format "rtf" = str
- | otherwise = ""
-inlineToRTF LineBreak = "\\line "
-inlineToRTF SoftBreak = " "
-inlineToRTF PageBreak = "\\page "
-inlineToRTF Space = " "
-inlineToRTF (Link _ text (src, _)) =
- "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
- "\"}}{\\fldrslt{\\ul\n" ++ (inlineListToRTF text) ++ "\n}}}\n"
+ | f == Format "rtf" = return str
+ | otherwise = return ""
+inlineToRTF (LineBreak) = return "\\line "
+inlineToRTF SoftBreak = return " "
+inlineToRTF PageBreak = return "\\page "
+inlineToRTF Space = return " "
+inlineToRTF (Link _ text (src, _)) = do
+ contents <- inlinesToRTF text
+ return $ "{\\field{\\*\\fldinst{HYPERLINK \"" ++ (codeStringToRTF src) ++
+ "\"}}{\\fldrslt{\\ul\n" ++ contents ++ "\n}}}\n"
inlineToRTF (Image _ _ (source, _)) =
- "{\\cf1 [image: " ++ source ++ "]\\cf0}"
-inlineToRTF (Note contents) =
- "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
- (concatMap (blockToRTF 0 AlignDefault) contents) ++ "}"
+ return $ "{\\cf1 [image: " ++ source ++ "]\\cf0}"
+inlineToRTF (Note contents) = do
+ body <- concat <$> mapM (blockToRTF 0 AlignDefault) contents
+ return $ "{\\super\\chftn}{\\*\\footnote\\chftn\\~\\plain\\pard " ++
+ body ++ "}"