git.iko.soy/typeable/pandoc
on 4eff607 help sign in
typeable/pandoc/tests/Tests/Arbitrary.hs
194 lines 8.3 kB history raw
1{-# OPTIONS_GHC -fno-warn-orphans #-}
2{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
3-- provides Arbitrary instance for Pandoc types
4module Tests.Arbitrary ()
5where
6import Test.QuickCheck.Gen
7import Test.QuickCheck.Arbitrary
8import Control.Monad (liftM, liftM2)
9import Text.Pandoc.Definition
10import Text.Pandoc.Shared (normalize, escapeURI)
11import Text.Pandoc.Builder
13realString :: Gen String
14realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
15 , (1, elements ['\128'..'\9999']) ]
17arbAttr :: Gen Attr
18arbAttr = 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)
24instance Arbitrary Inlines where
25 arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary
27instance Arbitrary Blocks where
28 arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary
30instance Arbitrary Inline where
31 arbitrary = resize 3 $ arbInline 2
33arbInlines :: Int -> Gen [Inline]
34arbInlines 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
40arbInline :: Int -> Gen Inline
41arbInline 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 ]
73instance Arbitrary Block where
74 arbitrary = resize 3 $ arbBlock 2
76arbBlock :: Int -> Gen Block
77arbBlock 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*&amp;*\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 ]
113instance Arbitrary Pandoc where
114 arbitrary = resize 8 $ liftM normalize
115 $ liftM2 Pandoc arbitrary arbitrary
117instance 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"
126instance 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)
136instance 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"
144instance 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"
152instance 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
162instance 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"
172instance 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"
185instance 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"