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
|
{-# OPTIONS_GHC -Wno-orphans -Wno-missing-signatures #-}
module Main where
import qualified Data.List as List
import qualified Deque.Lazy as Lazy
import qualified Deque.Strict as Strict
import GHC.Exts as Exports (IsList (..))
import Test.Tasty
import Test.Tasty.QuickCheck
import Prelude hiding (choose, toList)
main =
defaultMain
$ testGroup ""
$ [ testImplementation
"Strict"
toList
fromList
Strict.fromConsAndSnocLists
Strict.cons
Strict.snoc
Strict.reverse
Strict.shiftLeft
Strict.shiftRight
Strict.filter
Strict.take
Strict.drop
Strict.takeWhile
Strict.dropWhile
Strict.span
Strict.uncons
Strict.unsnoc
Strict.null
Strict.head
Strict.last
Strict.tail
Strict.init,
testImplementation
"Lazy"
toList
fromList
Lazy.fromConsAndSnocLists
Lazy.cons
Lazy.snoc
Lazy.reverse
Lazy.shiftLeft
Lazy.shiftRight
Lazy.filter
Lazy.take
Lazy.drop
Lazy.takeWhile
Lazy.dropWhile
Lazy.span
Lazy.uncons
Lazy.unsnoc
Lazy.null
Lazy.head
Lazy.last
Lazy.tail
Lazy.init,
testGroup "Conversions"
$ [ testGroup "Strict"
$ [ testProperty "toLazy" $ forAll strictAndLazyDequeGen $ \(strictDeque, lazyDeque) ->
Strict.toLazy strictDeque === lazyDeque,
testProperty "fromLazy" $ forAll strictAndLazyDequeGen $ \(strictDeque, lazyDeque) ->
Strict.fromLazy lazyDeque === strictDeque
],
testGroup "Lazy"
$ [ testProperty "toStrict" $ forAll strictAndLazyDequeGen $ \(strictDeque, lazyDeque) ->
Lazy.toStrict lazyDeque === strictDeque,
testProperty "fromStrict" $ forAll strictAndLazyDequeGen $ \(strictDeque, lazyDeque) ->
Lazy.fromStrict strictDeque === lazyDeque
]
]
]
-- |
-- Test group, which abstracts over the implementation of deque.
testImplementation
name
(toList :: forall a. f a -> [a])
fromList
fromConsAndSnocLists
cons
snoc
reverse
shiftLeft
shiftRight
filter
take
drop
takeWhile
dropWhile
span
uncons
unsnoc
null
head
last
tail
init =
testGroup ("Deque implementation: " <> name)
$ [ testProperty "toList" $ forAll dequeAndListGen $ \(deque, list) ->
toList deque === list,
testProperty "fromList" $ forAll listGen $ \list ->
toList (fromList list) === list,
testProperty "eq" $ forAll dequeAndListGen $ \(deque, list) ->
deque === fromList list,
testProperty "show" $ forAll dequeAndListGen $ \(deque, list) ->
show deque === show list,
testProperty "cons" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \(a, (deque, list)) ->
toList (cons a deque) === a : list,
testProperty "snoc" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \(a, (deque, list)) ->
toList (snoc a deque) === list <> [a],
testProperty "reverse" $ forAll dequeAndListGen $ \(deque, list) ->
toList (reverse deque) === List.reverse list,
testProperty "shiftLeft" $ forAll dequeAndListGen $ \(deque, list) ->
toList (shiftLeft deque) === List.drop 1 list <> List.take 1 list,
testProperty "shiftRight" $ forAll dequeAndListGen $ \(deque, list) ->
toList (shiftRight deque) === case list of
[] -> []
_ -> List.last list : List.init list,
testProperty "filter" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \(predicate, (deque, list)) ->
toList (filter predicate deque) === List.filter predicate list,
testProperty "take" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \(amount, (deque, list)) ->
toList (take amount deque) === List.take amount list,
testProperty "drop" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \(amount, (deque, list)) ->
toList (drop amount deque) === List.drop amount list,
testProperty "takeWhile" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \(predicate, (deque, list)) ->
toList (takeWhile predicate deque) === List.takeWhile predicate list,
testProperty "dropWhile" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \(predicate, (deque, list)) ->
toList (dropWhile predicate deque) === List.dropWhile predicate list,
testProperty "span" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \(predicate, (deque, list)) ->
bimap toList toList (span predicate deque) === List.span predicate list,
testProperty "uncons" $ forAll dequeAndListGen $ \(deque, list) ->
fmap (fmap toList) (uncons deque) === List.uncons list,
testProperty "unsnoc" $ forAll dequeAndListGen $ \(deque, list) ->
fmap (fmap toList) (unsnoc deque) === case list of
[] -> Nothing
_ -> Just (List.last list, List.init list),
testProperty "null" $ forAll dequeAndListGen $ \(deque, list) ->
null deque === List.null list,
testProperty "head" $ forAll dequeAndListGen $ \(deque, list) ->
head deque === case list of
head : _ -> Just head
_ -> Nothing,
testProperty "last" $ forAll dequeAndListGen $ \(deque, list) ->
last deque === case list of
[] -> Nothing
_ -> Just (List.last list),
testProperty "tail" $ forAll dequeAndListGen $ \(deque, list) ->
toList (tail deque) === case list of
_ : tail -> tail
_ -> [],
testProperty "init" $ forAll dequeAndListGen $ \(deque, list) ->
toList (init deque) === case list of
[] -> []
_ -> List.init list,
testProperty "<>" $ forAll ((,) <$> dequeAndListGen <*> dequeAndListGen) $ \((deque1, list1), (deque2, list2)) ->
toList (deque1 <> deque2) === (list1 <> list2),
testProperty "<*>" $ forAll ((,) <$> dequeAndListGen <*> dequeAndListGen) $ \((deque1, list1), (deque2, list2)) ->
toList ((,) <$> deque1 <*> deque2) === ((,) <$> list1 <*> list2),
testProperty ">>=" $ forAll ((,) <$> dequeAndListKleisliGen <*> dequeAndListGen) $ \((dequeK, listK), (deque, list)) ->
toList (deque >>= dequeK) === (list >>= listK),
testProperty "foldl'" $ forAll dequeAndListGen $ \(deque, list) ->
foldl' (flip (:)) [] deque === foldl' (flip (:)) [] list,
testProperty "foldr" $ forAll dequeAndListGen $ \(deque, list) ->
foldr (:) [] deque === foldr (:) [] list,
testProperty "traverse" $ forAll dequeAndListGen $ \(deque, list) ->
let fn x = if mod x 2 == 0 then Right x else Left x
in fmap toList (traverse fn deque) === traverse fn list
]
where
dequeAndListGen = do
consList <- listGen
snocList <- listGen
return (fromConsAndSnocLists consList snocList, consList <> List.reverse snocList)
dequeAndListKleisliGen = do
list <- listGen
let listK x = fmap (+ x) list
dequeK = fromList . listK
in return (dequeK, listK)
sizedListGen maxSize = do
length <- choose (0, maxSize)
replicateM length (arbitrary @Word8)
listGen = arbitrary @[Word8]
predicateGen = do
op <- elements [(>), (>=), (==), (<=), (<)]
x <- arbitrary @Word8
return (op x)
strictAndLazyDequeGen = do
consList <- listGen
snocList <- listGen
return (Strict.fromConsAndSnocLists consList snocList, Lazy.fromConsAndSnocLists consList snocList)
-- Workarounds to satisfy QuickCheck's requirements,
-- when we need to generate a predicate.
-------------------------
instance Show (Word8 -> Bool) where
show _ = "@(Word8 -> Bool)"
instance Show (Word8 -> [Word8]) where
show _ = "@(Word8 -> [Word8])"
instance Show (Word8 -> Strict.Deque Word8) where
show _ = "@(Word8 -> Deque Word8)"
instance Show (Word8 -> Lazy.Deque Word8) where
show _ = "@(Word8 -> Deque Word8)"
|
