1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
|
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.HTML (tests) where
import Prelude
import Data.Text (unpack)
import Test.Tasty
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
html :: (ToPandoc a) => a -> String
html = unpack . purely (writeHtml4String def{ writerWrapText = WrapNone }) . toPandoc
htmlQTags :: (ToPandoc a) => a -> String
htmlQTags = unpack
. purely (writeHtml4String def{ writerWrapText = WrapNone, writerHtmlQTags = True })
. toPandoc
{-
"my test" =: X =?> Y
is shorthand for
test html "my test" $ X =?> Y
which is in turn shorthand for
test html "my test" (X,Y)
-}
infix 4 =:
(=:) :: (ToString a, ToPandoc a)
=> String -> (a, String) -> TestTree
(=:) = test html
tests :: [TestTree]
tests = [ testGroup "inline code"
[ "basic" =: code "@&" =?> "<code>@&</code>"
, "haskell" =: codeWith ("",["haskell"],[]) ">>="
=?> "<code class=\"sourceCode haskell\"><span class=\"op\">>>=</span></code>"
, "nolanguage" =: codeWith ("",["nolanguage"],[]) ">>="
=?> "<code class=\"nolanguage\">>>=</code>"
]
, testGroup "images"
[ "alt with formatting" =:
image "/url" "title" ("my " <> emph "image")
=?> "<img src=\"/url\" title=\"title\" alt=\"my image\" />"
]
, testGroup "blocks"
[ "definition list with empty <dt>" =:
definitionList [(mempty, [para $ text "foo bar"])]
=?> "<dl><dt></dt><dd><p>foo bar</p></dd></dl>"
]
, testGroup "quotes"
[ "quote with cite attribute (without q-tags)" =:
doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
=?> "“<span cite=\"http://example.org\">examples</span>”"
, tQ "quote with cite attribute (with q-tags)" $
doubleQuoted (spanWith ("", [], [("cite", "http://example.org")]) (str "examples"))
=?> "<q cite=\"http://example.org\">examples</q>"
]
, testGroup "sample"
[ "sample should be rendered correctly" =:
plain (codeWith ("",["sample"],[]) "Answer is 42") =?>
"<samp>Answer is 42</samp>"
]
, testGroup "variable"
[ "variable should be rendered correctly" =:
plain (codeWith ("",["variable"],[]) "result") =?>
"<var>result</var>"
]
, testGroup "sample with style"
[ "samp should wrap highlighted code" =:
codeWith ("",["sample","haskell"],[]) ">>="
=?> ("<samp><code class=\"sourceCode haskell\">" ++
"<span class=\"op\">>>=</span></code></samp>")
]
, testGroup "variable with style"
[ "var should wrap highlighted code" =:
codeWith ("",["haskell","variable"],[]) ">>="
=?> ("<var><code class=\"sourceCode haskell\">" ++
"<span class=\"op\">>>=</span></code></var>")
]
]
where
tQ :: (ToString a, ToPandoc a)
=> String -> (a, String) -> TestTree
tQ = test htmlQTags
|
