pandoc-2.3: src/Text/Pandoc/Writers/TEI.hs
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-
Copyright (C) 2006-2018 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.Writers.Docbook
Copyright : Copyright (C) 2006-2018 John MacFarlane
License : GNU GPL, version 2 or above
Maintainer : John MacFarlane <jgm@berkeley.edu>
Stability : alpha
Portability : portable
Conversion of 'Pandoc' documents to Docbook XML.
-}
module Text.Pandoc.Writers.TEI (writeTEI) where
import Prelude
import Data.Char (toLower)
import Data.List (isPrefixOf, stripPrefix)
import Data.Text (Text)
import Text.Pandoc.Class (PandocMonad, report)
import Text.Pandoc.Definition
import Text.Pandoc.Highlighting (languages, languagesByExtension)
import Text.Pandoc.ImageSize
import Text.Pandoc.Logging
import Text.Pandoc.Options
import Text.Pandoc.Pretty
import Text.Pandoc.Shared
import Text.Pandoc.Templates (renderTemplate')
import Text.Pandoc.Writers.Shared
import Text.Pandoc.XML
-- | Convert Pandoc document to string in Docbook format.
writeTEI :: PandocMonad m => WriterOptions -> Pandoc -> m Text
writeTEI opts (Pandoc meta blocks) = do
let elements = hierarchicalize blocks
colwidth = if writerWrapText opts == WrapAuto
then Just $ writerColumns opts
else Nothing
render' :: Doc -> Text
render' = render colwidth
startLvl = case writerTopLevelDivision opts of
TopLevelPart -> -1
TopLevelChapter -> 0
TopLevelSection -> 1
TopLevelDefault -> 1
metadata <- metaToJSON opts
(fmap (render' . vcat) .
mapM (elementToTEI opts startLvl) . hierarchicalize)
(fmap render' . inlinesToTEI opts)
meta
main <- (render' . vcat) <$> mapM (elementToTEI opts startLvl) elements
let context = defField "body" main
$
defField "mathml" (case writerHTMLMathMethod opts of
MathML -> True
_ -> False) metadata
case writerTemplate opts of
Nothing -> return main
Just tpl -> renderTemplate' tpl context
-- | Convert an Element to TEI.
elementToTEI :: PandocMonad m => WriterOptions -> Int -> Element -> m Doc
elementToTEI opts _ (Blk block) = blockToTEI opts block
elementToTEI opts lvl (Sec _ _num attr title elements) = do
-- TEI doesn't allow sections with no content, so insert some if needed
let elements' = if null elements
then [Blk (Para [])]
else elements
-- level numbering correspond to LaTeX internals
divType = case lvl of
n | n == -1 -> "part"
| n == 0 -> "chapter"
| n >= 1 && n <= 5 -> "level" ++ show n
| otherwise -> "section"
contents <- vcat <$> mapM (elementToTEI opts (lvl + 1)) elements'
titleContents <- inlinesToTEI opts title
return $ inTags True "div" (("type", divType) : idFromAttr opts attr) $
inTagsSimple "head" titleContents $$ contents
-- | Convert a list of Pandoc blocks to TEI.
blocksToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
blocksToTEI opts bs = vcat <$> mapM (blockToTEI opts) bs
-- | Auxiliary function to convert Plain block to Para.
plainToPara :: Block -> Block
plainToPara (Plain x) = Para x
plainToPara x = x
-- | Convert a list of pairs of terms and definitions into a TEI
-- list with labels and items.
deflistItemsToTEI :: PandocMonad m
=> WriterOptions -> [([Inline],[[Block]])] -> m Doc
deflistItemsToTEI opts items =
vcat <$> mapM (uncurry (deflistItemToTEI opts)) items
-- | Convert a term and a list of blocks into a TEI varlistentry.
deflistItemToTEI :: PandocMonad m
=> WriterOptions -> [Inline] -> [[Block]] -> m Doc
deflistItemToTEI opts term defs = do
term' <- inlinesToTEI opts term
defs' <- blocksToTEI opts $ concatMap (map plainToPara) defs
return $ inTagsIndented "label" term' $$
inTagsIndented "item" defs'
-- | Convert a list of lists of blocks to a list of TEI list items.
listItemsToTEI :: PandocMonad m => WriterOptions -> [[Block]] -> m Doc
listItemsToTEI opts items = vcat <$> mapM (listItemToTEI opts) items
-- | Convert a list of blocks into a TEI list item.
listItemToTEI :: PandocMonad m => WriterOptions -> [Block] -> m Doc
listItemToTEI opts item =
inTagsIndented "item" <$> blocksToTEI opts (map plainToPara item)
imageToTEI :: PandocMonad m => WriterOptions -> Attr -> String -> m Doc
imageToTEI opts attr src = return $ selfClosingTag "graphic" $
("url", src) : idFromAttr opts attr ++ dims
where
dims = go Width "width" ++ go Height "height"
go dir dstr = case dimension dir attr of
Just a -> [(dstr, show a)]
Nothing -> []
-- | Convert a Pandoc block element to TEI.
blockToTEI :: PandocMonad m => WriterOptions -> Block -> m Doc
blockToTEI _ Null = return empty
-- Add ids to paragraphs in divs with ids - this is needed for
-- pandoc-citeproc to get link anchors in bibliographies:
blockToTEI opts (Div attr [Para lst]) = do
let attribs = idFromAttr opts attr
inTags False "p" attribs <$> inlinesToTEI opts lst
blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs
blockToTEI _ h@Header{} = do
-- should not occur after hierarchicalize, except inside lists/blockquotes
report $ BlockNotRendered h
return empty
-- For TEI simple, text must be within containing block element, so
-- we use treat as Para to ensure that Plain text ends up contained by
-- something:
blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst
-- title beginning with fig: indicates that the image is a figure
--blockToTEI opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) =
-- let alt = inlinesToTEI opts txt
-- capt = if null txt
-- then empty
-- else inTagsSimple "title" alt
-- in inTagsIndented "figure" $
-- capt $$
-- (inTagsIndented "mediaobject" $
-- (inTagsIndented "imageobject"
-- (imageToTEI opts attr src)) $$
-- inTagsSimple "textobject" (inTagsSimple "phrase" alt))
blockToTEI opts (Para lst) =
inTags False "p" [] <$> inlinesToTEI opts lst
blockToTEI opts (LineBlock lns) =
blockToTEI opts $ linesToPara lns
blockToTEI opts (BlockQuote blocks) =
inTagsIndented "quote" <$> blocksToTEI opts blocks
blockToTEI _ (CodeBlock (_,classes,_) str) =
return $ text ("<ab type='codeblock " ++ lang ++ "'>") <> cr <>
flush (text (escapeStringForXML str) <> cr <> text "</ab>")
where lang = if null langs
then ""
else escapeStringForXML (head langs)
isLang l = map toLower l `elem` map (map toLower) languages
langsFrom s = if isLang s
then [s]
else languagesByExtension . map toLower $ s
langs = concatMap langsFrom classes
blockToTEI opts (BulletList lst) = do
let attribs = [("type", "unordered")]
inTags True "list" attribs <$> listItemsToTEI opts lst
blockToTEI _ (OrderedList _ []) = return empty
blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) = do
let attribs = case numstyle of
DefaultStyle -> []
Decimal -> [("type", "ordered:arabic")]
Example -> [("type", "ordered:arabic")]
UpperAlpha -> [("type", "ordered:upperalpha")]
LowerAlpha -> [("type", "ordered:loweralpha")]
UpperRoman -> [("type", "ordered:upperroman")]
LowerRoman -> [("type", "ordered:lowerroman")]
items <- if start == 1
then listItemsToTEI opts (first:rest)
else do
fi <- blocksToTEI opts $ map plainToPara first
re <- listItemsToTEI opts rest
return $ inTags True "item" [("n",show start)] fi $$ re
return $ inTags True "list" attribs items
blockToTEI opts (DefinitionList lst) = do
let attribs = [("type", "definition")]
inTags True "list" attribs <$> deflistItemsToTEI opts lst
blockToTEI _ b@(RawBlock f str)
| f == "tei" = return $ text str
-- raw TEI block (should such a thing exist).
| otherwise = do
report $ BlockNotRendered b
return empty
blockToTEI _ HorizontalRule = return $
selfClosingTag "milestone" [("unit","undefined")
,("type","separator")
,("rendition","line")]
-- | TEI Tables
-- TEI Simple's tables are composed of cells and rows; other
-- table info in the AST is here lossily discard.
blockToTEI opts (Table _ _ _ headers rows) = do
headers' <- tableHeadersToTEI opts headers
rows' <- mapM (tableRowToTEI opts) rows
return $ inTags True "table" [] $ headers' $$ vcat rows'
tableRowToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m Doc
tableRowToTEI opts cols =
(inTagsIndented "row" . vcat) <$> mapM (tableItemToTEI opts) cols
tableHeadersToTEI :: PandocMonad m
=> WriterOptions
-> [[Block]]
-> m Doc
tableHeadersToTEI opts cols =
(inTags True "row" [("role","label")] . vcat) <$>
mapM (tableItemToTEI opts) cols
tableItemToTEI :: PandocMonad m
=> WriterOptions
-> [Block]
-> m Doc
tableItemToTEI opts item =
(inTags False "cell" [] . vcat) <$> mapM (blockToTEI opts) item
-- | Convert a list of inline elements to TEI.
inlinesToTEI :: PandocMonad m => WriterOptions -> [Inline] -> m Doc
inlinesToTEI opts lst = hcat <$> mapM (inlineToTEI opts) lst
-- | Convert an inline element to TEI.
inlineToTEI :: PandocMonad m => WriterOptions -> Inline -> m Doc
inlineToTEI _ (Str str) = return $ text $ escapeStringForXML str
inlineToTEI opts (Emph lst) =
inTags False "hi" [("rendition","simple:italic")] <$> inlinesToTEI opts lst
inlineToTEI opts (Strong lst) =
inTags False "hi" [("rendition", "simple:bold")] <$> inlinesToTEI opts lst
inlineToTEI opts (Strikeout lst) =
inTags False "hi" [("rendition", "simple:strikethrough")] <$>
inlinesToTEI opts lst
inlineToTEI opts (Superscript lst) =
inTags False "hi" [("rendition", "simple:superscript")] <$>
inlinesToTEI opts lst
inlineToTEI opts (Subscript lst) =
inTags False "hi" [("rendition", "simple:subscript")] <$>
inlinesToTEI opts lst
inlineToTEI opts (SmallCaps lst) =
inTags False "hi" [("rendition", "simple:smallcaps")] <$>
inlinesToTEI opts lst
inlineToTEI opts (Quoted _ lst) =
inTagsSimple "quote" <$> inlinesToTEI opts lst
inlineToTEI opts (Cite _ lst) =
inlinesToTEI opts lst
inlineToTEI opts (Span _ ils) =
inlinesToTEI opts ils
inlineToTEI _ (Code _ str) = return $
inTags False "seg" [("type","code")] $ text (escapeStringForXML str)
-- Distinguish display from inline math by wrapping the former in a "figure."
inlineToTEI _ (Math t str) = return $
case t of
InlineMath -> inTags False "formula" [("notation","TeX")] $
text str
DisplayMath -> inTags True "figure" [("type","math")] $
inTags False "formula" [("notation","TeX")] $ text str
inlineToTEI _ il@(RawInline f x) | f == "tei" = return $ text x
| otherwise = empty <$
report (InlineNotRendered il)
inlineToTEI _ LineBreak = return $ selfClosingTag "lb" []
inlineToTEI _ Space =
return space
-- because we use \n for LineBreak, we can't do soft breaks:
inlineToTEI _ SoftBreak =
return space
inlineToTEI opts (Link attr txt (src, _))
| Just email <- stripPrefix "mailto:" src = do
let emailLink = text $
escapeStringForXML email
case txt of
[Str s] | escapeURI s == email ->
return emailLink
_ -> do
linktext <- inlinesToTEI opts txt
return $ linktext <+> char '(' <> emailLink <> char ')'
| otherwise =
(if "#" `isPrefixOf` src
then inTags False "ref" $ ("target", drop 1 src)
: idFromAttr opts attr
else inTags False "ref" $ ("target", src)
: idFromAttr opts attr ) <$>
inlinesToTEI opts txt
inlineToTEI opts (Image attr description (src, tit)) = do
let titleDoc = if null tit
then empty
else inTags False "figDesc" []
(text $ escapeStringForXML tit)
imageDesc <- if null description
then return empty
else inTags False "head" []
<$> inlinesToTEI opts description
img <- imageToTEI opts attr src
return $ inTagsIndented "figure" $ imageDesc $$ img $$ titleDoc
inlineToTEI opts (Note contents) =
inTagsIndented "note" <$> blocksToTEI opts contents
idFromAttr :: WriterOptions -> Attr -> [(String, String)]
idFromAttr opts (id',_,_) =
if null id'
then []
else [("xml:id", writerIdentifierPrefix opts ++ id')]