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
|
-- | Test generators.
--
module TestGenerators (
emptyDocGen,
emptyDocListGen
) where
import PrettyTestVersion
import TestStructures
import Control.Monad
import Test.QuickCheck
instance Arbitrary CDoc where
arbitrary = sized arbDoc
where
-- TODO: finetune frequencies
arbDoc k | k <= 1 = frequency [
(1,return CEmpty)
, (2,return (CText . unText) `ap` arbitrary)
]
arbDoc n = frequency [
(1, return CList `ap` arbitrary `ap` (liftM unDocList $ resize (pred n) arbitrary))
,(1, binaryComb n CBeside)
,(1, binaryComb n CAbove)
,(1, choose (0,10) >>= \k -> return (CNest k) `ap` (resize (pred n) arbitrary))
]
binaryComb n f =
split2 (n-1) >>= \(n1,n2) ->
return f `ap` arbitrary `ap` (resize n1 arbitrary) `ap` (resize n2 arbitrary)
split2 n = flip liftM ( choose (0,n) ) $ \sz -> (sz, n - sz)
instance CoArbitrary CDoc where
coarbitrary CEmpty = variant 0
coarbitrary (CText t) = variant 1 . coarbitrary (length t)
coarbitrary (CList f list) = variant 2 . coarbitrary f . coarbitrary list
coarbitrary (CBeside b d1 d2) = variant 3 . coarbitrary b . coarbitrary d1 . coarbitrary d2
coarbitrary (CAbove b d1 d2) = variant 4 . coarbitrary b . coarbitrary d1 . coarbitrary d2
coarbitrary (CNest k d) = variant 5 . coarbitrary k . coarbitrary d
instance Arbitrary CList where
arbitrary = oneof $ map return [ CCat, CSep, CFCat, CFSep ]
instance CoArbitrary CList where
coarbitrary cl = variant (case cl of CCat -> 0; CSep -> 1; CFCat -> 2; CFSep -> 3)
-- we assume that the list itself has no size, so that
-- sizeof (a $$ b) = sizeof (sep [a,b]) = sizeof(a) + sizeof(b)+1
instance Arbitrary CDocList where
arbitrary = liftM CDocList $ sized $ \n -> arbDocList n where
arbDocList 0 = return []
arbDocList n = do
listSz <- choose (1,n)
let elems = take listSz $ repeat (n `div` listSz) -- approximative
mapM (\sz -> resize sz arbitrary) elems
instance CoArbitrary CDocList where
coarbitrary (CDocList ds) = coarbitrary ds
instance Arbitrary Text where
arbitrary = liftM Text $ sized $ \n -> mapM (const arbChar) [1..n]
where arbChar = oneof (map return ['a'..'c'])
instance CoArbitrary Text where
coarbitrary (Text str) = coarbitrary (length str)
emptyDocGen :: Gen CDoc
emptyDocGen = return CEmpty
emptyDocListGen :: Gen CDocList
emptyDocListGen = do
ls <- listOf emptyDocGen
return $ CDocList ls
|
