pandoc-3.10: test/Tests/Writers/BBCode.hs
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Tests.Writers.BBCode (tests) where
import Data.Maybe (isNothing)
import Data.Text as T
import Test.Tasty
import Test.Tasty.HUnit (HasCallStack)
import Test.Tasty.QuickCheck
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
import Text.Pandoc.Shared (tshow)
import Text.Read (readMaybe)
bbcodeDefault
, bbcodeSteam
, bbcodePhpBB
, bbcodeFluxBB
, bbcodeHubzilla
, bbcodeXenforo ::
(ToPandoc a) => a -> Text
bbcodeDefault = purely (writeBBCode def) . toPandoc
bbcodeSteam = purely (writeBBCodeSteam def) . toPandoc
bbcodePhpBB = purely (writeBBCodePhpBB def) . toPandoc
bbcodeFluxBB = purely (writeBBCodeFluxBB def) . toPandoc
bbcodeHubzilla = purely (writeBBCodeHubzilla def) . toPandoc
bbcodeXenforo = purely (writeBBCodeXenforo def) . toPandoc
infix 4 =:, `steam`, `phpbb`, `fluxbb`, `hubzilla`, `xenforo`
(=:)
, steam
, phpbb
, fluxbb
, hubzilla
, xenforo ::
(ToString a, ToPandoc a, HasCallStack) =>
String ->
(a, Text) ->
TestTree
(=:) = test bbcodeDefault
steam = test bbcodeSteam
phpbb = test bbcodePhpBB
fluxbb = test bbcodeFluxBB
hubzilla = test bbcodeHubzilla
xenforo = test bbcodeXenforo
spanClasses :: [Text] -> Inlines -> Inlines
spanClasses cls = spanWith ("", cls, [])
spanAttrs :: [(Text, Text)] -> Inlines -> Inlines
spanAttrs kvList = spanWith ("", [], kvList)
divClasses :: [Text] -> Blocks -> Blocks
divClasses cls = divWith ("", cls, [])
divAttrs :: [(Text, Text)] -> Blocks -> Blocks
divAttrs kvList = divWith ("", [], kvList)
tests :: [TestTree]
tests =
[ testGroup
"spans classes"
[ "left" =: spanClasses ["left"] "foo" =?> "foo"
, "center" =: spanClasses ["center"] "foo" =?> "foo"
, "right" =: spanClasses ["right"] "foo" =?> "foo"
, "spoiler" =: spanClasses ["spoiler"] "foo" =?> "foo"
]
, testGroup
"spans attributes"
[ testProperty "incorrect size ignored" . property $ do
n <- arbitrary @String
let nInt = readMaybe @Int n
let actual = bbcodeDefault (spanAttrs [("size", T.pack n)] "foo")
pure $ isNothing nInt ==> actual === "foo"
, testProperty "size<=0 ignored" . property $ do
NonPositive n <- arbitrary @(NonPositive Int)
let actual = bbcodeDefault (spanAttrs [("size", tshow n)] "foo")
pure $ actual === "foo"
, testProperty "size>0" . property $ do
Positive n <- arbitrary @(Positive Int)
let actual = bbcodeDefault (spanAttrs [("size", tshow n)] "foo")
let expected = "[size=" <> tshow n <> "]" <> "foo[/size]"
pure $ actual === expected
, "size=20" =: spanAttrs [("size", "20")] "foo" =?> "[size=20]foo[/size]"
, "color=#AAAAAA"
=: spanAttrs [("color", "#AAAAAA")] "foo"
=?> "[color=#AAAAAA]foo[/color]"
, "spoiler ignored"
=: spanAttrs [("spoiler", "name with spaces and ]brackets[]")] "foo"
=?> "foo"
]
, testGroup
"divs classes"
[ "left"
=: divClasses ["left"] (para "foo")
=?> "[left]foo[/left]"
, "center"
=: divClasses ["center"] (para "foo")
=?> "[center]foo[/center]"
, "right"
=: divClasses ["right"] (para "foo")
=?> "[right]foo[/right]"
, "spoiler"
=: divClasses ["spoiler"] (para "foo")
=?> "[spoiler]foo[/spoiler]"
]
, testGroup
"divs attributes"
[ testProperty "incorrect size ignored" . property $ do
n <- arbitrary @String
let nInt = readMaybe @Int n
let actual = bbcodeDefault (divAttrs [("size", T.pack n)] $ para "foo")
pure $ isNothing nInt ==> actual === "foo"
, testProperty "size<=0 ignored" . property $ do
NonPositive n <- arbitrary @(NonPositive Int)
let actual = bbcodeDefault (divAttrs [("size", tshow n)] $ para "foo")
pure $ actual === "foo"
, testProperty "size>0" . property $ do
Positive n <- arbitrary @(Positive Int)
let actual = bbcodeDefault (divAttrs [("size", tshow n)] $ para "foo")
let expected = "[size=" <> tshow n <> "]" <> "foo[/size]"
pure $ actual === expected
, "size=20"
=: divAttrs [("size", "20")] (para "foo")
=?> "[size=20]foo[/size]"
, "color=#AAAAAA"
=: divAttrs [("color", "#AAAAAA")] (para "foo")
=?> "[color=#AAAAAA]foo[/color]"
, "spoiler"
=: divAttrs
[("spoiler", "name with spaces and ]brackets[]")]
(para "foo")
=?> "[spoiler=name with spaces and brackets]foo[/spoiler]"
]
, testGroup
"default flavor"
[ "link"
=: link "https://example.com" "title" "label"
=?> "[url=https://example.com]label[/url]"
, "autolink"
=: link "https://example.com" "title" "https://example.com"
=?> "[url]https://example.com[/url]"
, "email autolink"
=: link
"mailto:example@example.com"
"title"
"example@example.com"
=?> "[email]example@example.com[/email]"
, "named email"
=: link "mailto:example@example.com" "title" "example email"
=?> "[email=example@example.com]example email[/email]"
, "h0" =: header 0 "heading 0" =?> "[u][b]heading 0[/b][/u]"
, "h1" =: header 1 "heading 1" =?> "[u][b]heading 1[/b][/u]"
, "h2" =: header 2 "heading 2" =?> "[b]heading 2[/b]"
, "h3" =: header 3 "heading 3" =?> "[u]heading 3[/u]"
, "h4" =: header 4 "heading 4" =?> "heading 4"
, "h5" =: header 5 "heading 5" =?> "heading 5"
]
, testGroup
"steam"
[ test bbcodeSteam "dename spoiler" $
divAttrs [("spoiler", "bar")] (para "foo")
=?> ("[spoiler]foo[/spoiler]" :: Text)
, testProperty "ordered list styleless" . property $ do
let listItems = [para "foo", para "bar", para "baz"]
attrsRand <- (,,) <$> arbitrary <*> arbitrary <*> arbitrary
let actual = bbcodeSteam $ orderedListWith attrsRand listItems
let expected = "[olist]\n[*]foo\n[*]bar\n[*]baz\n[/olist]"
pure $ actual === expected
, "h0" `steam` header 0 "heading 0" =?> "[h1]heading 0[/h1]"
, "h1" `steam` header 1 "heading 1" =?> "[h1]heading 1[/h1]"
, "h2" `steam` header 2 "heading 2" =?> "[h2]heading 2[/h2]"
, "h3" `steam` header 3 "heading 3" =?> "[h3]heading 3[/h3]"
, "h4" `steam` header 4 "heading 4" =?> "[h3]heading 4[/h3]"
, "code"
`steam` codeWith ("id", ["haskell"], []) "map (2^) [1..5]"
=?> "[noparse]map (2^) [1..5][/noparse]"
]
, testGroup
"phpBB"
[ "image"
`phpbb` imageWith
("id", [], [("width", "100")])
"https://example.com"
"title"
"alt text"
=?> "[img]https://example.com[/img]"
]
, testGroup
"FluxBB"
[ "image"
`fluxbb` imageWith
("id", [], [("width", "100")])
"https://example.com"
"title"
"alt text"
=?> "[img=alt text]https://example.com[/img]"
, testProperty "ordered list" . property $ do
let listItems = [para "foo", para "bar", para "baz"]
attrsRand <- (,,) <$> arbitrary <*> arbitrary <*> arbitrary
let actual = bbcodeFluxBB $ orderedListWith attrsRand listItems
let opening = case attrsRand of
(_, LowerAlpha, _) -> "[list=a]"
(_, UpperAlpha, _) -> "[list=a]"
_ -> "[list=1]"
let expected = opening <> "\n[*]foo\n[*]bar\n[*]baz\n[/list]"
pure $ actual === expected
, "ulist > BlockQuote not rendered"
`fluxbb` bulletList [blockQuote (para "foo") <> para "bar"]
=?> "[list]\n[*]bar\n[/list]"
, "code block"
`fluxbb` codeBlockWith
("id", ["haskell"], [])
( T.intercalate "\n" $
[ "vals ="
, " take 10"
, " . filter (\\x -> (x - 5) `mod` 3 == 0)"
, " $ map (2 ^) [1 ..]"
]
)
=?> T.intercalate
"\n"
[ "[code]vals ="
, " take 10"
, " . filter (\\x -> (x - 5) `mod` 3 == 0)"
, " $ map (2 ^) [1 ..]"
, "[/code]"
]
]
, testGroup
"Hubzilla"
[ "unordered list"
`hubzilla` bulletList [para "foo", para "bar", para "baz"]
=?> "[ul]\n[*]foo\n[*]bar\n[*]baz\n[/ul]"
, testProperty "ordered list" . property $ do
let listItems = [para "foo", para "bar", para "baz"]
attrsRand <- (,,) <$> arbitrary <*> arbitrary <*> arbitrary
let actual = bbcodeHubzilla $ orderedListWith attrsRand listItems
let (opening, closing) = case attrsRand of
(_, Decimal, _) -> ("[list=1]", "[/list]")
(_, DefaultStyle, _) -> ("[ol]", "[/ol]")
(_, Example, _) -> ("[ol]", "[/ol]")
(_, LowerAlpha, _) -> ("[list=a]", "[/list]")
(_, UpperAlpha, _) -> ("[list=A]", "[/list]")
(_, LowerRoman, _) -> ("[list=i]", "[/list]")
(_, UpperRoman, _) -> ("[list=I]", "[/list]")
let expected =
opening <> "\n[*]foo\n[*]bar\n[*]baz\n" <> closing
pure $ actual === expected
, "definition list"
`hubzilla` definitionList
[ ("term_foo", [para "def_foo1", para "def_foo2"])
, ("term_bar", [para "def_bar1", para "def_bar2"])
, ("term_baz", [para "def_baz1", para "def_baz2"])
]
=?> mconcat
[ "[dl terms=\"b\"]\n"
, "[*= term_foo]\ndef_foo1\ndef_foo2\n"
, "[*= term_bar]\ndef_bar1\ndef_bar2\n"
, "[*= term_baz]\ndef_baz1\ndef_baz2\n"
, "[/dl]"
]
, "h0" `hubzilla` header 0 "heading 0" =?> "[h1]heading 0[/h1]"
, "h1" `hubzilla` header 1 "heading 1" =?> "[h1]heading 1[/h1]"
, "h2" `hubzilla` header 2 "heading 2" =?> "[h2]heading 2[/h2]"
, "h3" `hubzilla` header 3 "heading 3" =?> "[h3]heading 3[/h3]"
, "h4" `hubzilla` header 4 "heading 4" =?> "[h4]heading 4[/h4]"
, "h5" `hubzilla` header 5 "heading 5" =?> "[h5]heading 5[/h5]"
, "h6" `hubzilla` header 6 "heading 6" =?> "[h6]heading 6[/h6]"
, "h7" `hubzilla` header 7 "heading 7" =?> "[h6]heading 7[/h6]"
, "link"
`hubzilla` link "https://example.com" "title" "label"
=?> "[url=https://example.com]label[/url]"
, "autolink"
`hubzilla` link "https://example.com" "title" "https://example.com"
=?> "[url]https://example.com[/url]"
, "email autolink"
`hubzilla` link
"mailto:example@example.com"
"title"
"example@example.com"
=?> "[url=mailto:example@example.com]example@example.com[/url]"
, "named email"
`hubzilla` link "mailto:example@example.com" "title" "example email"
=?> "[url=mailto:example@example.com]example email[/url]"
, "inline code"
`hubzilla` ( "inline code: "
<> codeWith ("id", ["haskell"], []) "map (2^) [1..5]"
)
=?> "inline code: [code]map (2^) [1..5][/code]"
, "font"
`hubzilla` divAttrs [("font", "serif")] (para "foo")
=?> "[font=serif]foo[/font]"
]
, testGroup
"xenForo"
[ "unordered list"
`xenforo` bulletList [para "foo", para "bar", para "baz"]
=?> "[list]\n[*]foo\n[*]bar\n[*]baz\n[/list]"
, testProperty "ordered list styleless" . property $ do
let listItems = [para "foo", para "bar", para "baz"]
attrsRand <- (,,) <$> arbitrary <*> arbitrary <*> arbitrary
let actual = bbcodeXenforo $ orderedListWith attrsRand listItems
let expected = "[list=1]\n[*]foo\n[*]bar\n[*]baz\n[/list]"
pure $ actual === expected
, "h0" `xenforo` header 0 "heading 0" =?> "[heading=1]heading 0[/heading]"
, "h1" `xenforo` header 1 "heading 1" =?> "[heading=1]heading 1[/heading]"
, "h2" `xenforo` header 2 "heading 2" =?> "[heading=2]heading 2[/heading]"
, "h3" `xenforo` header 3 "heading 3" =?> "[heading=3]heading 3[/heading]"
, "h4" `xenforo` header 4 "heading 4" =?> "[heading=4]heading 4[/heading]"
, "link"
`xenforo` link "https://example.com" "title" "label"
=?> "[url=https://example.com]label[/url]"
, "autolink"
`xenforo` link "https://example.com" "title" "https://example.com"
=?> "[url]https://example.com[/url]"
, "email autolink"
`xenforo` link
"mailto:example@example.com"
"title"
"example@example.com"
=?> "[email]example@example.com[/email]"
, "named email"
`xenforo` link "mailto:example@example.com" "title" "example email"
=?> "[email=example@example.com]example email[/email]"
, "inline code"
`xenforo` ( "inline code: "
<> codeWith ("id", ["haskell"], []) "map (2^) [1..5]"
)
=?> "inline code: [icode]map (2^) [1..5][/icode]"
, "font"
`xenforo` divAttrs [("font", "serif")] (para "foo")
=?> "[font=serif]foo[/font]"
, "inline spoiler"
`xenforo` ("It was " <> spanClasses ["spoiler"] ("DNS") <> "!")
=?> "It was [ispoiler]DNS[/ispoiler]!"
, "image w=50% h=50%"
`xenforo` imageWith
("", [], [("width", "50%"), ("height", "50%")])
"https://example.com"
"title text"
"alt text"
=?> "[img alt=\"alt text\" title=\"title text\" width=50%]https://example.com[/img]"
, "image w=50 h=50"
`xenforo` imageWith
("", [], [("width", "50"), ("height", "50")])
"https://example.com"
""
""
=?> "[img]https://example.com[/img]"
]
]