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
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# LANGUAGE OverloadedStrings #-}
module Tests.Writers.ConTeXt (tests) where
import Data.Text (unpack)
import Test.Tasty
import Test.Tasty.QuickCheck
import Tests.Helpers
import Text.Pandoc
import Text.Pandoc.Arbitrary ()
import Text.Pandoc.Builder
context :: (ToPandoc a) => a -> String
context = unpack . purely (writeConTeXt def) . toPandoc
context' :: (ToPandoc a) => a -> String
context' = unpack . purely (writeConTeXt def{ writerWrapText = WrapNone }) . toPandoc
contextNtb :: (ToPandoc a) => a -> String
contextNtb = unpack . purely (writeConTeXt def{ writerExtensions = enableExtension Ext_ntb pandocExtensions }) . toPandoc
{-
"my test" =: X =?> Y
is shorthand for
test context "my test" $ X =?> Y
which is in turn shorthand for
test context "my test" (X,Y)
-}
infix 4 =:
(=:) :: (ToString a, ToPandoc a)
=> String -> (a, String) -> TestTree
(=:) = test context
tests :: [TestTree]
tests = [ testGroup "inline code"
[ "with '}'" =: code "}" =?> "\\mono{\\}}"
, "without '}'" =: code "]" =?> "\\type{]}"
, testProperty "code property" $ \s -> null s ||
if '{' `elem` s || '}' `elem` s
then (context' $ code s) == "\\mono{" ++
(context' $ str s) ++ "}"
else (context' $ code s) == "\\type{" ++ s ++ "}"
]
, testGroup "headers"
[ "level 1" =:
headerWith ("my-header",[],[]) 1 "My header" =?> "\\section[my-header]{My header}"
]
, testGroup "bullet lists"
[ "nested" =:
bulletList [
plain (text "top")
<> bulletList [
plain (text "next")
<> bulletList [plain (text "bot")]
]
] =?> unlines
[ "\\startitemize[packed]"
, "\\item"
, " top"
, " \\startitemize[packed]"
, " \\item"
, " next"
, " \\startitemize[packed]"
, " \\item"
, " bot"
, " \\stopitemize"
, " \\stopitemize"
, "\\stopitemize" ]
]
, testGroup "natural tables"
[ test contextNtb "table with header and caption" $
let caption = text "Table 1"
aligns = [(AlignRight, 0.0), (AlignLeft, 0.0), (AlignCenter, 0.0), (AlignDefault, 0.0)]
headers = [plain $ text "Right",
plain $ text "Left",
plain $ text "Center",
plain $ text "Default"]
rows = [[plain $ text "1.1",
plain $ text "1.2",
plain $ text "1.3",
plain $ text "1.4"]
,[plain $ text "2.1",
plain $ text "2.2",
plain $ text "2.3",
plain $ text "2.4"]
,[plain $ text "3.1",
plain $ text "3.2",
plain $ text "3.3",
plain $ text "3.4"]]
in table caption aligns headers rows
=?> unlines [ "\\startplacetable[caption={Table 1}]"
, "\\startTABLE"
, "\\startTABLEhead"
, "\\NC[align=left] Right"
, "\\NC[align=right] Left"
, "\\NC[align=middle] Center"
, "\\NC Default"
, "\\NC\\NR"
, "\\stopTABLEhead"
, "\\startTABLEbody"
, "\\NC[align=left] 1.1"
, "\\NC[align=right] 1.2"
, "\\NC[align=middle] 1.3"
, "\\NC 1.4"
, "\\NC\\NR"
, "\\NC[align=left] 2.1"
, "\\NC[align=right] 2.2"
, "\\NC[align=middle] 2.3"
, "\\NC 2.4"
, "\\NC\\NR"
, "\\stopTABLEbody"
, "\\startTABLEfoot"
, "\\NC[align=left] 3.1"
, "\\NC[align=right] 3.2"
, "\\NC[align=middle] 3.3"
, "\\NC 3.4"
, "\\NC\\NR"
, "\\stopTABLEfoot"
, "\\stopTABLE"
, "\\stopplacetable" ]
]
]
|
