Tissevert/pandoc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Refactored math conversion in writers.

Browse source 
* 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.
This commit is contained in:
John MacFarlane 2016-12-03 16:15:13 +01:00
parent 221f878c0e
commit 830be4d632
12 changed files with 489 additions and 417 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
pandoc.cabal
View file

@ -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,

48
src/Text/Pandoc/Readers/TeXMath.hs
View file

@ -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, "$")

285
src/Text/Pandoc/Writers/Docbook.hs
View file

@ -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

18
src/Text/Pandoc/Writers/Docx.hs
View file

@ -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`

15
src/Text/Pandoc/Writers/HTML.hs
View file

@ -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

63
src/Text/Pandoc/Writers/Haddock.hs
View file

@ -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

5
src/Text/Pandoc/Writers/ICML.hs
View file

@ -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

6
src/Text/Pandoc/Writers/Man.hs
View file

@ -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

22
src/Text/Pandoc/Writers/Markdown.hs
View file

@ -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

47
src/Text/Pandoc/Writers/Math.hs Normal file
View file

@ -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

136
src/Text/Pandoc/Writers/OpenDocument.hs
View file

@ -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 )]

259
src/Text/Pandoc/Writers/RTF.hs
View file

@ -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 ++ "}"