@@ -0,0 +1,320 @@
1+{-# LANGUAGE OverloadedStrings, PatternGuards #-}
2+{-
3+Copyright (C) 2006-2015 John MacFarlane <jgm@berkeley.edu>
4+
5+This program is free software; you can redistribute it and/or modify
6+it under the terms of the GNU General Public License as published by
7+the Free Software Foundation; either version 2 of the License, or
8+(at your option) any later version.
9+
10+This program is distributed in the hope that it will be useful,
11+but WITHOUT ANY WARRANTY; without even the implied warranty of
12+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+GNU General Public License for more details.
14+
15+You should have received a copy of the GNU General Public License
16+along with this program; if not, write to the Free Software
17+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
18+-}
19+
20+{- |
21+ Module : Text.Pandoc.Writers.Docbook
22+ Copyright : Copyright (C) 2006-2015 John MacFarlane
23+ License : GNU GPL, version 2 or above
24+
25+ Maintainer : John MacFarlane <jgm@berkeley.edu>
26+ Stability : alpha
27+ Portability : portable
28+
29+Conversion of 'Pandoc' documents to Docbook XML.
30+-}
31+module Text.Pandoc.Writers.TEI (writeTEI) where
32+import Text.Pandoc.Definition
33+import Text.Pandoc.XML
34+import Text.Pandoc.Shared
35+import Text.Pandoc.Writers.Shared
36+import Text.Pandoc.Options
37+import Text.Pandoc.Templates (renderTemplate')
38+import Data.List ( stripPrefix, isPrefixOf, isSuffixOf )
39+import Data.Char ( toLower )
40+import Text.Pandoc.Highlighting ( languages, languagesByExtension )
41+import Text.Pandoc.Pretty
42+import Text.Pandoc.ImageSize
43+import qualified Text.Pandoc.Builder as B
44+
45+-- | Convert list of authors to a docbook <author> section
46+authorToTEI :: WriterOptions -> [Inline] -> B.Inlines
47+authorToTEI opts name' =
48+ let name = render Nothing $ inlinesToTEI opts name'
49+ colwidth = if writerWrapText opts == WrapAuto
50+ then Just $ writerColumns opts
51+ else Nothing
52+ in B.rawInline "tei" $ render colwidth $
53+ inTagsSimple "author" (text $ escapeStringForXML name)
54+
55+-- | Convert Pandoc document to string in Docbook format.
56+writeTEI :: WriterOptions -> Pandoc -> String
57+writeTEI opts (Pandoc meta blocks) =
58+ let elements = hierarchicalize blocks
59+ colwidth = if writerWrapText opts == WrapAuto
60+ then Just $ writerColumns opts
61+ else Nothing
62+ render' = render colwidth
63+ opts' = if "/book>" `isSuffixOf`
64+ (trimr $ writerTemplate opts)
65+ then opts{ writerChapters = True }
66+ else opts
67+ startLvl = if writerChapters opts' then 0 else 1
68+ auths' = map (authorToTEI opts) $ docAuthors meta
69+ meta' = B.setMeta "author" auths' meta
70+ Just metadata = metaToJSON opts
71+ (Just . render colwidth . (vcat .
72+ (map (elementToTEI opts' startLvl)) . hierarchicalize))
73+ (Just . render colwidth . inlinesToTEI opts')
74+ meta'
75+ main = render' $ vcat (map (elementToTEI opts' startLvl) elements)
76+ context = defField "body" main
77+ $ defField "mathml" (case writerHTMLMathMethod opts of
78+ MathML _ -> True
79+ _ -> False)
80+ $ metadata
81+ in if writerStandalone opts
82+ then renderTemplate' (writerTemplate opts) context
83+ else main
84+
85+-- | Convert an Element to TEI.
86+elementToTEI :: WriterOptions -> Int -> Element -> Doc
87+elementToTEI opts _ (Blk block) = blockToTEI opts block
88+elementToTEI opts lvl (Sec _ _num (id',_,_) title elements) =
89+ -- TEI doesn't allow sections with no content, so insert some if needed
90+ let elements' = if null elements
91+ then [Blk (Para [])]
92+ else elements
93+ divType = case lvl of
94+ n | n == 0 -> "chapter"
95+ | n >= 1 && n <= 5 -> "sect" ++ show n
96+ | otherwise -> "simplesect"
97+ in inTags True "div" [("type", divType) | not (null id')] $
98+-- ("id", writerIdentifierPrefix opts ++ id') | not (null id')] $
99+ inTagsSimple "head" (inlinesToTEI opts title) $$
100+ vcat (map (elementToTEI opts (lvl + 1)) elements')
101+
102+-- | Convert a list of Pandoc blocks to TEI.
103+blocksToTEI :: WriterOptions -> [Block] -> Doc
104+blocksToTEI opts = vcat . map (blockToTEI opts)
105+
106+-- | Auxiliary function to convert Plain block to Para.
107+plainToPara :: Block -> Block
108+plainToPara (Plain x) = Para x
109+plainToPara x = x
110+
111+-- | Convert a list of pairs of terms and definitions into a TEI
112+-- list with labels and items.
113+deflistItemsToTEI :: WriterOptions -> [([Inline],[[Block]])] -> Doc
114+deflistItemsToTEI opts items =
115+ vcat $ map (\(term, defs) -> deflistItemToTEI opts term defs) items
116+
117+-- | Convert a term and a list of blocks into a TEI varlistentry.
118+deflistItemToTEI :: WriterOptions -> [Inline] -> [[Block]] -> Doc
119+deflistItemToTEI opts term defs =
120+ let def' = concatMap (map plainToPara) defs
121+ in inTagsIndented "label" (inlinesToTEI opts term) $$
122+ inTagsIndented "item" (blocksToTEI opts def')
123+
124+-- | Convert a list of lists of blocks to a list of TEI list items.
125+listItemsToTEI :: WriterOptions -> [[Block]] -> Doc
126+listItemsToTEI opts items = vcat $ map (listItemToTEI opts) items
127+
128+-- | Convert a list of blocks into a TEI list item.
129+listItemToTEI :: WriterOptions -> [Block] -> Doc
130+listItemToTEI opts item =
131+ inTagsIndented "item" $ blocksToTEI opts $ map plainToPara item
132+
133+imageToTEI :: WriterOptions -> Attr -> String -> Doc
134+imageToTEI _ attr src = selfClosingTag "graphic" $
135+ ("url", src) : idAndRole attr ++ dims
136+ where
137+ dims = go Width "width" ++ go Height "depth"
138+ go dir dstr = case (dimension dir attr) of
139+ Just a -> [(dstr, show a)]
140+ Nothing -> []
141+
142+-- | Convert a Pandoc block element to TEI.
143+blockToTEI :: WriterOptions -> Block -> Doc
144+blockToTEI _ Null = empty
145+-- Add ids to paragraphs in divs with ids - this is needed for
146+-- pandoc-citeproc to get link anchors in bibliographies:
147+blockToTEI opts (Div (ident,_,_) [Para lst]) =
148+ let attribs = [("id", ident) | not (null ident)] in
149+ inTags False "p" attribs $ inlinesToTEI opts lst
150+blockToTEI opts (Div _ bs) = blocksToTEI opts $ map plainToPara bs
151+blockToTEI _ (Header _ _ _) = empty -- should not occur after hierarchicalize
152+-- For TEI simple, text must be within containing block element, so
153+-- we use plainToPara to ensure that Plain text ends up contained by
154+-- something.
155+blockToTEI opts (Plain lst) = blockToTEI opts $ Para lst
156+-- title beginning with fig: indicates that the image is a figure
157+--blockToTEI opts (Para [Image attr txt (src,'f':'i':'g':':':_)]) =
158+-- let alt = inlinesToTEI opts txt
159+-- capt = if null txt
160+-- then empty
161+-- else inTagsSimple "title" alt
162+-- in inTagsIndented "figure" $
163+-- capt $$
164+-- (inTagsIndented "mediaobject" $
165+-- (inTagsIndented "imageobject"
166+-- (imageToTEI opts attr src)) $$
167+-- inTagsSimple "textobject" (inTagsSimple "phrase" alt))
168+blockToTEI opts (Para lst) =
169+ inTags False "p" [] $ inlinesToTEI opts lst
170+blockToTEI opts (BlockQuote blocks) =
171+ inTagsIndented "quote" $ blocksToTEI opts blocks
172+blockToTEI _ (CodeBlock (_,classes,_) str) =
173+ text ("<ab type='codeblock " ++ lang ++ "'>") <> cr <>
174+ flush (text (escapeStringForXML str) <> cr <> text "</ab>")
175+ where lang = if null langs
176+ then ""
177+ else escapeStringForXML (head langs)
178+ isLang l = map toLower l `elem` map (map toLower) languages
179+ langsFrom s = if isLang s
180+ then [s]
181+ else languagesByExtension . map toLower $ s
182+ langs = concatMap langsFrom classes
183+blockToTEI opts (BulletList lst) =
184+ let attribs = [("type", "bullet") | isTightList lst]
185+ in inTags True "list" attribs $ listItemsToTEI opts lst
186+blockToTEI _ (OrderedList _ []) = empty
187+blockToTEI opts (OrderedList (start, numstyle, _) (first:rest)) =
188+ let attribs = case numstyle of
189+ DefaultStyle -> []
190+ Decimal -> [("type", "ordered:arabic")]
191+ Example -> [("type", "ordered:arabic")]
192+ UpperAlpha -> [("type", "ordered:upperalpha")]
193+ LowerAlpha -> [("type", "ordered:loweralpha")]
194+ UpperRoman -> [("type", "ordered:upperroman")]
195+ LowerRoman -> [("type", "ordered:lowerroman")]
196+ items = if start == 1
197+ then listItemsToTEI opts (first:rest)
198+ else (inTags True "item" [("n",show start)]
199+ (blocksToTEI opts $ map plainToPara first)) $$
200+ listItemsToTEI opts rest
201+ in inTags True "list" attribs items
202+blockToTEI opts (DefinitionList lst) =
203+ let attribs = [("type", "definition")]
204+ in inTags True "list" attribs $ deflistItemsToTEI opts lst
205+blockToTEI _ (RawBlock f str)
206+ | f == "tei" = text str -- raw TEI block (should such a thing exist).
207+-- | f == "html" = text str -- allow html for backwards compatibility
208+ | otherwise = empty
209+blockToTEI _ HorizontalRule =
210+ selfClosingTag "milestone" [("unit","undefined"), ("type","separator"),("rendition","line")]
211+
212+-- | TEI Tables
213+-- TEI Simple's tables are composed of cells and rows; other
214+-- table info in the AST is here lossily discard.
215+blockToTEI opts (Table _ _ _ headers rows) =
216+ let
217+ headers' = tableHeadersToTEI opts headers
218+-- headers' = if all null headers
219+-- then return empty
220+-- else tableRowToTEI opts headers
221+ in
222+ inTags True "table" [] $
223+ vcat $ [headers'] <> map (tableRowToTEI opts) rows
224+
225+tableRowToTEI :: WriterOptions
226+ -> [[Block]]
227+ -> Doc
228+tableRowToTEI opts cols =
229+ inTagsIndented "row" $ vcat $ map (tableItemToTEI opts) cols
230+
231+tableHeadersToTEI :: WriterOptions
232+ -> [[Block]]
233+ -> Doc
234+tableHeadersToTEI opts cols =
235+ inTags True "row" [("role","label")] $ vcat $ map (tableItemToTEI opts) cols
236+
237+tableItemToTEI :: WriterOptions
238+ -> [Block]
239+ -> Doc
240+tableItemToTEI opts item =
241+ inTags False "cell" [] $ vcat $ map (blockToTEI opts) item
242+
243+-- | Convert a list of inline elements to TEI.
244+inlinesToTEI :: WriterOptions -> [Inline] -> Doc
245+inlinesToTEI opts lst = hcat $ map (inlineToTEI opts) lst
246+
247+-- | Convert an inline element to TEI.
248+inlineToTEI :: WriterOptions -> Inline -> Doc
249+inlineToTEI _ (Str str) = text $ escapeStringForXML str
250+inlineToTEI opts (Emph lst) =
251+ inTags False "hi" [("rendition","simple:italic")] $ inlinesToTEI opts lst
252+inlineToTEI opts (Strong lst) =
253+ inTags False "hi" [("rendition", "simple:bold")] $ inlinesToTEI opts lst
254+inlineToTEI opts (Strikeout lst) =
255+ inTags False "hi" [("rendition", "simple:strikethrough")] $
256+ inlinesToTEI opts lst
257+inlineToTEI opts (Superscript lst) =
258+ inTags False "hi" [("rendition", "simple:superscript")] $ inlinesToTEI opts lst
259+inlineToTEI opts (Subscript lst) =
260+ inTags False "hi" [("rendition", "simple:subscript")] $ inlinesToTEI opts lst
261+inlineToTEI opts (SmallCaps lst) =
262+ inTags False "hi" [("rendition", "simple:smallcaps")] $
263+ inlinesToTEI opts lst
264+inlineToTEI opts (Quoted _ lst) =
265+ inTagsSimple "quote" $ inlinesToTEI opts lst
266+inlineToTEI opts (Cite _ lst) =
267+ inlinesToTEI opts lst
268+inlineToTEI opts (Span _ ils) =
269+ inlinesToTEI opts ils
270+inlineToTEI _ (Code _ str) =
271+ inTags False "seg" [("type","code")] $ text (escapeStringForXML str)
272+-- Distinguish display from inline math by wrapping the former in a "figure."
273+inlineToTEI _ (Math t str) =
274+ case t of
275+ InlineMath -> inTags False "formula" [("notation","TeX")] $
276+ text (str)
277+ DisplayMath -> inTags True "figure" [("type","math")] $
278+ inTags False "formula" [("notation","TeX")] $ text (str)
279+
280+inlineToTEI _ (RawInline f x) | f == "html" || f == "tei" = text x
281+ | otherwise = empty
282+inlineToTEI _ LineBreak = text ""
283+inlineToTEI _ Space = space
284+-- because we use \n for LineBreak, we can't do soft breaks:
285+inlineToTEI _ SoftBreak = space
286+inlineToTEI opts (Link attr txt (src, _))
287+ | Just email <- stripPrefix "mailto:" src =
288+ let emailLink = text $
289+ escapeStringForXML $ email
290+ in case txt of
291+ [Str s] | escapeURI s == email -> emailLink
292+ _ -> inlinesToTEI opts txt <+>
293+ char '(' <> emailLink <> char ')'
294+ | otherwise =
295+ (if isPrefixOf "#" src
296+ then inTags False "ref" $ ("target", drop 1 src) : idAndRole attr
297+ else inTags False "ref" $ ("target", src) : idAndRole attr ) $
298+ inlinesToTEI opts txt
299+inlineToTEI opts (Image attr description (src, tit)) =
300+ let titleDoc = if null tit
301+ then empty
302+ else inTags False "figDesc" [] (text $ escapeStringForXML tit)
303+ imageDesc = if null description
304+ then empty
305+ else inTags False "head" [] (inlinesToTEI opts description)
306+ in inTagsIndented "figure" $ imageDesc $$
307+ imageToTEI opts attr src $$ titleDoc
308+inlineToTEI opts (Note contents) =
309+ inTagsIndented "note" $ blocksToTEI opts contents
310+
311+idAndRole :: Attr -> [(String, String)]
312+idAndRole (id',cls,_) = ident ++ role
313+ where
314+ ident = if null id'
315+ then []
316+ else [("id", id')]
317+ role = if null cls
318+ then []
319+ else [("role", unwords cls)]
320+