1
{-# OPTIONS_GHC -fno-warn-orphans #-}
2
{-# LANGUAGE TypeSynonymInstances #-}
3
-- provides Arbitrary instance for Pandoc types
4
module Tests.Arbitrary ()
6
import Test.QuickCheck.Gen
7
import Test.QuickCheck.Arbitrary
8
import Control.Monad (liftM, liftM2)
9
import Text.Pandoc.Definition
10
import Text.Pandoc.Shared (normalize, escapeURI)
11
import Text.Pandoc.Builder
13
realString :: Gen String
14
realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
15
, (1, elements ['\128'..'\9999']) ]
19
id' <- elements ["","loc"]
20
classes <- elements [[],["haskell"],["c","numberLines"]]
21
keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]]
22
return (id',classes,keyvals)
24
instance Arbitrary Inlines where
25
arbitrary = liftM fromList arbitrary
27
instance Arbitrary Blocks where
28
arbitrary = liftM fromList arbitrary
30
instance Arbitrary Inline where
31
arbitrary = resize 3 $ arbInline 3
33
arbInlines :: Int -> Gen [Inline]
34
arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace)
35
where startsWithSpace (Space:_) = True
36
startsWithSpace _ = False
38
-- restrict to 3 levels of nesting max; otherwise we get
39
-- bogged down in indefinitely large structures
40
arbInline :: Int -> Gen Inline
41
arbInline n = frequency $ [ (60, liftM Str realString)
43
, (10, liftM2 Code arbAttr realString)
46
, (5, return Apostrophe)
47
, (5, return Ellipses)
48
, (5, elements [ RawInline "html" "<a id=\"eek\">"
49
, RawInline "latex" "\\my{command}" ])
50
] ++ [ x | x <- nesters, n > 1]
51
where nesters = [ (10, liftM Emph $ arbInlines (n-1))
52
, (10, liftM Strong $ arbInlines (n-1))
53
, (10, liftM Strikeout $ arbInlines (n-1))
54
, (10, liftM Superscript $ arbInlines (n-1))
55
, (10, liftM Subscript $ arbInlines (n-1))
56
-- , (10, liftM SmallCaps $ arbInlines (n-1))
57
, (10, do x1 <- arbitrary
58
x2 <- arbInlines (n-1)
59
return $ Quoted x1 x2)
60
, (10, do x1 <- arbitrary
63
, (10, do x1 <- arbInlines (n-1)
65
x2 <- liftM escapeURI realString
66
return $ Link x1 (x2,x3))
67
, (10, do x1 <- arbInlines (n-1)
69
x2 <- liftM escapeURI realString
70
return $ Image x1 (x2,x3))
71
, (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1))
74
instance Arbitrary Block where
75
arbitrary = resize 3 $ arbBlock 3
77
arbBlock :: Int -> Gen Block
78
arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1))
79
, (15, liftM Para $ arbInlines (n-1))
80
, (5, liftM2 CodeBlock arbAttr realString)
81
, (2, elements [ RawBlock "html"
82
"<div>\n*&*\n</div>"
84
"\\begin[opt]{env}\nhi\n{\\end{env}"
86
, (5, do x1 <- choose (1 :: Int, 6)
87
x2 <- arbInlines (n-1)
88
return (Header x1 x2))
89
, (2, return HorizontalRule)
90
] ++ [x | x <- nesters, n > 0]
91
where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1))
92
, (5, do x2 <- arbitrary
94
x1 <- arbitrary `suchThat` (> 0)
95
x4 <- listOf1 $ listOf1 $ arbBlock (n-1)
96
return $ OrderedList (x1,x2,x3) x4 )
97
, (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1)))
98
, (5, do items <- listOf1 $ do
99
x1 <- listOf1 $ listOf1 $ arbBlock (n-1)
100
x2 <- arbInlines (n-1)
102
return $ DefinitionList items)
103
, (2, do rs <- choose (1 :: Int, 4)
104
cs <- choose (1 :: Int, 4)
105
x1 <- arbInlines (n-1)
107
x3 <- vectorOf cs $ elements [0, 0.25]
108
x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
109
x5 <- vectorOf rs $ vectorOf cs
110
$ listOf $ arbBlock (n-1)
111
return (Table x1 x2 x3 x4 x5))
114
instance Arbitrary Pandoc where
115
arbitrary = resize 8 $ liftM normalize
116
$ liftM2 Pandoc arbitrary arbitrary
119
instance Arbitrary CitationMode where
121
= do x <- choose (0 :: Int, 2)
123
0 -> return AuthorInText
124
1 -> return SuppressAuthor
125
2 -> return NormalCitation
126
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
128
instance Arbitrary Citation where
130
= do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary
136
return (Citation x1 x2 x3 x4 x5 x6)
139
instance Arbitrary MathType where
141
= do x <- choose (0 :: Int, 1)
143
0 -> return DisplayMath
144
1 -> return InlineMath
145
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
147
instance Arbitrary QuoteType where
149
= do x <- choose (0 :: Int, 1)
151
0 -> return SingleQuote
152
1 -> return DoubleQuote
153
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
155
instance Arbitrary Meta where
158
x2 <- liftM (filter (not . null)) arbitrary
160
return (Meta x1 x2 x3)
162
instance Arbitrary Alignment where
164
= do x <- choose (0 :: Int, 3)
166
0 -> return AlignLeft
167
1 -> return AlignRight
168
2 -> return AlignCenter
169
3 -> return AlignDefault
170
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
172
instance Arbitrary ListNumberStyle where
174
= do x <- choose (0 :: Int, 6)
176
0 -> return DefaultStyle
179
3 -> return LowerRoman
180
4 -> return UpperRoman
181
5 -> return LowerAlpha
182
6 -> return UpperAlpha
183
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
185
instance Arbitrary ListNumberDelim where
187
= do x <- choose (0 :: Int, 3)
189
0 -> return DefaultDelim
192
3 -> return TwoParens
193
_ -> error "FATAL ERROR: Arbitrary instance, logic bug"
added
removed
src/Tests/Arbitrary.hs
