@@ -1,194 +0,0 @@
1−{-# OPTIONS_GHC -fno-warn-orphans #-}
2−{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
3−-- provides Arbitrary instance for Pandoc types
4−module Tests.Arbitrary ()
5−where
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
12−
13−realString :: Gen String
14−realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
15− , (1, elements ['\128'..'\9999']) ]
16−
17−arbAttr :: Gen Attr
18−arbAttr = do
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)
23−
24−instance Arbitrary Inlines where
25− arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary
26−
27−instance Arbitrary Blocks where
28− arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary
29−
30−instance Arbitrary Inline where
31− arbitrary = resize 3 $ arbInline 2
32−
33−arbInlines :: Int -> Gen [Inline]
34−arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace)
35− where startsWithSpace (Space:_) = True
36− startsWithSpace _ = False
37−
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)
42− , (60, return Space)
43− , (10, liftM2 Code arbAttr realString)
44− , (5, elements [ RawInline (Format "html") "<a id=\"eek\">"
45− , RawInline (Format "latex") "\\my{command}" ])
46− ] ++ [ x | x <- nesters, n > 1]
47− where nesters = [ (10, liftM Emph $ arbInlines (n-1))
48− , (10, liftM Strong $ arbInlines (n-1))
49− , (10, liftM Strikeout $ arbInlines (n-1))
50− , (10, liftM Superscript $ arbInlines (n-1))
51− , (10, liftM Subscript $ arbInlines (n-1))
52− , (10, liftM SmallCaps $ arbInlines (n-1))
53− , (10, do x1 <- arbitrary
54− x2 <- arbInlines (n-1)
55− return $ Quoted x1 x2)
56− , (10, do x1 <- arbitrary
57− x2 <- realString
58− return $ Math x1 x2)
59− , (10, do x0 <- arbAttr
60− x1 <- arbInlines (n-1)
61− x3 <- realString
62− x2 <- liftM escapeURI realString
63− return $ Link x0 x1 (x2,x3))
64− , (10, do x0 <- arbAttr
65− x1 <- arbInlines (n-1)
66− x3 <- realString
67− x2 <- liftM escapeURI realString
68− return $ Image x0 x1 (x2,x3))
69− , (2, liftM2 Cite arbitrary (arbInlines 1))
70− , (2, liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1))
71− ]
72−
73−instance Arbitrary Block where
74− arbitrary = resize 3 $ arbBlock 2
75−
76−arbBlock :: Int -> Gen Block
77−arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1))
78− , (15, liftM Para $ arbInlines (n-1))
79− , (5, liftM2 CodeBlock arbAttr realString)
80− , (2, elements [ RawBlock (Format "html")
81− "<div>\n*&*\n</div>"
82− , RawBlock (Format "latex")
83− "\\begin[opt]{env}\nhi\n{\\end{env}"
84− ])
85− , (5, do x1 <- choose (1 :: Int, 6)
86− x2 <- arbInlines (n-1)
87− return (Header x1 nullAttr x2))
88− , (2, return HorizontalRule)
89− ] ++ [x | x <- nesters, n > 0]
90− where nesters = [ (5, liftM BlockQuote $ listOf1 $ arbBlock (n-1))
91− , (5, do x2 <- arbitrary
92− x3 <- arbitrary
93− x1 <- arbitrary `suchThat` (> 0)
94− x4 <- listOf1 $ listOf1 $ arbBlock (n-1)
95− return $ OrderedList (x1,x2,x3) x4 )
96− , (5, liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1)))
97− , (5, do items <- listOf1 $ do
98− x1 <- listOf1 $ listOf1 $ arbBlock (n-1)
99− x2 <- arbInlines (n-1)
100− return (x2,x1)
101− return $ DefinitionList items)
102− , (2, do rs <- choose (1 :: Int, 4)
103− cs <- choose (1 :: Int, 4)
104− x1 <- arbInlines (n-1)
105− x2 <- vector cs
106− x3 <- vectorOf cs $ elements [0, 0.25]
107− x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
108− x5 <- vectorOf rs $ vectorOf cs
109− $ listOf $ arbBlock (n-1)
110− return (Table x1 x2 x3 x4 x5))
111− ]
112−
113−instance Arbitrary Pandoc where
114− arbitrary = resize 8 $ liftM normalize
115− $ liftM2 Pandoc arbitrary arbitrary
116−
117−instance Arbitrary CitationMode where
118− arbitrary
119− = do x <- choose (0 :: Int, 2)
120− case x of
121− 0 -> return AuthorInText
122− 1 -> return SuppressAuthor
123− 2 -> return NormalCitation
124− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
125−
126−instance Arbitrary Citation where
127− arbitrary
128− = do x1 <- listOf $ elements $ ['a'..'z'] ++ ['0'..'9'] ++ ['_']
129− x2 <- arbInlines 1
130− x3 <- arbInlines 1
131− x4 <- arbitrary
132− x5 <- arbitrary
133− x6 <- arbitrary
134− return (Citation x1 x2 x3 x4 x5 x6)
135−
136−instance Arbitrary MathType where
137− arbitrary
138− = do x <- choose (0 :: Int, 1)
139− case x of
140− 0 -> return DisplayMath
141− 1 -> return InlineMath
142− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
143−
144−instance Arbitrary QuoteType where
145− arbitrary
146− = do x <- choose (0 :: Int, 1)
147− case x of
148− 0 -> return SingleQuote
149− 1 -> return DoubleQuote
150− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
151−
152−instance Arbitrary Meta where
153− arbitrary
154− = do (x1 :: Inlines) <- arbitrary
155− (x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary
156− (x3 :: Inlines) <- arbitrary
157− return $ setMeta "title" x1
158− $ setMeta "author" x2
159− $ setMeta "date" x3
160− $ nullMeta
161−
162−instance Arbitrary Alignment where
163− arbitrary
164− = do x <- choose (0 :: Int, 3)
165− case x of
166− 0 -> return AlignLeft
167− 1 -> return AlignRight
168− 2 -> return AlignCenter
169− 3 -> return AlignDefault
170− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
171−
172−instance Arbitrary ListNumberStyle where
173− arbitrary
174− = do x <- choose (0 :: Int, 6)
175− case x of
176− 0 -> return DefaultStyle
177− 1 -> return Example
178− 2 -> return Decimal
179− 3 -> return LowerRoman
180− 4 -> return UpperRoman
181− 5 -> return LowerAlpha
182− 6 -> return UpperAlpha
183− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
184−
185−instance Arbitrary ListNumberDelim where
186− arbitrary
187− = do x <- choose (0 :: Int, 3)
188− case x of
189− 0 -> return DefaultDelim
190− 1 -> return Period
191− 2 -> return OneParen
192− 3 -> return TwoParens
193− _ -> error "FATAL ERROR: Arbitrary instance, logic bug"
194−