{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.Docbook (tests) where
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
docbook :: (ToPandoc a) => a -> String
docbook = docbookWithOpts def{ writerWrapText = WrapNone }
docbook5 :: (ToPandoc a) => a -> String
docbook5 = docbook5WithOpts def{ writerWrapText = WrapNone }
docbookWithOpts :: ToPandoc a => WriterOptions -> a -> String
docbookWithOpts opts = unpack . purely (writeDocbook4 opts) . toPandoc
docbook5WithOpts :: ToPandoc a => WriterOptions -> a -> String
docbook5WithOpts opts = unpack . purely (writeDocbook5 opts) . toPandoc
{-
"my test" =: X =?> Y
is shorthand for
test docbook "my test" $ X =?> Y
which is in turn shorthand for
test docbook "my test" (X,Y)
-}
infix 4 =:
(=:), testDb4, testDb5 :: (ToString a, ToPandoc a)
=> String -> (a, String) -> TestTree
(=:) = test docbook
testDb4 = test docbook
testDb5 = test docbook5
lineblock :: Blocks
lineblock = para ("some text" <> linebreak <>
"and more lines" <> linebreak <>
"and again")
lineblock_out :: [String]
lineblock_out = [ "some text"
, "and more lines"
, "and again"
]
tests :: [TestTree]
tests = [ testGroup "inline elements"
[ testGroup "links"
[ testDb4 "db4 external link" $ link "https://example.com" "" "Hello"
=?> "Hello"
, testDb5 "db5 external link" $ link "https://example.com" "" "Hello"
=?> "Hello"
, testDb5 "anchor" $ link "#foo" "" "Hello"
=?> "Hello"
, testDb5 "automatic anchor" $ link "#foo" "" ""
=?> ""
]
]
, testGroup "line blocks"
[ "none" =: para "This is a test"
=?> unlines
[ ""
, " This is a test"
, ""
]
, "basic" =: lineblock
=?> unlines lineblock_out
, "blockquote" =: blockQuote lineblock
=?> unlines
( [ "" ] ++
lineblock_out ++
[ "
" ]
)
, "footnote" =: para ("This is a test" <>
note lineblock <>
" of footnotes")
=?> unlines
( [ ""
, " This is a test" ] ++
lineblock_out ++
[ " of footnotes"
, "" ]
)
]
, testGroup "divs"
[ "admonition" =: divWith ("foo", ["warning"], []) (para "This is a test")
=?> unlines
[ ""
, " "
, " This is a test"
, " "
, ""
]
, "admonition-with-title" =:
divWith ("foo", ["note"], []) (
divWith ("foo", ["title"], [])
(plain (text "This is title")) <>
para "This is a test"
)
=?> unlines
[ ""
, " This is title"
, " "
, " This is a test"
, " "
, ""
]
, "admonition-with-title-in-para" =:
divWith ("foo", ["note"], []) (
divWith ("foo", ["title"], [])
(para "This is title") <>
para "This is a test"
)
=?> unlines
[ ""
, " This is title"
, " "
, " This is a test"
, " "
, ""
]
, "single-child" =:
divWith ("foo", [], []) (para "This is a test")
=?> unlines
[ ""
, " This is a test"
, ""
]
, "single-literal-child" =:
divWith ("foo", [], []) lineblock
=?> unlines
[ "some text"
, "and more lines"
, "and again"
]
, "multiple-children" =:
divWith ("foo", [], []) (
para "This is a test" <>
para "This is an another test"
)
=?> unlines
[ ""
, ""
, " This is a test"
, ""
, ""
, " This is an another test"
, ""
]
]
, testGroup "compact lists"
[ testGroup "bullet"
[ "compact" =: bulletList [plain "a", plain "b", plain "c"]
=?> unlines
[ ""
, " "
, " "
, " a"
, " "
, " "
, " "
, " "
, " b"
, " "
, " "
, " "
, " "
, " c"
, " "
, " "
, ""
]
, "loose" =: bulletList [para "a", para "b", para "c"]
=?> unlines
[ ""
, " "
, " "
, " a"
, " "
, " "
, " "
, " "
, " b"
, " "
, " "
, " "
, " "
, " c"
, " "
, " "
, ""
]
]
, testGroup "ordered"
[ "compact" =: orderedList [plain "a", plain "b", plain "c"]
=?> unlines
[ ""
, " "
, " "
, " a"
, " "
, " "
, " "
, " "
, " b"
, " "
, " "
, " "
, " "
, " c"
, " "
, " "
, ""
]
, "loose" =: orderedList [para "a", para "b", para "c"]
=?> unlines
[ ""
, " "
, " "
, " a"
, " "
, " "
, " "
, " "
, " b"
, " "
, " "
, " "
, " "
, " c"
, " "
, " "
, ""
]
]
, testGroup "definition"
[ "compact" =: definitionList [ ("an", [plain "apple" ])
, ("a", [plain "banana"])
, ("an", [plain "orange"])]
=?> unlines
[ ""
, " "
, " "
, " an"
, " "
, " "
, " "
, " apple"
, " "
, " "
, " "
, " "
, " "
, " a"
, " "
, " "
, " "
, " banana"
, " "
, " "
, " "
, " "
, " "
, " an"
, " "
, " "
, " "
, " orange"
, " "
, " "
, " "
, ""
]
, "loose" =: definitionList [ ("an", [para "apple" ])
, ("a", [para "banana"])
, ("an", [para "orange"])]
=?> unlines
[ ""
, " "
, " "
, " an"
, " "
, " "
, " "
, " apple"
, " "
, " "
, " "
, " "
, " "
, " a"
, " "
, " "
, " "
, " banana"
, " "
, " "
, " "
, " "
, " "
, " an"
, " "
, " "
, " "
, " orange"
, " "
, " "
, " "
, ""
]
]
]
, testGroup "writer options"
[ testGroup "top-level division" $
let
headers = header 1 (text "header1")
<> header 2 (text "header2")
<> header 3 (text "header3")
docbookTopLevelDiv :: (ToPandoc a)
=> TopLevelDivision -> a -> String
docbookTopLevelDiv division =
docbookWithOpts def{ writerTopLevelDivision = division }
in
[ test (docbookTopLevelDiv TopLevelSection) "sections as top-level" $
headers =?>
unlines [ ""
, " header1"
, " "
, " header2"
, " "
, " header3"
, " "
, " "
, " "
, " "
, ""
]
, test (docbookTopLevelDiv TopLevelChapter) "chapters as top-level" $
headers =?>
unlines [ ""
, " header1"
, " "
, " header2"
, " "
, " header3"
, " "
, " "
, " "
, " "
, ""
]
, test (docbookTopLevelDiv TopLevelPart) "parts as top-level" $
headers =?>
unlines [ ""
, " header1"
, " "
, " header2"
, " "
, " header3"
, " "
, " "
, " "
, " "
, ""
]
, test (docbookTopLevelDiv TopLevelDefault) "default top-level" $
headers =?>
unlines [ ""
, " header1"
, " "
, " header2"
, " "
, " header3"
, " "
, " "
, " "
, " "
, ""
]
]
]
, testGroup "section attributes" $
let
headers = headerWith ("myid1",[],[("role","internal"),("xml:id","anotherid"),("dir","rtl")]) 1 "header1"
<> headerWith ("myid2",[],[("invalidname","value"),("arch","linux"),("dir","invaliddir")]) 1 "header2"
in
[ test docbook5 "sections with attributes (db5)" $
headers =?>
unlines [ ""
, " header1"
, " "
, " "
, ""
, ""
, " header2"
, " "
, " "
, ""
]
, test docbook "sections with attributes (db4)" $
headers =?>
unlines [ ""
, " header1"
, " "
, " "
, ""
, ""
, " header2"
, " "
, " "
, ""
]
]
]