@@ -0,0 +1,167 @@
1+{-# OPTIONS_GHC -fno-warn-orphans #-}
2+-- provides Arbitrary instance for Pandoc types
3+module Tests.Arbitrary ()
4+where
5+import Test.QuickCheck.Gen
6+import Test.QuickCheck.Arbitrary
7+import Control.Monad (liftM, liftM2)
8+import Text.Pandoc
9+import Text.Pandoc.Shared
10+
11+realString :: Gen String
12+realString = elements wordlist
13+
14+wordlist :: [String]
15+wordlist = ["foo","Bar","baz","\\","/",":","\"","'","féé"]
16+
17+instance Arbitrary Inline where
18+ arbitrary = resize 3 $ arbInline 3
19+
20+-- restrict to 3 levels of nesting max; otherwise we get
21+-- bogged down in indefinitely large structures
22+arbInline :: Int -> Gen Inline
23+arbInline n = frequency $ [ (60, liftM Str realString)
24+ , (60, return Space)
25+ , (10, liftM Code realString)
26+ , (5, return EmDash)
27+ , (5, return EnDash)
28+ , (5, return Apostrophe)
29+ , (5, return Ellipses)
30+ ] ++ [ x | x <- nesters, n > 1]
31+ where nesters = [ (10, liftM Emph $ listOf $ arbInline (n-1))
32+ , (10, liftM Strong $ listOf $ arbInline (n-1))
33+ , (10, liftM Strikeout $ listOf $ arbInline (n-1))
34+ , (10, liftM Superscript $ listOf $ arbInline (n-1))
35+ , (10, liftM Subscript $ listOf $ arbInline (n-1))
36+ , (10, liftM SmallCaps $ listOf $ arbInline (n-1))
37+ , (10, do x1 <- arbitrary
38+ x2 <- listOf $ arbInline (n-1)
39+ return $ Quoted x1 x2)
40+ , (10, do x1 <- arbitrary
41+ x2 <- realString
42+ return $ Math x1 x2)
43+ , (10, do x1 <- listOf $ arbInline (n-1)
44+ x3 <- realString
45+ x2 <- realString
46+ return $ Link x1 (x2,x3))
47+ , (10, do x1 <- listOf $ arbInline (n-1)
48+ x3 <- realString
49+ x2 <- realString
50+ return $ Image x1 (x2,x3))
51+ , (2, liftM Note $ resize 3 $ listOf1 arbitrary)
52+ ]
53+
54+instance Arbitrary Block where
55+ arbitrary = resize 3 $ arbBlock 3
56+
57+arbBlock :: Int -> Gen Block
58+arbBlock n = frequency $ [ (10, liftM Plain arbitrary)
59+ , (15, liftM Para arbitrary)
60+ , (5, liftM2 CodeBlock arbitrary realString)
61+ , (2, liftM RawHtml realString)
62+ , (5, do x1 <- choose (1 :: Int, 6)
63+ x2 <- arbitrary
64+ return (Header x1 x2))
65+ , (2, return HorizontalRule)
66+ ] ++ [x | x <- nesters, n > 0]
67+ where nesters = [ (5, liftM BlockQuote $ listOf $ arbBlock (n-1))
68+ , (5, liftM2 OrderedList arbitrary
69+ $ (listOf $ listOf $ arbBlock (n-1)))
70+ , (5, liftM BulletList $ (listOf $ listOf $ arbBlock (n-1)))
71+ , (5, do x1 <- listOf $ listOf $ listOf $ arbBlock (n-1)
72+ x2 <- arbitrary
73+ return (DefinitionList $ zip x2 x1))
74+ , (2, do rs <- choose (1 :: Int, 4)
75+ cs <- choose (1 :: Int, 4)
76+ x1 <- arbitrary
77+ x2 <- vector cs
78+ x3 <- vectorOf cs $ elements [0, 0.25]
79+ x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
80+ x5 <- vectorOf rs $ vectorOf cs
81+ $ listOf $ arbBlock (n-1)
82+ return (Table x1 x2 x3 x4 x5))
83+ ]
84+
85+instance Arbitrary Pandoc where
86+ arbitrary
87+ = do x1 <- arbitrary
88+ x2 <- arbitrary
89+ return $ normalize (Pandoc x1 x2)
90+
91+{-
92+instance Arbitrary CitationMode where
93+ arbitrary
94+ = do x <- choose (0 :: Int, 2)
95+ case x of
96+ 0 -> return AuthorInText
97+ 1 -> return SuppressAuthor
98+ 2 -> return NormalCitation
99+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
100+
101+instance Arbitrary Citation where
102+ arbitrary
103+ = do x1 <- liftM (filter (`notElem` ",;]@ \t\n")) arbitrary
104+ x2 <- arbitrary
105+ x3 <- arbitrary
106+ x4 <- arbitrary
107+ x5 <- arbitrary
108+ x6 <- arbitrary
109+ return (Citation x1 x2 x3 x4 x5 x6)
110+-}
111+
112+instance Arbitrary MathType where
113+ arbitrary
114+ = do x <- choose (0 :: Int, 1)
115+ case x of
116+ 0 -> return DisplayMath
117+ 1 -> return InlineMath
118+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
119+
120+instance Arbitrary QuoteType where
121+ arbitrary
122+ = do x <- choose (0 :: Int, 1)
123+ case x of
124+ 0 -> return SingleQuote
125+ 1 -> return DoubleQuote
126+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
127+
128+instance Arbitrary Meta where
129+ arbitrary
130+ = do x1 <- arbitrary
131+ x2 <- liftM (filter (not . null)) arbitrary
132+ x3 <- arbitrary
133+ return (Meta x1 x2 x3)
134+
135+instance Arbitrary Alignment where
136+ arbitrary
137+ = do x <- choose (0 :: Int, 3)
138+ case x of
139+ 0 -> return AlignLeft
140+ 1 -> return AlignRight
141+ 2 -> return AlignCenter
142+ 3 -> return AlignDefault
143+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
144+
145+instance Arbitrary ListNumberStyle where
146+ arbitrary
147+ = do x <- choose (0 :: Int, 6)
148+ case x of
149+ 0 -> return DefaultStyle
150+ 1 -> return Example
151+ 2 -> return Decimal
152+ 3 -> return LowerRoman
153+ 4 -> return UpperRoman
154+ 5 -> return LowerAlpha
155+ 6 -> return UpperAlpha
156+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
157+
158+instance Arbitrary ListNumberDelim where
159+ arbitrary
160+ = do x <- choose (0 :: Int, 3)
161+ case x of
162+ 0 -> return DefaultDelim
163+ 1 -> return Period
164+ 2 -> return OneParen
165+ 3 -> return TwoParens
166+ _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
167+