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