1module Main where
2
3import Prelude hiding (toList, choose)
4import GHC.Exts as Exports (IsList(..))
5import Test.QuickCheck.Instances
6import Test.Tasty
7import Test.Tasty.Runners
8import Test.Tasty.HUnit
9import Test.Tasty.QuickCheck
10import qualified Test.QuickCheck as QuickCheck
11import qualified Test.QuickCheck.Property as QuickCheck
12import qualified Data.List as List
13import qualified Deque.Lazy as Lazy
14import qualified Deque.Strict as Strict
15
16
17main =
18  defaultMain $
19  testGroup "" $
20  [
21    testImplementation "Strict"
22      toList fromList Strict.fromConsAndSnocLists
23      Strict.cons Strict.snoc Strict.reverse
24      Strict.shiftLeft Strict.shiftRight Strict.filter Strict.take Strict.drop Strict.takeWhile Strict.dropWhile Strict.span
25      Strict.uncons Strict.unsnoc Strict.null Strict.head Strict.last Strict.tail Strict.init
26    ,
27    testImplementation "Lazy"
28      toList fromList Lazy.fromConsAndSnocLists
29      Lazy.cons Lazy.snoc Lazy.reverse
30      Lazy.shiftLeft Lazy.shiftRight Lazy.filter Lazy.take Lazy.drop Lazy.takeWhile Lazy.dropWhile Lazy.span
31      Lazy.uncons Lazy.unsnoc Lazy.null Lazy.head Lazy.last Lazy.tail Lazy.init
32    ,
33    testGroup "Conversions" $
34    [
35      testGroup "Strict" $
36      [
37        testProperty "toLazy" $ forAll strictAndLazyDequeGen $ \ (strictDeque, lazyDeque) ->
38        Strict.toLazy strictDeque === lazyDeque
39        ,
40        testProperty "fromLazy" $ forAll strictAndLazyDequeGen $ \ (strictDeque, lazyDeque) ->
41        Strict.fromLazy lazyDeque === strictDeque
42      ]
43      ,
44      testGroup "Lazy" $
45      [
46        testProperty "toStrict" $ forAll strictAndLazyDequeGen $ \ (strictDeque, lazyDeque) ->
47        Lazy.toStrict lazyDeque === strictDeque
48        ,
49        testProperty "fromStrict" $ forAll strictAndLazyDequeGen $ \ (strictDeque, lazyDeque) ->
50        Lazy.fromStrict strictDeque === lazyDeque
51      ]
52    ]
53  ]
54
55{-|
56Test group, which abstracts over the implementation of deque.
57-}
58testImplementation name
59  (toList :: forall a. f a -> [a]) fromList fromConsAndSnocLists
60  cons snoc reverse
61  shiftLeft shiftRight filter take drop takeWhile dropWhile span
62  uncons unsnoc null head last tail init =
63    testGroup ("Deque implementation: " <> name) $
64    [
65      testProperty "toList" $ forAll dequeAndListGen $ \ (deque, list) ->
66      toList deque === list
67      ,
68      testProperty "fromList" $ forAll listGen $ \ list ->
69      toList (fromList list) === list
70      ,
71      testProperty "eq" $ forAll dequeAndListGen $ \ (deque, list) ->
72      deque === fromList list
73      ,
74      testProperty "show" $ forAll dequeAndListGen $ \ (deque, list) ->
75      show deque === show list
76      ,
77      testProperty "cons" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \ (a, (deque, list)) ->
78      toList (cons a deque) === a : list
79      ,
80      testProperty "snoc" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \ (a, (deque, list)) ->
81      toList (snoc a deque) === list <> [a]
82      ,
83      testProperty "reverse" $ forAll dequeAndListGen $ \ (deque, list) ->
84      toList (reverse deque) === List.reverse list
85      ,
86      testProperty "shiftLeft" $ forAll dequeAndListGen $ \ (deque, list) ->
87      toList (shiftLeft deque) === List.drop 1 list <> List.take 1 list
88      ,
89      testProperty "shiftRight" $ forAll dequeAndListGen $ \ (deque, list) ->
90      toList (shiftRight deque) === case list of
91        [] -> []
92        _ -> List.last list : List.init list
93      ,
94      testProperty "filter" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \ (predicate, (deque, list)) ->
95      toList (filter predicate deque) === List.filter predicate list
96      ,
97      testProperty "take" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \ (amount, (deque, list)) ->
98      toList (take amount deque) === List.take amount list
99      ,
100      testProperty "drop" $ forAll ((,) <$> arbitrary <*> dequeAndListGen) $ \ (amount, (deque, list)) ->
101      toList (drop amount deque) === List.drop amount list
102      ,
103      testProperty "takeWhile" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \ (predicate, (deque, list)) ->
104      toList (takeWhile predicate deque) === List.takeWhile predicate list
105      ,
106      testProperty "dropWhile" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \ (predicate, (deque, list)) ->
107      toList (dropWhile predicate deque) === List.dropWhile predicate list
108      ,
109      testProperty "span" $ forAll ((,) <$> predicateGen <*> dequeAndListGen) $ \ (predicate, (deque, list)) ->
110      bimap toList toList (span predicate deque) === List.span predicate list
111      ,
112      testProperty "uncons" $ forAll dequeAndListGen $ \ (deque, list) ->
113      fmap (fmap toList) (uncons deque) === List.uncons list
114      ,
115      testProperty "unsnoc" $ forAll dequeAndListGen $ \ (deque, list) ->
116      fmap (fmap toList) (unsnoc deque) === case list of
117        [] -> Nothing
118        _ -> Just (List.last list, List.init list)
119      ,
120      testProperty "null" $ forAll dequeAndListGen $ \ (deque, list) ->
121      null deque === List.null list
122      ,
123      testProperty "head" $ forAll dequeAndListGen $ \ (deque, list) ->
124      head deque === case list of
125        head : _ -> Just head
126        _ -> Nothing
127      ,
128      testProperty "last" $ forAll dequeAndListGen $ \ (deque, list) ->
129      last deque === case list of
130        [] -> Nothing
131        _ -> Just (List.last list)
132      ,
133      testProperty "tail" $ forAll dequeAndListGen $ \ (deque, list) ->
134      toList (tail deque) === case list of
135        _ : tail -> tail
136        _ -> []
137      ,
138      testProperty "init" $ forAll dequeAndListGen $ \ (deque, list) ->
139      toList (init deque) === case list of
140        [] -> []
141        _ -> List.init list
142      ,
143      testProperty "<>" $ forAll ((,) <$> dequeAndListGen <*> dequeAndListGen) $ \ ((deque1, list1), (deque2, list2)) ->
144      toList (deque1 <> deque2) === (list1 <> list2)
145      ,
146      testProperty "<*>" $ forAll ((,) <$> dequeAndListGen <*> dequeAndListGen) $ \ ((deque1, list1), (deque2, list2)) ->
147      toList ((,) <$> deque1 <*> deque2) === ((,) <$> list1 <*> list2)
148      ,
149      testProperty ">>=" $ forAll ((,) <$> dequeAndListKleisliGen <*> dequeAndListGen) $ \ ((dequeK, listK), (deque, list)) ->
150      toList (deque >>= dequeK) === (list >>= listK)
151      ,
152      testProperty "foldl'" $ forAll dequeAndListGen $ \ (deque, list) ->
153      foldl' (flip (:)) [] deque === foldl' (flip (:)) [] list
154      ,
155      testProperty "foldr" $ forAll dequeAndListGen $ \ (deque, list) ->
156      foldr (:) [] deque === foldr (:) [] list
157      ,
158      testProperty "traverse" $ forAll dequeAndListGen $ \ (deque, list) -> let
159        fn x = if mod x 2 == 0 then Right x else Left x
160        in fmap toList (traverse fn deque) === traverse fn list
161    ]
162    where
163      dequeAndListGen = do
164        consList <- listGen
165        snocList <- listGen
166        return (fromConsAndSnocLists consList snocList, consList <> List.reverse snocList)
167      dequeAndListKleisliGen = do
168        list <- listGen
169        let
170          listK x = fmap (+ x) list
171          dequeK = fromList . listK
172          in return (dequeK, listK)
173
174sizedListGen maxSize = do
175  length <- choose (0, maxSize)
176  replicateM length (arbitrary @Word8)
177
178listGen = arbitrary @[Word8]
179
180predicateGen = do
181  op <- elements [(>), (>=), (==), (<=), (<)]
182  x <- arbitrary @Word8
183  return (op x)
184
185strictAndLazyDequeGen = do
186  consList <- listGen
187  snocList <- listGen
188  return (Strict.fromConsAndSnocLists consList snocList, Lazy.fromConsAndSnocLists consList snocList)
189
190
191-- * Workarounds to satisfy QuickCheck's requirements,
192-- when we need to generate a predicate.
193-------------------------
194
195instance Show (Word8 -> Bool) where
196  show _ = "@(Word8 -> Bool)"
197
198instance Show (Word8 -> [Word8]) where
199  show _ = "@(Word8 -> [Word8])"
200
201instance Show (Word8 -> Strict.Deque Word8) where
202  show _ = "@(Word8 -> Deque Word8)"
203
204instance Show (Word8 -> Lazy.Deque Word8) where
205  show _ = "@(Word8 -> Deque Word8)"
206