aboutsummaryrefslogtreecommitdiff
path: root/tests/Tests/Arbitrary.hs
blob: 9073f2521f9a91081a3f1b1c7c4bb447f64c60fe (plain)
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
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, ScopedTypeVariables #-}
-- provides Arbitrary instance for Pandoc types
module Tests.Arbitrary ()
where
import Prelude
import Test.QuickCheck.Gen
import Test.QuickCheck.Arbitrary
import Control.Monad (liftM, liftM2)
import Text.Pandoc.Definition
import Text.Pandoc.Shared (normalize, escapeURI)
import Text.Pandoc.Builder

realString :: Gen String
realString = resize 8 $ listOf $ frequency [ (9, elements [' '..'\127'])
                                           , (1, elements ['\128'..'\9999']) ]

arbAttr :: Gen Attr
arbAttr = do
  id' <- elements ["","loc"]
  classes <- elements [[],["haskell"],["c","numberLines"]]
  keyvals <- elements [[],[("start","22")],[("a","11"),("b_2","a b c")]]
  return (id',classes,keyvals)

instance Arbitrary Inlines where
  arbitrary = liftM (fromList :: [Inline] -> Inlines) arbitrary

instance Arbitrary Blocks where
  arbitrary = liftM (fromList :: [Block] -> Blocks) arbitrary

instance Arbitrary Inline where
  arbitrary = resize 3 $ arbInline 2

arbInlines :: Int -> Gen [Inline]
arbInlines n = listOf1 (arbInline n) `suchThat` (not . startsWithSpace)
  where startsWithSpace (Space:_) = True
        startsWithSpace        _  = False

-- restrict to 3 levels of nesting max; otherwise we get
-- bogged down in indefinitely large structures
arbInline :: Int -> Gen Inline
arbInline n = frequency $ [ (60, liftM Str realString)
                          , (60, return Space)
                          , (10, liftM2 Code arbAttr realString)
                          , (5,  elements [ RawInline (Format "html") "<a id=\"eek\">"
                                          , RawInline (Format "latex") "\\my{command}" ])
                          ] ++ [ x | x <- nesters, n > 1]
   where nesters = [ (10,  liftM Emph $ arbInlines (n-1))
                   , (10,  liftM Strong $ arbInlines (n-1))
                   , (10,  liftM Strikeout $ arbInlines (n-1))
                   , (10,  liftM Superscript $ arbInlines (n-1))
                   , (10,  liftM Subscript $ arbInlines (n-1))
                   , (10,  liftM SmallCaps $ arbInlines (n-1))
                   , (10,  do x1 <- arbitrary
                              x2 <- arbInlines (n-1)
                              return $ Quoted x1 x2)
                   , (10,  do x1 <- arbitrary
                              x2 <- realString
                              return $ Math x1 x2)
                   , (10,  do x1 <- arbInlines (n-1)
                              x3 <- realString
                              x2 <- liftM escapeURI realString
                              return $ Link x1 (x2,x3))
                   , (10,  do x1 <- arbInlines (n-1)
                              x3 <- realString
                              x2 <- liftM escapeURI realString
                              return $ Image x1 (x2,x3))
                   , (2,  liftM2 Cite arbitrary (arbInlines 1))
                   , (2,  liftM Note $ resize 3 $ listOf1 $ arbBlock (n-1))
                   ]

instance Arbitrary Block where
  arbitrary = resize 3 $ arbBlock 2

arbBlock :: Int -> Gen Block
arbBlock n = frequency $ [ (10, liftM Plain $ arbInlines (n-1))
                         , (15, liftM Para $ arbInlines (n-1))
                         , (5,  liftM2 CodeBlock arbAttr realString)
                         , (2,  elements [ RawBlock (Format "html")
                                            "<div>\n*&amp;*\n</div>"
                                         , RawBlock (Format "latex")
                                            "\\begin[opt]{env}\nhi\n{\\end{env}"
                                         ])
                         , (5,  do x1 <- choose (1 :: Int, 6)
                                   x2 <- arbInlines (n-1)
                                   return (Header x1 nullAttr x2))
                         , (2, return HorizontalRule)
                         ] ++ [x | x <- nesters, n > 0]
   where nesters = [ (5,  liftM BlockQuote $ listOf1 $ arbBlock (n-1))
                   , (5,  do x2 <- arbitrary
                             x3 <- arbitrary
                             x1 <- arbitrary `suchThat` (> 0)
                             x4 <- listOf1 $ listOf1 $ arbBlock (n-1)
                             return $ OrderedList (x1,x2,x3) x4 )
                   , (5,  liftM BulletList $ (listOf1 $ listOf1 $ arbBlock (n-1)))
                   , (5,  do items <- listOf1 $ do
                                        x1 <- listOf1 $ listOf1 $ arbBlock (n-1)
                                        x2 <- arbInlines (n-1)
                                        return (x2,x1)
                             return $ DefinitionList items)
                   , (2, do rs <- choose (1 :: Int, 4)
                            cs <- choose (1 :: Int, 4)
                            x1 <- arbInlines (n-1)
                            x2 <- vector cs
                            x3 <- vectorOf cs $ elements [0, 0.25]
                            x4 <- vectorOf cs $ listOf $ arbBlock (n-1)
                            x5 <- vectorOf rs $ vectorOf cs
                                  $ listOf $ arbBlock (n-1)
                            return (Table x1 x2 x3 x4 x5))
                   ]

instance Arbitrary Pandoc where
        arbitrary = resize 8 $ liftM normalize
                             $ liftM2 Pandoc arbitrary arbitrary

instance Arbitrary CitationMode where
        arbitrary
          = do x <- choose (0 :: Int, 2)
               case x of
                   0 -> return AuthorInText
                   1 -> return SuppressAuthor
                   2 -> return NormalCitation
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

instance Arbitrary Citation where
        arbitrary
          = do x1 <- listOf $ elements $ ['a'..'z'] ++ ['0'..'9'] ++ ['_']
               x2 <- arbInlines 1
               x3 <- arbInlines 1
               x4 <- arbitrary
               x5 <- arbitrary
               x6 <- arbitrary
               return (Citation x1 x2 x3 x4 x5 x6)

instance Arbitrary MathType where
        arbitrary
          = do x <- choose (0 :: Int, 1)
               case x of
                   0 -> return DisplayMath
                   1 -> return InlineMath
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

instance Arbitrary QuoteType where
        arbitrary
          = do x <- choose (0 :: Int, 1)
               case x of
                   0 -> return SingleQuote
                   1 -> return DoubleQuote
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

instance Arbitrary Meta where
        arbitrary
          = do (x1 :: Inlines) <- arbitrary
               (x2 :: [Inlines]) <- liftM (filter (not . isNull)) arbitrary
               (x3 :: Inlines) <- arbitrary
               return $ setMeta "title" x1
                      $ setMeta "author" x2
                      $ setMeta "date" x3
                      $ nullMeta

instance Arbitrary Alignment where
        arbitrary
          = do x <- choose (0 :: Int, 3)
               case x of
                   0 -> return AlignLeft
                   1 -> return AlignRight
                   2 -> return AlignCenter
                   3 -> return AlignDefault
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

instance Arbitrary ListNumberStyle where
        arbitrary
          = do x <- choose (0 :: Int, 6)
               case x of
                   0 -> return DefaultStyle
                   1 -> return Example
                   2 -> return Decimal
                   3 -> return LowerRoman
                   4 -> return UpperRoman
                   5 -> return LowerAlpha
                   6 -> return UpperAlpha
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"

instance Arbitrary ListNumberDelim where
        arbitrary
          = do x <- choose (0 :: Int, 3)
               case x of
                   0 -> return DefaultDelim
                   1 -> return Period
                   2 -> return OneParen
                   3 -> return TwoParens
                   _ -> error "FATAL ERROR: Arbitrary instance, logic bug"