mirror of
https://github.com/jgm/pandoc.git
synced 2026-08-29 01:41:20 +08:00
reptee
c660bd3419
`bbcode` is now supported as an output format, as well as variants `bbcode_fluxbb` (FluxBB), `bbcode_phpbb` (phpBB), `bbcode_steam` (Hubzilla), `bbcode_hubzilla` (Hubzilla), and `bbcode_xenforo` (xenForo). [API change] Adds a new module Text.Pandoc.Writers.BBCode, exporting a number of functions. Also exports `writeBBCode`, `writeBBCodeSteam`, `writeBBCodeFluxBB`, `writeBBCodePhpBB`, `writeBBCodeHubzilla`, `writeBBCodeXenforo` from Text.Pandoc.Writers.
356 lines
14 KiB
Haskell
356 lines
14 KiB
Haskell
{-# 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]"
|
|
]
|
|
]
|