@@ -32,9 +32,7 @@ module Text.Pandoc.Writers.Docbook (
3232 ) where
3333import Text.Pandoc.Definition
3434import Text.Pandoc.Shared
35−import Text.Pandoc.Writers.HTML ( stringToSmartHtml, stringToHtml )
3635import Text.Pandoc.Entities ( encodeEntities )
37−import Text.Html ( stringToHtmlString )
3836import Text.Regex ( mkRegex, matchRegex )
3937import Data.Char ( toLower, ord )
4038import Data.List ( isPrefixOf, partition )
@@ -54,19 +52,21 @@ hierarchicalize :: [Block] -> [Element]
5452hierarchicalize [] = []
5553hierarchicalize (block:rest) =
5654 case block of
57− (Header level title) -> let (thisSection, rest') = break (headerAtLeast level) rest in
58− (Sec title (hierarchicalize thisSection)):(hierarchicalize rest')
55+ (Header level title) -> let (thisSection, rest') = break (headerAtLeast
56+ level) rest in
57+ (Sec title (hierarchicalize thisSection)):
58+ (hierarchicalize rest')
5959 x -> (Blk x):(hierarchicalize rest)
6060
6161-- | Convert list of authors to a docbook <author> section
6262authorToDocbook :: WriterOptions -> [Char] -> Doc
63−authorToDocbook options name = indentedInTags "author" $
63+authorToDocbook opts name = inTagsIndented opts "author" $
6464 if ',' `elem` name
6565 then -- last name first
6666 let (lastname, rest) = break (==',') name
6767 firstname = removeLeadingSpace rest in
68− inTags "firstname" (text $ stringToXML options firstname) <>
69− inTags "surname" (text $ stringToXML options lastname)
68+ inTagsSimple opts "firstname" (text $ stringToSGML opts firstname) <>
69+ inTagsSimple opts "surname" (text $ stringToSGML opts lastname)
7070 else -- last name last
7171 let namewords = words name
7272 lengthname = length namewords
@@ -74,101 +74,82 @@ authorToDocbook options name = indentedInTags "author" $
7474 0 -> ("","")
7575 1 -> ("", name)
7676 n -> (joinWithSep " " (take (n-1) namewords), last namewords) in
77− inTags "firstname" (text $ stringToXML options firstname) $$
78− inTags "surname" (text $ stringToXML options lastname)
77+ inTagsSimple opts "firstname" (text $ stringToSGML opts firstname) $$
78+ inTagsSimple opts "surname" (text $ stringToSGML opts lastname)
7979
8080-- | Convert Pandoc document to string in Docbook format.
8181writeDocbook :: WriterOptions -> Pandoc -> String
82−writeDocbook options (Pandoc (Meta title authors date) blocks) =
83− let head = if (writerStandalone options)
84− then text (writerHeader options)
82+writeDocbook opts (Pandoc (Meta title authors date) blocks) =
83+ let head = if (writerStandalone opts)
84+ then text (writerHeader opts)
8585 else empty
86− meta = if (writerStandalone options)
87− then indentedInTags "articleinfo" $
88− (inTags "title" (inlinesToDocbook options title)) $$
89− (vcat (map (authorToDocbook options) authors)) $$
90− (inTags "date" (text date))
86+ meta = if (writerStandalone opts)
87+ then inTagsIndented opts "articleinfo" $
88+ (inTagsSimple opts "title" (inlinesToDocbook opts title)) $$
89+ (vcat (map (authorToDocbook opts) authors)) $$
90+ (inTagsSimple opts "date" (text $ stringToSGML opts date))
9191 else empty
9292 blocks' = replaceReferenceLinks blocks
9393 (noteBlocks, blocks'') = partition isNoteBlock blocks'
94− options' = options {writerNotes = noteBlocks}
94+ opts' = opts {writerNotes = noteBlocks}
9595 elements = hierarchicalize blocks''
96− body = text (writerIncludeBefore options') <>
97− vcat (map (elementToDocbook options') elements) $$
98− text (writerIncludeAfter options')
99− body' = if writerStandalone options'
100− then indentedInTags "article" (meta $$ body)
96+ body = text (writerIncludeBefore opts') <>
97+ vcat (map (elementToDocbook opts') elements) $$
98+ text (writerIncludeAfter opts')
99+ body' = if writerStandalone opts'
100+ then inTagsIndented opts "article" (meta $$ body)
101101 else body in
102102 render $ head $$ body' <> text "\n"
103103
104−-- | Put the supplied contents between start and end tags of tagType,
105−-- with specified attributes.
106−inTagsWithAttrib :: String -> [(String, String)] -> Doc -> Doc
107−inTagsWithAttrib tagType attribs contents = text ("<" ++ tagType ++
108− (concatMap (\(a, b) -> " " ++ attributeStringToXML a ++
109− "=\"" ++ attributeStringToXML b ++ "\"") attribs)) <>
110− if isEmpty contents
111− then text " />" -- self-closing tag
112− else text ">" <> contents <> text ("</" ++ tagType ++ ">")
113−
114−-- | Put the supplied contents between start and end tags of tagType.
115−inTags :: String -> Doc -> Doc
116−inTags tagType contents = inTagsWithAttrib tagType [] contents
117−
118−-- | Put the supplied contents in indented block btw start and end tags.
119−indentedInTags :: [Char] -> Doc -> Doc
120−indentedInTags tagType contents = text ("<" ++ tagType ++ ">") $$
121− nest 2 contents $$ text ("</" ++ tagType ++ ">")
122−
123104-- | Convert an Element to Docbook.
124105elementToDocbook :: WriterOptions -> Element -> Doc
125−elementToDocbook options (Blk block) = blockToDocbook options block
126−elementToDocbook options (Sec title elements) =
106+elementToDocbook opts (Blk block) = blockToDocbook opts block
107+elementToDocbook opts (Sec title elements) =
127108 -- Docbook doesn't allow sections with no content, so insert some if needed
128109 let elements' = if null elements
129110 then [Blk (Para [])]
130111 else elements in
131− indentedInTags "section" $
132− inTags "title" (wrap options title) $$
133− vcat (map (elementToDocbook options) elements')
112+ inTagsIndented opts "section" $
113+ inTagsSimple opts "title" (wrap opts title) $$
114+ vcat (map (elementToDocbook opts) elements')
134115
135116-- | Convert a list of Pandoc blocks to Docbook.
136117blocksToDocbook :: WriterOptions -> [Block] -> Doc
137−blocksToDocbook options = vcat . map (blockToDocbook options)
118+blocksToDocbook opts = vcat . map (blockToDocbook opts)
138119
139120-- | Convert a list of lists of blocks to a list of Docbook list items.
140121listItemsToDocbook :: WriterOptions -> [[Block]] -> Doc
141−listItemsToDocbook options items =
142− vcat $ map (listItemToDocbook options) items
122+listItemsToDocbook opts items =
123+ vcat $ map (listItemToDocbook opts) items
143124
144125-- | Convert a list of blocks into a Docbook list item.
145126listItemToDocbook :: WriterOptions -> [Block] -> Doc
146−listItemToDocbook options item =
127+listItemToDocbook opts item =
147128 let plainToPara (Plain x) = Para x
148129 plainToPara y = y in
149130 let item' = map plainToPara item in
150− indentedInTags "listitem" (blocksToDocbook options item')
131+ inTagsIndented opts "listitem" (blocksToDocbook opts item')
151132
152133-- | Convert a Pandoc block element to Docbook.
153134blockToDocbook :: WriterOptions -> Block -> Doc
154−blockToDocbook options Blank = text ""
155−blockToDocbook options Null = empty
156−blockToDocbook options (Plain lst) = wrap options lst
157−blockToDocbook options (Para lst) =
158− indentedInTags "para" (wrap options lst)
159−blockToDocbook options (BlockQuote blocks) =
160− indentedInTags "blockquote" (blocksToDocbook options blocks)
161−blockToDocbook options (CodeBlock str) =
162− text "<screen>\n" <> text (codeStringToXML str) <> text "\n</screen>"
163−blockToDocbook options (BulletList lst) =
164− indentedInTags "itemizedlist" $ listItemsToDocbook options lst
165−blockToDocbook options (OrderedList lst) =
166− indentedInTags "orderedlist" $ listItemsToDocbook options lst
167−blockToDocbook options (RawHtml str) = text str -- raw XML block
168−blockToDocbook options HorizontalRule = empty -- not semantic
169−blockToDocbook options (Note _ _) = empty -- shouldn't occur
170−blockToDocbook options (Key _ _) = empty -- shouldn't occur
171−blockToDocbook options _ = indentedInTags "para" (text "Unknown block type")
135+blockToDocbook opts Blank = text ""
136+blockToDocbook opts Null = empty
137+blockToDocbook opts (Plain lst) = wrap opts lst
138+blockToDocbook opts (Para lst) =
139+ inTagsIndented opts "para" (wrap opts lst)
140+blockToDocbook opts (BlockQuote blocks) =
141+ inTagsIndented opts "blockquote" (blocksToDocbook opts blocks)
142+blockToDocbook opts (CodeBlock str) =
143+ text "<screen>\n" <> text (escapeSGML str) <> text "\n</screen>"
144+blockToDocbook opts (BulletList lst) =
145+ inTagsIndented opts "itemizedlist" $ listItemsToDocbook opts lst
146+blockToDocbook opts (OrderedList lst) =
147+ inTagsIndented opts "orderedlist" $ listItemsToDocbook opts lst
148+blockToDocbook opts (RawHtml str) = text str -- raw XML block
149+blockToDocbook opts HorizontalRule = empty -- not semantic
150+blockToDocbook opts (Note _ _) = empty -- shouldn't occur
151+blockToDocbook opts (Key _ _) = empty -- shouldn't occur
152+blockToDocbook opts _ = inTagsIndented opts "para" (text "Unknown block type")
172153
173154-- | Put string in CDATA section
174155cdata :: String -> Doc
@@ -176,62 +157,47 @@ cdata str = text $ "<![CDATA[" ++ str ++ "]]>"
176157
177158-- | Take list of inline elements and return wrapped doc.
178159wrap :: WriterOptions -> [Inline] -> Doc
179−wrap options lst = fsep $ map (inlinesToDocbook options) (splitBy Space lst)
180−
181−-- | Escape a string for XML (with "smart" option if specified).
182−stringToXML :: WriterOptions -> String -> String
183−stringToXML options = encodeEntities .
184− (if writerSmart options
185− then stringToSmartHtml
186− else stringToHtml)
187−
188−-- | Escape string to XML appropriate for attributes
189−attributeStringToXML :: String -> String
190−attributeStringToXML = gsub "\"" """ . codeStringToXML
191−
192−-- | Escape a literal string for XML.
193−codeStringToXML :: String -> String
194−codeStringToXML = encodeEntities . gsub "<" "<" . gsub "&" "&"
160+wrap opts lst = fsep $ map (inlinesToDocbook opts) (splitBy Space lst)
195161
196162-- | Convert a list of inline elements to Docbook.
197163inlinesToDocbook :: WriterOptions -> [Inline] -> Doc
198−inlinesToDocbook options lst = hcat (map (inlineToDocbook options) lst)
164+inlinesToDocbook opts lst = hcat (map (inlineToDocbook opts) lst)
199165
200166-- | Convert an inline element to Docbook.
201167inlineToDocbook :: WriterOptions -> Inline -> Doc
202−inlineToDocbook options (Str str) = text $ stringToXML options str
203−inlineToDocbook options (Emph lst) =
204− inTags "emphasis" (inlinesToDocbook options lst)
205−inlineToDocbook options (Strong lst) =
206− inTagsWithAttrib "emphasis" [("role", "strong")]
207− (inlinesToDocbook options lst)
208−inlineToDocbook options (Code str) =
209− inTags "literal" $ text (codeStringToXML str)
210−inlineToDocbook options (TeX str) = inlineToDocbook options (Code str)
211−inlineToDocbook options (HtmlInline str) = empty
212−inlineToDocbook options LineBreak =
168+inlineToDocbook opts (Str str) = text $ stringToSGML opts str
169+inlineToDocbook opts (Emph lst) =
170+ inTagsSimple opts "emphasis" (inlinesToDocbook opts lst)
171+inlineToDocbook opts (Strong lst) =
172+ inTags False opts "emphasis" [("role", "strong")]
173+ (inlinesToDocbook opts lst)
174+inlineToDocbook opts (Code str) =
175+ inTagsSimple opts "literal" $ text (escapeSGML str)
176+inlineToDocbook opts (TeX str) = inlineToDocbook opts (Code str)
177+inlineToDocbook opts (HtmlInline str) = empty
178+inlineToDocbook opts LineBreak =
213179 text $ "<literallayout></literallayout>"
214−inlineToDocbook options Space = char ' '
215−inlineToDocbook options (Link txt (Src src tit)) =
180+inlineToDocbook opts Space = char ' '
181+inlineToDocbook opts (Link txt (Src src tit)) =
216182 case (matchRegex (mkRegex "mailto:(.*)") src) of
217− Just [addr] -> inTags "email" $ text (codeStringToXML addr)
218− Nothing -> inTagsWithAttrib "ulink" [("url", src)] $
219− inlinesToDocbook options txt
220−inlineToDocbook options (Link text (Ref ref)) = empty -- shouldn't occur
221−inlineToDocbook options (Image alt (Src src tit)) =
183+ Just [addr] -> inTagsSimple opts "email" $ text (escapeSGML addr)
184+ Nothing -> inTags False opts "ulink" [("url", src)] $
185+ inlinesToDocbook opts txt
186+inlineToDocbook opts (Link text (Ref ref)) = empty -- shouldn't occur
187+inlineToDocbook opts (Image alt (Src src tit)) =
222188 let titleDoc = if null tit
223189 then empty
224− else indentedInTags "objectinfo" $
225− indentedInTags "title"
226− (text $ stringToXML options tit) in
227− indentedInTags "inlinemediaobject" $
228− indentedInTags "imageobject" $
229− titleDoc $$ inTagsWithAttrib "imagedata" [("fileref", src)] empty
230−inlineToDocbook options (Image alternate (Ref ref)) = empty --shouldn't occur
231−inlineToDocbook options (NoteRef ref) =
232− let notes = writerNotes options
190+ else inTagsIndented opts "objectinfo" $
191+ inTagsIndented opts "title"
192+ (text $ stringToSGML opts tit) in
193+ inTagsIndented opts "inlinemediaobject" $
194+ inTagsIndented opts "imageobject" $
195+ titleDoc $$ selfClosingTag opts "imagedata" [("fileref", src)]
196+inlineToDocbook opts (Image alternate (Ref ref)) = empty --shouldn't occur
197+inlineToDocbook opts (NoteRef ref) =
198+ let notes = writerNotes opts
233199 hits = filter (\(Note r _) -> r == ref) notes in
234200 if null hits
235201 then empty
236202 else let (Note _ contents) = head hits in
237− indentedInTags "footnote" $ blocksToDocbook options contents
203+ inTagsIndented opts "footnote" $ blocksToDocbook opts contents