git.iko.soy/typeable/pandoc
on master help sign in
Merge pull request #6922 from jtojnar/db-writer-admonitions
810df00John MacFarlane
src/Text/Pandoc/Writers/Docbook.hs+45−19
compare with master
unifiedsplit
@@ -53,6 +53,13 @@ getStartLvl opts =
53 TopLevelSection -> 1
53 TopLevelSection -> 1
54 TopLevelDefault -> 1
54 TopLevelDefault -> 1
55
55
56+-- | Get correct name for the id attribute based on DocBook version.
57+-- DocBook 4 used custom id attribute but DocBook 5 adopted the xml:id specification.
58+-- https://www.w3.org/TR/xml-id/
59+idName :: DocBookVersion -> Text
60+idName DocBook5 = "xml:id"
61+idName DocBook4 = "id"
62+
56-- | Convert list of authors to a docbook <author> section
63-- | Convert list of authors to a docbook <author> section
57authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
64authorToDocbook :: PandocMonad m => WriterOptions -> [Inline] -> DB m B.Inlines
58authorToDocbook opts name' = do
65authorToDocbook opts name' = do
@@ -174,10 +181,7 @@ blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
174 then "section"
181 then "section"
175 else "sect" <> tshow n
182 else "sect" <> tshow n
176 _ -> "simplesect"
183 _ -> "simplesect"
177− idName = if version == DocBook5
178− then "xml:id"
179− else "id"
180− idAttr = [(idName, writerIdentifierPrefix opts <> id') | not (T.null id')]
184+ idAttr = [(idName version, writerIdentifierPrefix opts <> id') | not (T.null id')]
181 -- We want to add namespaces to the root (top-level) element.
185 -- We want to add namespaces to the root (top-level) element.
182 nsAttr = if version == DocBook5 && lvl == getStartLvl opts && isNothing (writerTemplate opts)
186 nsAttr = if version == DocBook5 && lvl == getStartLvl opts && isNothing (writerTemplate opts)
183 -- Though, DocBook 4 does not support namespaces and
187 -- Though, DocBook 4 does not support namespaces and
@@ -188,18 +192,39 @@ blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
188 title' <- inlinesToDocbook opts ils
192 title' <- inlinesToDocbook opts ils
189 contents <- blocksToDocbook opts bs
193 contents <- blocksToDocbook opts bs
190 return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
194 return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
191−blockToDocbook opts (Div (ident,_,_) [Para lst]) =
195+blockToDocbook opts (Div (ident,classes,_) bs) = do
196+ version <- ask
192− let attribs = [("id", ident) | not (T.null ident)] in
197+ let identAttribs = [(idName version, ident) | not (T.null ident)]
198+ admonitions = ["attention","caution","danger","error","hint",
199+ "important","note","tip","warning"]
200+ case classes of
201+ (l:_) | l `elem` admonitions -> do
202+ let (mTitleBs, bodyBs) =
203+ case bs of
204+ -- Matches AST produced by the DocBook reader → Markdown writer → Markdown reader chain.
205+ (Div (_,["title"],_) [Para ts] : rest) -> (Just (inlinesToDocbook opts ts), rest)
206+ -- Matches AST produced by the Docbook reader.
207+ (Div (_,["title"],_) ts : rest) -> (Just (blocksToDocbook opts ts), rest)
208+ _ -> (Nothing, bs)
209+ admonitionTitle <- case mTitleBs of
210+ Nothing -> return mempty
211+ -- id will be attached to the admonition so let’s pass empty identAttrs.
212+ Just titleBs -> inTags False "title" [] <$> titleBs
213+ admonitionBody <- handleDivBody [] bodyBs
214+ return (inTags True l identAttribs (admonitionTitle $$ admonitionBody))
215+ _ -> handleDivBody identAttribs bs
216+ where
217+ handleDivBody identAttribs [Para lst] =
193− if hasLineBreaks lst
218+ if hasLineBreaks lst
194− then flush . nowrap . inTags False "literallayout" attribs
219+ then flush . nowrap . inTags False "literallayout" identAttribs
195− <$> inlinesToDocbook opts lst
220+ <$> inlinesToDocbook opts lst
196− else inTags True "para" attribs <$> inlinesToDocbook opts lst
221+ else inTags True "para" identAttribs <$> inlinesToDocbook opts lst
197−blockToDocbook opts (Div (ident,_,_) bs) = do
222+ handleDivBody identAttribs bodyBs = do
198− contents <- blocksToDocbook opts (map plainToPara bs)
223+ contents <- blocksToDocbook opts (map plainToPara bodyBs)
199− return $
224+ return $
200− (if T.null ident
225+ (if null identAttribs
201− then mempty
226+ then mempty
202− else selfClosingTag "anchor" [("id", ident)]) $$ contents
227+ else selfClosingTag "anchor" identAttribs) $$ contents
203blockToDocbook _ h@Header{} = do
228blockToDocbook _ h@Header{} = do
204 -- should be handled by Div section above, except inside lists/blockquotes
229 -- should be handled by Div section above, except inside lists/blockquotes
205 report $ BlockNotRendered h
230 report $ BlockNotRendered h
@@ -353,11 +378,12 @@ inlineToDocbook opts (Quoted _ lst) =
353 inTagsSimple "quote" <$> inlinesToDocbook opts lst
378 inTagsSimple "quote" <$> inlinesToDocbook opts lst
354inlineToDocbook opts (Cite _ lst) =
379inlineToDocbook opts (Cite _ lst) =
355 inlinesToDocbook opts lst
380 inlinesToDocbook opts lst
356−inlineToDocbook opts (Span (ident,_,_) ils) =
381+inlineToDocbook opts (Span (ident,_,_) ils) = do
382+ version <- ask
357 ((if T.null ident
383 ((if T.null ident
358 then mempty
384 then mempty
359− else selfClosingTag "anchor" [("id", ident)]) <>) <$>
385+ else selfClosingTag "anchor" [(idName version, ident)]) <>) <$>
360− inlinesToDocbook opts ils
386+ inlinesToDocbook opts ils
361inlineToDocbook _ (Code _ str) =
387inlineToDocbook _ (Code _ str) =
362 return $ inTagsSimple "literal" $ literal (escapeStringForXML str)
388 return $ inTagsSimple "literal" $ literal (escapeStringForXML str)
363inlineToDocbook opts (Math t str)
389inlineToDocbook opts (Math t str)
test/Tests/Writers/Docbook.hs+66
@@ -70,6 +70,72 @@ tests = [ testGroup "line blocks"
70 , "</para>" ]
70 , "</para>" ]
71 )
71 )
72 ]
72 ]
73+ , testGroup "divs"
74+ [ "admonition" =: divWith ("foo", ["warning"], []) (para "This is a test")
75+ =?> unlines
76+ [ "<warning id=\"foo\">"
77+ , " <para>"
78+ , " This is a test"
79+ , " </para>"
80+ , "</warning>"
81+ ]
82+ , "admonition-with-title" =:
83+ divWith ("foo", ["attention"], []) (
84+ divWith ("foo", ["title"], [])
85+ (plain (text "This is title")) <>
86+ para "This is a test"
87+ )
88+ =?> unlines
89+ [ "<attention id=\"foo\">"
90+ , " <title>This is title</title>"
91+ , " <para>"
92+ , " This is a test"
93+ , " </para>"
94+ , "</attention>"
95+ ]
96+ , "admonition-with-title-in-para" =:
97+ divWith ("foo", ["attention"], []) (
98+ divWith ("foo", ["title"], [])
99+ (para "This is title") <>
100+ para "This is a test"
101+ )
102+ =?> unlines
103+ [ "<attention id=\"foo\">"
104+ , " <title>This is title</title>"
105+ , " <para>"
106+ , " This is a test"
107+ , " </para>"
108+ , "</attention>"
109+ ]
110+ , "single-child" =:
111+ divWith ("foo", [], []) (para "This is a test")
112+ =?> unlines
113+ [ "<para id=\"foo\">"
114+ , " This is a test"
115+ , "</para>"
116+ ]
117+ , "single-literal-child" =:
118+ divWith ("foo", [], []) lineblock
119+ =?> unlines
120+ [ "<literallayout id=\"foo\">some text"
121+ , "and more lines"
122+ , "and again</literallayout>"
123+ ]
124+ , "multiple-children" =:
125+ divWith ("foo", [], []) (
126+ para "This is a test" <>
127+ para "This is an another test"
128+ )
129+ =?> unlines
130+ [ "<anchor id=\"foo\" />"
131+ , "<para>"
132+ , " This is a test"
133+ , "</para>"
134+ , "<para>"
135+ , " This is an another test"
136+ , "</para>"
137+ ]
138+ ]
73 , testGroup "compact lists"
139 , testGroup "compact lists"
74 [ testGroup "bullet"
140 [ testGroup "bullet"
75 [ "compact" =: bulletList [plain "a", plain "b", plain "c"]
141 [ "compact" =: bulletList [plain "a", plain "b", plain "c"]