@@ -33,7 +33,8 @@ module Text.Pandoc.Writers.TEI (writeTEI) where
3333import Data.Char (toLower)
3434import Data.List (isPrefixOf, stripPrefix)
3535import qualified Text.Pandoc.Builder as B
36−import Text.Pandoc.Class (PandocMonad)
36+import Text.Pandoc.Class (PandocMonad, report)
37+import Text.Pandoc.Logging
3738import Text.Pandoc.Definition
3839import Text.Pandoc.Highlighting (languages, languagesByExtension)
3940import Text.Pandoc.ImageSize
@@ -45,18 +46,18 @@ import Text.Pandoc.Writers.Shared
4546import Text.Pandoc.XML
4647
4748-- | Convert list of authors to a docbook <author> section
48−authorToTEI :: WriterOptions -> [Inline] -> B.Inlines
49−authorToTEI opts name' =
50− let name = render Nothing $ inlinesToTEI opts name'
51− colwidth = if writerWrapText opts == WrapAuto
49+authorToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m B.Inlines
50+authorToTEI opts name' = do
51+ name <- render Nothing <$> inlinesToTEI opts name'
52+ let colwidth = if writerWrapText opts == WrapAuto
5253 then Just $ writerColumns opts
5354 else Nothing
54− in B.rawInline "tei" $ render colwidth $
55+ return $ B.rawInline "tei" $ render colwidth $
5556 inTagsSimple "author" (text $ escapeStringForXML name)
5657
5758-- | Convert Pandoc document to string in Docbook format.
5859writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m String
59−writeTEI opts (Pandoc meta blocks) = return $
60+writeTEI opts (Pandoc meta blocks) = do
6061 let elements = hierarchicalize blocks
6162 colwidth = if writerWrapText opts == WrapAuto
6263 then Just $ writerColumns opts
@@ -67,27 +68,27 @@ writeTEI opts (Pandoc meta blocks) = return $
6768 TopLevelChapter -> 0
6869 TopLevelSection -> 1
6970 TopLevelDefault -> 1
70− auths' = map (authorToTEI opts) $ docAuthors meta
71− meta' = B.setMeta "author" auths' meta
72− Just metadata = metaToJSON opts
73− (Just . render colwidth . (vcat .
74− (map (elementToTEI opts startLvl)) . hierarchicalize))
75− (Just . render colwidth . inlinesToTEI opts)
71+ auths' <- mapM (authorToTEI opts) $ docAuthors meta
72+ let meta' = B.setMeta "author" auths' meta
73+ metadata <- metaToJSON opts
74+ (fmap (render colwidth . vcat) .
75+ (mapM (elementToTEI opts startLvl)) . hierarchicalize)
76+ (fmap (render colwidth) . inlinesToTEI opts)
7677 meta'
77− main = render' $ vcat (map (elementToTEI opts startLvl) elements)
78− context = defField "body" main
78+ main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements
79+ let context = defField "body" main
7980 $ defField "mathml" (case writerHTMLMathMethod opts of
8081 MathML -> True
8182 _ -> False)
8283 $ metadata
83− in case writerTemplate opts of
84− Nothing -> main
85− Just tpl -> renderTemplate' tpl context
84+ case writerTemplate opts of
85+ Nothing -> return main
86+ Just tpl -> return $ renderTemplate' tpl context
8687
8788-- | Convert an Element to TEI.
88−elementToTEI :: WriterOptions -> Int -> Element -> Doc
89+elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
8990elementToTEI opts _ (Blk block) = blockToTEI opts block
90−elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) =
91+elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) = do
9192 -- TEI doesn't allow sections with no content, so insert some if needed
9293 let elements' = if null elements
9394 then [Blk (Para [])]
@@ -98,14 +99,15 @@ elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) =
9899 | n == 0 -> "chapter"
99100 | n >= 1 && n <= 5 -> "level" ++ show n
100101 | otherwise -> "section"
101− in inTags True "div" [("type", divType) | not (null id')] $
102−-- ("id", writerIdentifierPrefix opts ++ id') | not (null id')] $
103− inTagsSimple "head" (inlinesToTEI opts title) $$
104− vcat (map (elementToTEI opts (lvl + 1)) elements')
102+ contents <- vcat <$> mapM (elementToTEI opts (lvl + 1)) elements'
103+ titleContents <- inlinesToTEI opts title
104+ return $ inTags True "div" (("type", divType) :
105+ [("id", writerIdentifierPrefix opts ++ id') | not (null id')]) $
106+ inTagsSimple "head" titleContents $$ contents
105107
106108-- | Convert a list of Pandoc blocks to TEI.
107−blocksToTEI :: WriterOptions -> [Block] -> Doc
108−blocksToTEI opts = vcat . map (blockToTEI opts)
109+blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
110+blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs
109111
110112-- | Auxiliary function to convert Plain block to Para.
111113plainToPara :: Block -> Block
@@ -114,28 +116,32 @@ plainToPara x = x
114116
115117-- | Convert a list of pairs of terms and definitions into a TEI
116118-- list with labels and items.
117−deflistItemsToTEI :: WriterOptions -> [([Inline],[[Block]])] -> Doc
119+deflistItemsToTEI :: PandocMonad m
120+ => WriterOptions -> [([Inline],[[Block]])] -> m Doc
118121deflistItemsToTEI opts items =
119− vcat $ map (\(term, defs) -> deflistItemToTEI opts term defs) items
122+ vcat <$> mapM (\(term, defs) -> deflistItemToTEI opts term defs) items
120123
121124-- | Convert a term and a list of blocks into a TEI varlistentry.
122−deflistItemToTEI :: WriterOptions -> [Inline] -> [[Block]] -> Doc
123−deflistItemToTEI opts term defs =
125+deflistItemToTEI :: PandocMonad m
126+ => WriterOptions -> [Inline] -> [[Block]] -> m Doc
127+deflistItemToTEI opts term defs = do
124128 let def' = concatMap (map plainToPara) defs
125− in inTagsIndented "label" (inlinesToTEI opts term) $$
126− inTagsIndented "item" (blocksToTEI opts def')
129+ term' <- inlinesToTEI opts term
130+ defs' <- blocksToTEI opts $ concatMap (map plainToPara) defs
131+ return $ inTagsIndented "label" term' $$
132+ inTagsIndented "item" defs'
127133
128134-- | Convert a list of lists of blocks to a list of TEI list items.
129−listItemsToTEI :: WriterOptions -> [[Block]] -> Doc
130−listItemsToTEI opts items = vcat $ map (listItemToTEI opts) items
135+listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
136+listItemsToTEI opts items = vcat <$> mapM (listItemToTEI opts) items
131137
132138-- | Convert a list of blocks into a TEI list item.
133−listItemToTEI :: WriterOptions -> [Block] -> Doc
139+listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
134140listItemToTEI opts item =
135− inTagsIndented "item" $ blocksToTEI opts $ map plainToPara item
141+ inTagsIndented "item" <$> blocksToTEI opts (map plainToPara item)
136142
137−imageToTEI :: WriterOptions -> Attr -> String -> Doc
138−imageToTEI _ attr src = selfClosingTag "graphic" $
143+imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m Doc
144+imageToTEI _ attr src = return $ selfClosingTag "graphic" $
139145 ("url", src) : idAndRole attr ++ dims
140146 where
141147 dims = go Width "width" ++ go Height "depth"
@@ -144,15 +150,16 @@ imageToTEI _ attr src = selfClosingTag "graphic" $
144150 Nothing -> []
145151
146152-- | Convert a Pandoc block element to TEI.
147−blockToTEI :: WriterOptions -> Block -> Doc
148−blockToTEI _ Null = empty
153+blockToTEI :: PandocMonad m => WriterOptions -> Block -> m Doc
154+blockToTEI _ Null = return empty
149155-- Add ids to paragraphs in divs with ids - this is needed for
150156-- pandoc-citeproc to get link anchors in bibliographies:
151−blockToTEI opts (Div (ident,_,_) [Para lst]) =
152− let attribs = [("id", ident) | not (null ident)] in
153− inTags False "p" attribs $ inlinesToTEI opts lst
157+blockToTEI opts (Div (ident,_,_) [Para lst]) = do
158+ let attribs = [("id", ident) | not (null ident)]
159+ inTags False "p" attribs <$> inlinesToTEI opts lst
154160blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs
155−blockToTEI _ (Header _ _ _) = empty -- should not occur after hierarchicalize
161+blockToTEI _ (Header _ _ _) = return empty
162+-- should not occur after hierarchicalize
156163-- For TEI simple, text must be within containing block element, so
157164-- we use plainToPara to ensure that Plain text ends up contained by
158165-- something.
@@ -170,13 +177,13 @@ blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst
170177-- (imageToTEI opts attr src)) $$
171178-- inTagsSimple "textobject" (inTagsSimple "phrase" alt))
172179blockToTEI opts (Para lst) =
173− inTags False "p" [] $ inlinesToTEI opts lst
180+ inTags False "p" [] <$> inlinesToTEI opts lst
174181blockToTEI opts (LineBlock lns) =
175182 blockToTEI opts $ linesToPara lns
176183blockToTEI opts (BlockQuote blocks) =
177− inTagsIndented "quote" $ blocksToTEI opts blocks
184+ inTagsIndented "quote" <$> blocksToTEI opts blocks
178185blockToTEI _ (CodeBlock (_,classes,_) str) =
179− text ("<ab type='codeblock " ++ lang ++ "'>") <> cr <>
186+ return $ text ("<ab type='codeblock " ++ lang ++ "'>") <> cr <>
180187 flush (text (escapeStringForXML str) <> cr <> text "</ab>")
181188 where lang = if null langs
182189 then ""
@@ -186,11 +193,11 @@ blockToTEI _ (CodeBlock (_,classes,_) str) =
186193 then [s]
187194 else languagesByExtension . map toLower $ s
188195 langs = concatMap langsFrom classes
189−blockToTEI opts (BulletList lst) =
196+blockToTEI opts (BulletList lst) = do
190197 let attribs = [("type", "unordered")]
191− in inTags True "list" attribs $ listItemsToTEI opts lst
192−blockToTEI _ (OrderedList _ []) = empty
193−blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) =
198+ inTags True "list" attribs <$> listItemsToTEI opts lst
199+blockToTEI _ (OrderedList _ []) = return empty
200+blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) = do
194201 let attribs = case numstyle of
195202 DefaultStyle -> []
196203 Decimal -> [("type", "ordered:arabic")]
@@ -199,120 +206,130 @@ blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) =
199206 LowerAlpha -> [("type", "ordered:loweralpha")]
200207 UpperRoman -> [("type", "ordered:upperroman")]
201208 LowerRoman -> [("type", "ordered:lowerroman")]
202− items = if start == 1
203− then listItemsToTEI opts (first:rest)
204− else (inTags True "item" [("n",show start)]
205− (blocksToTEI opts $ map plainToPara first)) $$
206− listItemsToTEI opts rest
207− in inTags True "list" attribs items
208−blockToTEI opts (DefinitionList lst) =
209+ items <- if start == 1
210+ then listItemsToTEI opts (first:rest)
211+ else do
212+ fi <- blocksToTEI opts $ map plainToPara first
213+ re <- listItemsToTEI opts rest
214+ return $ (inTags True "item" [("n",show start)] fi) $$ re
215+ return $ inTags True "list" attribs items
216+blockToTEI opts (DefinitionList lst) = do
209217 let attribs = [("type", "definition")]
210− in inTags True "list" attribs $ deflistItemsToTEI opts lst
211−blockToTEI _ (RawBlock f str)
212− | f == "tei" = text str -- raw TEI block (should such a thing exist).
213−-- | f == "html" = text str -- allow html for backwards compatibility
214− | otherwise = empty
215−blockToTEI _ HorizontalRule =
216− selfClosingTag "milestone" [("unit","undefined"), ("type","separator"),("rendition","line")]
218+ inTags True "list" attribs <$> deflistItemsToTEI opts lst
219+blockToTEI _ b@(RawBlock f str)
220+ | f == "tei" = return $ text str
221+ -- raw TEI block (should such a thing exist).
222+ | otherwise = do
223+ report $ BlockNotRendered b
224+ return empty
225+blockToTEI _ HorizontalRule = return $
226+ selfClosingTag "milestone" [("unit","undefined")
227+ ,("type","separator")
228+ ,("rendition","line")]
217229
218230-- | TEI Tables
219231-- TEI Simple's tables are composed of cells and rows; other
220232-- table info in the AST is here lossily discard.
221−blockToTEI opts (Table _ _ _ headers rows) =
222− let
223− headers' = tableHeadersToTEI opts headers
224−-- headers' = if all null headers
225−-- then return empty
226−-- else tableRowToTEI opts headers
227− in
228− inTags True "table" [] $
229− vcat $ [headers'] <> map (tableRowToTEI opts) rows
233+blockToTEI opts (Table _ _ _ headers rows) = do
234+ headers' <- tableHeadersToTEI opts headers
235+ rows' <- mapM (tableRowToTEI opts) rows
236+ return $ inTags True "table" [] $ headers' $$ vcat rows'
230237
231−tableRowToTEI :: WriterOptions
232− -> [[Block]]
233− -> Doc
238+tableRowToTEI :: PandocMonad m
239+ => WriterOptions
240+ -> [[Block]]
241+ -> m Doc
234242tableRowToTEI opts cols =
235− inTagsIndented "row" $ vcat $ map (tableItemToTEI opts) cols
243+ (inTagsIndented "row" . vcat) <$> mapM (tableItemToTEI opts) cols
236244
237−tableHeadersToTEI :: WriterOptions
245+tableHeadersToTEI :: PandocMonad m
246+ => WriterOptions
238247 -> [[Block]]
239− -> Doc
248+ -> m Doc
240249tableHeadersToTEI opts cols =
241− inTags True "row" [("role","label")] $ vcat $ map (tableItemToTEI opts) cols
250+ (inTags True "row" [("role","label")] . vcat) <$>
251+ mapM (tableItemToTEI opts) cols
242252
243−tableItemToTEI :: WriterOptions
244− -> [Block]
245− -> Doc
253+tableItemToTEI :: PandocMonad m
254+ => WriterOptions
255+ -> [Block]
256+ -> m Doc
246257tableItemToTEI opts item =
247− inTags False "cell" [] $ vcat $ map (blockToTEI opts) item
258+ (inTags False "cell" [] . vcat) <$> mapM (blockToTEI opts) item
248259
249260-- | Convert a list of inline elements to TEI.
250−inlinesToTEI :: WriterOptions -> [Inline] -> Doc
251−inlinesToTEI opts lst = hcat $ map (inlineToTEI opts) lst
261+inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
262+inlinesToTEI opts lst = hcat <$> mapM (inlineToTEI opts) lst
252263
253264-- | Convert an inline element to TEI.
254−inlineToTEI :: WriterOptions -> Inline -> Doc
255−inlineToTEI _ (Str str) = text $ escapeStringForXML str
265+inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m Doc
266+inlineToTEI _ (Str str) = return $ text $ escapeStringForXML str
256267inlineToTEI opts (Emph lst) =
257− inTags False "hi" [("rendition","simple:italic")] $ inlinesToTEI opts lst
268+ inTags False "hi" [("rendition","simple:italic")] <$> inlinesToTEI opts lst
258269inlineToTEI opts (Strong lst) =
259− inTags False "hi" [("rendition", "simple:bold")] $ inlinesToTEI opts lst
270+ inTags False "hi" [("rendition", "simple:bold")] <$> inlinesToTEI opts lst
260271inlineToTEI opts (Strikeout lst) =
261− inTags False "hi" [("rendition", "simple:strikethrough")] $
272+ inTags False "hi" [("rendition", "simple:strikethrough")] <$>
262273 inlinesToTEI opts lst
263274inlineToTEI opts (Superscript lst) =
264− inTags False "hi" [("rendition", "simple:superscript")] $ inlinesToTEI opts lst
275+ inTags False "hi" [("rendition", "simple:superscript")] <$>
276+ inlinesToTEI opts lst
265277inlineToTEI opts (Subscript lst) =
266− inTags False "hi" [("rendition", "simple:subscript")] $ inlinesToTEI opts lst
278+ inTags False "hi" [("rendition", "simple:subscript")] <$>
279+ inlinesToTEI opts lst
267280inlineToTEI opts (SmallCaps lst) =
268− inTags False "hi" [("rendition", "simple:smallcaps")] $
269− inlinesToTEI opts lst
281+ inTags False "hi" [("rendition", "simple:smallcaps")] <$>
282+ inlinesToTEI opts lst
270283inlineToTEI opts (Quoted _ lst) =
271− inTagsSimple "quote" $ inlinesToTEI opts lst
284+ inTagsSimple "quote" <$> inlinesToTEI opts lst
272285inlineToTEI opts (Cite _ lst) =
273286 inlinesToTEI opts lst
274287inlineToTEI opts (Span _ ils) =
275288 inlinesToTEI opts ils
276−inlineToTEI _ (Code _ str) =
289+inlineToTEI _ (Code _ str) = return $
277290 inTags False "seg" [("type","code")] $ text (escapeStringForXML str)
278291-- Distinguish display from inline math by wrapping the former in a "figure."
279−inlineToTEI _ (Math t str) =
292+inlineToTEI _ (Math t str) = return $
280293 case t of
281294 InlineMath -> inTags False "formula" [("notation","TeX")] $
282295 text (str)
283296 DisplayMath -> inTags True "figure" [("type","math")] $
284297 inTags False "formula" [("notation","TeX")] $ text (str)
285298
286−inlineToTEI _ (RawInline f x) | f == "tei" = text x
287− | otherwise = empty
288−inlineToTEI _ LineBreak = selfClosingTag "lb" []
289−inlineToTEI _ Space = space
299+inlineToTEI _ il@(RawInline f x) | f == "tei" = return $ text x
300+ | otherwise = empty <$
301+ report (InlineNotRendered il)
302+inlineToTEI _ LineBreak = return $ selfClosingTag "lb" []
303+inlineToTEI _ Space = return $ space
290304-- because we use \n for LineBreak, we can't do soft breaks:
291−inlineToTEI _ SoftBreak = space
305+inlineToTEI _ SoftBreak = return $ space
292306inlineToTEI opts (Link attr txt (src, _))
293− | Just email <- stripPrefix "mailto:" src =
307+ | Just email <- stripPrefix "mailto:" src = do
294308 let emailLink = text $
295309 escapeStringForXML $ email
296− in case txt of
297− [Str s] | escapeURI s == email -> emailLink
298− _ -> inlinesToTEI opts txt <+>
299− char '(' <> emailLink <> char ')'
310+ case txt of
311+ [Str s] | escapeURI s == email -> return $ emailLink
312+ _ -> do
313+ linktext <- inlinesToTEI opts txt
314+ return $ linktext <+> char '(' <> emailLink <> char ')'
300315 | otherwise =
301316 (if isPrefixOf "#" src
302317 then inTags False "ref" $ ("target", drop 1 src) : idAndRole attr
303− else inTags False "ref" $ ("target", src) : idAndRole attr ) $
318+ else inTags False "ref" $ ("target", src) : idAndRole attr ) <$>
304319 inlinesToTEI opts txt
305−inlineToTEI opts (Image attr description (src, tit)) =
320+inlineToTEI opts (Image attr description (src, tit)) = do
306321 let titleDoc = if null tit
307322 then empty
308− else inTags False "figDesc" [] (text $ escapeStringForXML tit)
309− imageDesc = if null description
310− then empty
311− else inTags False "head" [] (inlinesToTEI opts description)
312− in inTagsIndented "figure" $ imageDesc $$
313− imageToTEI opts attr src $$ titleDoc
323+ else inTags False "figDesc" []
324+ (text $ escapeStringForXML tit)
325+ imageDesc <- if null description
326+ then return empty
327+ else inTags False "head" []
328+ <$> inlinesToTEI opts description
329+ img <- imageToTEI opts attr src
330+ return $ inTagsIndented "figure" $ imageDesc $$ img $$ titleDoc
314331inlineToTEI opts (Note contents) =
315− inTagsIndented "note" $ blocksToTEI opts contents
332+ inTagsIndented "note" <$> blocksToTEI opts contents
316333
317334idAndRole :: Attr -> [(String, String)]
318335idAndRole (id',cls,_) = ident ++ role