git.iko.soy/typeable/pandoc
on master help sign in
Docbook writer: handle admonitions
dc68565Jan Tojnar
src/Text/Pandoc/Writers/Docbook.hs+30−12
compare with master
unifiedsplit
@@ -188,18 +188,36 @@ blockToDocbook opts (Div (id',"section":_,_) (Header lvl _ ils : xs)) = do
188 title' <- inlinesToDocbook opts ils
188 title' <- inlinesToDocbook opts ils
189 contents <- blocksToDocbook opts bs
189 contents <- blocksToDocbook opts bs
190 return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
190 return $ inTags True tag attribs $ inTagsSimple "title" title' $$ contents
191−blockToDocbook opts (Div (ident,_,_) [Para lst]) =
191+blockToDocbook opts (Div (ident,classes,_) bs) =
192− let attribs = [("id", ident) | not (T.null ident)] in
192+ let identAttribs = [("id", ident) | not (T.null ident)]
193+ admonitions = ["attention","caution","danger","error","hint",
194+ "important","note","tip","warning"]
195+ in case classes of
196+ (l:_) | l `elem` admonitions -> do
197+ let (mTitleBs, bodyBs) =
198+ case bs of
199+ -- Matches AST produced by the Docbook reader.
200+ (Div (_,["title"],_) ts : rest) -> (Just (blocksToDocbook opts ts), rest)
201+ _ -> (Nothing, bs)
202+ admonitionTitle <- case mTitleBs of
203+ Nothing -> return mempty
204+ -- id will be attached to the admonition so let’s pass empty identAttrs.
205+ Just titleBs -> inTags False "title" [] <$> titleBs
206+ admonitionBody <- handleDivBody [] bodyBs
207+ return (inTags True l identAttribs (admonitionTitle $$ admonitionBody))
208+ _ -> handleDivBody identAttribs bs
209+ where
210+ handleDivBody identAttribs [Para lst] =
193− if hasLineBreaks lst
211+ if hasLineBreaks lst
194− then flush . nowrap . inTags False "literallayout" attribs
212+ then flush . nowrap . inTags False "literallayout" identAttribs
195− <$> inlinesToDocbook opts lst
213+ <$> inlinesToDocbook opts lst
196− else inTags True "para" attribs <$> inlinesToDocbook opts lst
214+ else inTags True "para" identAttribs <$> inlinesToDocbook opts lst
197−blockToDocbook opts (Div (ident,_,_) bs) = do
215+ handleDivBody identAttribs bodyBs = do
198− contents <- blocksToDocbook opts (map plainToPara bs)
216+ contents <- blocksToDocbook opts (map plainToPara bodyBs)
199− return $
217+ return $
200− (if T.null ident
218+ (if null identAttribs
201− then mempty
219+ then mempty
202− else selfClosingTag "anchor" [("id", ident)]) $$ contents
220+ else selfClosingTag "anchor" identAttribs) $$ contents
203blockToDocbook _ h@Header{} = do
221blockToDocbook _ h@Header{} = do
204 -- should be handled by Div section above, except inside lists/blockquotes
222 -- should be handled by Div section above, except inside lists/blockquotes
205 report $ BlockNotRendered h
223 report $ BlockNotRendered h
test/Tests/Writers/Docbook.hs+52
@@ -70,6 +70,58 @@ 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+ , "single-child" =:
97+ divWith ("foo", [], []) (para "This is a test")
98+ =?> unlines
99+ [ "<para id=\"foo\">"
100+ , " This is a test"
101+ , "</para>"
102+ ]
103+ , "single-literal-child" =:
104+ divWith ("foo", [], []) lineblock
105+ =?> unlines
106+ [ "<literallayout id=\"foo\">some text"
107+ , "and more lines"
108+ , "and again</literallayout>"
109+ ]
110+ , "multiple-children" =:
111+ divWith ("foo", [], []) (
112+ para "This is a test" <>
113+ para "This is an another test"
114+ )
115+ =?> unlines
116+ [ "<anchor id=\"foo\" />"
117+ , "<para>"
118+ , " This is a test"
119+ , "</para>"
120+ , "<para>"
121+ , " This is an another test"
122+ , "</para>"
123+ ]
124+ ]
73 , testGroup "compact lists"
125 , testGroup "compact lists"
74 [ testGroup "bullet"
126 [ testGroup "bullet"
75 [ "compact" =: bulletList [plain "a", plain "b", plain "c"]
127 [ "compact" =: bulletList [plain "a", plain "b", plain "c"]