-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathSet5aTest.hs
225 lines (187 loc) · 9.79 KB
/
Set5aTest.hs
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
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
module Set5aTest where
import Data.List
import Test.QuickCheck
import Mooc.Th
import Mooc.Test
import Set5a
main = score tests
tests = [(1,"Vehicle",[ex1])
,(2,"BusTicket",[ex2])
,(3,"ShippingEntry",[ex3_totalPrice, ex3_buyOneMore])
,(4,"Person",[ex4_name, ex4_age])
,(5,"Position",[ex5_simple, ex5_generate])
,(6,"Student",[ex6_freshman, ex6_nth, ex6_graduated, ex6_graduate])
,(7,"UpDown",[ex7_type, ex7_simple, ex7_generate])
,(8,"Color",[ex8_red, ex8_green, ex8_blue, ex8_simple, ex8_complicated])
,(9,"OneOrTwo",[ex9])
,(10,"KeyVals",[ex10_type, ex10_string_bool, ex10_int_int])
,(11,"Nat",[ex11_to, ex11_from, ex11_just, ex11_nothing])
,(12,"Bin",[ ex12_prettyPrint
, ex12_from_zero, ex12_to_zero, ex12_to_from_zero
, ex12_from_to_zero, ex12_from_one, ex12_to_one
, ex12_to_from_one, ex12_from_to_one, ex12_to_from
, ex12_from_to])
]
-- -- -- -- -- -- -- --
assertNormalConstructor (Constructor _ _) = property True
assertNormalConstructor (Weird n) = counterexample (" constructor "++n++" is not a normal constructor. Perhaps it's a record constructor or an infix constructor? Make it normal.") False
assertNoFields (Constructor n vs) = counterexample (" constructor "++n++" should have no fields") $ null vs
assertNoFields _ = property True
assertFields exp (Constructor n vs) = counterexample (" constructor "++n++" field types") $ vs ?== exp
assertFields _ _ = property True
ex1 = $(reifyType "Vehicle") $ \(DataType vars cs) ->
conjoin [counterexample " should have no type parameters" $ vars == []
,counterexample " should have 4 constructors" $ length cs ?== 4
,conjoin $ map assertNormalConstructor cs
,conjoin $ map assertNoFields cs
,counterexample " constructor names" $
hasElements ["Bike","Bus","Train","Tram"] [n | Constructor n _ <- cs]
]
ex2 = $(reifyType "BusTicket") $ \(DataType vars cs) ->
conjoin [counterexample " should have no type parameters" $ vars == []
,counterexample " should have 2 constructors" $ length cs ?== 2
,counterexample " constructor names" $
hasElements ["SingleTicket", "MonthlyTicket"] [n | Constructor n _ <- cs]
,conjoin $ map assertNormalConstructor cs
,counterexample " should have a constructor SingleTicket with no fields" $
any (==Constructor "SingleTicket" []) cs
,counterexample " should have a constructor MonthlyTicket with a String field" $
counterexample (show cs) $
any (==Constructor "MonthlyTicket" [SimpleType "String"]) cs
|| any (==Constructor "MonthlyTicket" [SimpleType "[Char]"]) cs
]
word = listOf1 (choose ('a','z'))
ex3_totalPrice = forAllBlind word $ \name ->
forAll_ $ \count ->
forAllBlind (elements [0.1,0.25..2.0]) $ \price ->
$(testing [|totalPrice (MkShoppingEntry name price count)|]) (?~=price * fromIntegral count)
eq (MkShoppingEntry n p c) (MkShoppingEntry n' p' c') = and [n==n',p==p',c==c']
ex3_buyOneMore = forAllBlind word $ \name -> forAll_ $ \(price,count) ->
let exp = MkShoppingEntry name price (succ count)
in $(testing [|buyOneMore (MkShoppingEntry name price count)|]) (\v -> expectation exp v (eq exp v))
ex4_name = property $ do
n <- word
return $ counterexample ("getName (setName "++show n++" fred)") $
getName (setName n fred) === n
ex4_age = property $ do
a <- choose (0,89)
return $ counterexample ("getAge (setAge "++show a++" fred)") $
getAge (setAge a fred) === a
ex5_simple = conjoin [$(testing' [|getX origin|]) (?==0)
,$(testing' [|getY origin|]) (?==0)
,$(testing' [|getX (right origin)|]) (?==1)
,$(testing' [|getY (up origin)|]) (?==1)]
ex5_generate = forAllShrink_ (choose (0,20)) $ \a ->
forAllShrink_ (choose (0,20)) $ \b' ->
let b = a+b'
pos0 = iterate (right . up) origin !! a
pos1 = iterate up pos0 !! b'
in counterexample ("After starting from origin and going right "++show a++" times and up "++show b++" times:") $
conjoin [counterexample "getX" (getX pos1 ?== a)
,counterexample "getY" (getY pos1 ?== b)]
ex6_freshman = $(testing [|study Freshman|]) (?==NthYear 1)
ex6_nth = forAllBlind (choose (1,6)) $ \i -> $(testing [|study (NthYear i)|]) (?==NthYear (i+1))
ex6_graduate = $(testing [|study (NthYear 7)|]) (?==Graduated)
ex6_graduated = $(testing [|study Graduated|]) (?==Graduated)
ex7_type = $(reifyType "UpDown") $ \(DataType vars cs) ->
conjoin [counterexample " should have no type parameters" $ vars == []
,counterexample " should have 2 constructors" $ length cs ?== 2
,conjoin $ map (assertFields [SimpleType "Int"]) cs
]
ex7_simple = conjoin [$(testing' [|get zero|]) (?== 0)
,$(testing' [|get (tick zero)|]) (?== 1)
,$(testing' [|get (tick (toggle zero))|]) (?== negate 1)
,$(testing' [|get (toggle (tick (zero)))|]) (?== 1)]
ex7_generate =
forAllShrink_ (choose (0,20)) $ \a ->
forAllShrink_ (choose (0,20)) $ \b ->
let tc0 = iterate tick zero !! a
tc1 = iterate tick (toggle tc0) !! b
in counterexample ("Did "++show a++" ticks, a toggle, and "++show b++" ticks:") $
counterexample "get:" (get tc1 ?== a-b)
ex8_red = $(testing [|rgb Red|]) (?==[1,0,0])
ex8_green = $(testing [|rgb Green|]) (?==[0,1,0])
ex8_blue = $(testing [|rgb Blue|]) (?==[0,0,1])
fcmp expected actual =
expectation expected actual (length expected == length actual && diff < eps)
where diff = sum . map abs $ zipWith (-) actual expected
eps = 0.01
ex8_simple = property $ do
~[c1,c2,c3,c4] <- shuffle [Red,Red,Red,Green]
return $ conjoin [$(testing [|rgb (Mix (Mix c1 c2) (Mix c3 c4))|]) (fcmp [0.75,0.25,0])
,$(testing [|rgb (Invert (Mix (Mix c1 c2) (Mix c3 c4)))|]) (fcmp [0.25,0.75,1.0])]
ex8_complicated = property $ do
cs <- vectorOf 4 (elements [Red,Invert Red,Green,Invert Green,Blue,Invert Blue])
let ~[c1,c2,c3,c4] = cs
r = fromIntegral $ length $ filter (has Red) cs
g = fromIntegral $ length $ filter (has Green) cs
b = fromIntegral $ length $ filter (has Blue) cs
return $ $(testing [|rgb (Mix (Mix c1 c2) (Mix c3 c4))|]) (fcmp [r/4, g/4, b/4])
where has Red Red = True
has Blue Blue = True
has Green Green = True
has x (Invert c) = not (has x c)
has _ _ = False
ex9 = $(reifyType "OneOrTwo") $ \(DataType vars cs) ->
conjoin [counterexample " should have one type parameter" $ length vars ?== 1
,counterexample " should have 2 constructors" $ length cs ?== 2
,counterexample " constructor names" $
hasElements ["One", "Two"] [n | Constructor n _ <- cs]
,conjoin $ map assertNormalConstructor cs
,counterexample " should have a constructor One with one field of the parameter type" $
any ((==) $ Constructor "One" $ map SimpleType vars) cs
,counterexample " should have a constructor Two with two fields of the parameter type" $
any ((==) $ Constructor "Two" $ map SimpleType $ vars++vars) cs
]
ex10_type = $(reifyType "KeyVals") $ \(DataType vars cs) ->
conjoin [counterexample " type parameters" $ ["k","v"] ?== vars
,counterexample " should have 2 constructors" $ length cs ?== 2
,conjoin $ map assertNormalConstructor cs
,counterexample " constructor names" $
hasElements ["Empty", "Pair"] [n | Constructor n _ <- cs]
,counterexample " should have a constructor Empty with no fields" $
any (==Constructor "Empty" []) cs
,counterexample " should have a constructor Pair with the right fields" $
any (==Constructor "Pair" [SimpleType "k",SimpleType "v",SimpleType "KeyVals k v"]) cs
]
m_ex10 vs = counterexample ("toList (fromList "++show vs++"))") $ vs ==? toList (fromList vs)
ex10_string_bool = forAll_ $ \(kvs::[(String,Bool)]) -> m_ex10 kvs
ex10_int_int = forAll_ $ \(kvs::[(Int,Int)]) -> m_ex10 kvs
instance Arbitrary Nat where
arbitrary = oneof $ map return $ take 20 $ iterate PlusOne Zero
ex11_to = $(testing [| toNat 0 |]) (?== Just Zero)
ex11_from = $(testing [| fromNat Zero |]) (?== 0)
ex11_just = forAll_ $ \(n :: Nat) ->
counterexample (" toNat (fromNat " ++ show n ++ ")")
(toNat (fromNat n) ?== Just n)
ex11_nothing = forAll_ $ \(Negative (z :: Int)) ->
$(testing [|toNat z|]) (?== Nothing)
instance Arbitrary Bin where
arbitrary = do
bs <- arbitrary :: Gen [Bool]
return $ foldr (\x b -> if x then I b else O b) (I End) (take 8 bs)
ex12_prettyPrint =
forAllBlind (listOf1 (elements "01")) $ \w->
let inp = foldl' (\acc i -> case i of '0' -> O acc; '1' -> I acc; _ -> error (show i)) End w
in $(testing [|prettyPrint inp|]) (?==w)
ex12_from_zero =
counterexample ("fromBin (O End)") (fromBin (O End) ?== 0)
ex12_to_zero =
counterexample ("toBin 0") (toBin 0 ?== O End)
ex12_to_from_zero =
counterexample ("toBin (fromBin (O End))") (toBin (fromBin (O End)) ?== O End)
ex12_from_to_zero =
counterexample ("fromBin (toBin 0)") (fromBin (toBin 0) ?== 0)
ex12_from_one =
counterexample ("fromBin (I End)") (fromBin (I End) ?== 1)
ex12_to_one =
counterexample ("toBin 1") (toBin 1 ?== I End)
ex12_to_from_one =
counterexample ("toBin (fromBin (I End))") (toBin (fromBin (I End)) ?== I End)
ex12_from_to_one =
counterexample ("fromBin (toBin 1)") (fromBin (toBin 1) ?== 1)
ex12_to_from = forAll_ $ \(b :: Bin) ->
counterexample ("toBin (fromBin (" ++ show b ++ "))") (toBin (fromBin b) ?== b)
ex12_from_to = forAll_ $ \(n :: Int) -> n < 0 .||.
counterexample ("fromBin (toBin (" ++ show n ++ "))") (fromBin (toBin n) ?== n)