@@ -8,7 +8,12 @@ import qualified Streamly.Internal.Data.Fold as FL
88
99import Test.Hspec(hspec, describe)
1010import Test.Hspec.QuickCheck
11−import Test.QuickCheck (forAll, chooseInt, Property, property, listOf, vectorOf)
11+import Test.QuickCheck (forAll, chooseInt, Property, property, listOf, vectorOf, counterexample, (.&&.))
12+
13+import Test.QuickCheck.Monadic (monadicIO, PropertyM, assert, monitor)
14+import Control.Monad.IO.Class (MonadIO(..))
15+import Control.Monad (when)
16+import Data.List ((\\))
1217
1318min_value :: Int
1419min_value = 0
@@ -22,6 +27,27 @@ max_value = 10000
2227max_length :: Int
2328max_length = 1000
2429
30+listEquals :: (Show a, Eq a, MonadIO m)
31+ => ([a] -> [a] -> Bool) -> [a] -> [a] -> PropertyM m ()
32+listEquals eq parsed_list list = do
33+ when (not $ parsed_list `eq` list) $ liftIO $ putStrLn $
34+ "parsed list " <> show parsed_list
35+ <> "\nlist " <> show list
36+ <> "\nparsed list \\\\ list " <> show (parsed_list \\ list)
37+ <> "\nlist \\\\ parsed list " <> show (list \\ parsed_list)
38+ when (not $ parsed_list `eq` list) $
39+ monitor
40+ (counterexample $
41+ "parsed list " <> show parsed_list
42+ <> "\nlist " <> show list
43+ <> "\nparsed list \\\\ list " <> show (parsed_list \\ list)
44+ <> "\nlist \\\\ parsed list " <> show (list \\ parsed_list)
45+ )
46+ assert (parsed_list `eq` list)
47+
48+checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property
49+checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)
50+
2551-- Accumulator Tests
2652
2753fromFold :: Property
@@ -137,8 +163,8 @@ take =
137163 forAll (chooseInt (min_value, max_value)) $ \n ->
138164 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
139165 case S.parse (P.take n FL.toList) (S.fromList ls) of
140− Right parsed_list -> parsed_list == Prelude.take n ls
141− Left _ -> False
166+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
167+ Left _ -> property False
142168
143169takeEQPass :: Property
144170takeEQPass =
@@ -146,8 +172,8 @@ takeEQPass =
146172 forAll (chooseInt (n, max_value)) $ \list_length ->
147173 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
148174 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
149− Right parsed_list -> parsed_list == Prelude.take n ls
150− Left _ -> False
175+ Right parsed_list -> checkListEqual parsed_list (Prelude.take n ls)
176+ Left _ -> property False
151177
152178takeEQ :: Property
153179takeEQ =
@@ -157,8 +183,12 @@ takeEQ =
157183 list_length = Prelude.length ls
158184 in
159185 case S.parse (P.takeEQ n FL.toList) (S.fromList ls) of
160− Right parsed_list -> (n <= list_length) && (parsed_list == Prelude.take n ls)
161− Left _ -> n > list_length
186+ Right parsed_list ->
187+ if (n <= list_length) then
188+ checkListEqual parsed_list (Prelude.take n ls)
189+ else
190+ property False
191+ Left _ -> property (n > list_length)
162192
163193takeGEPass :: Property
164194takeGEPass =
@@ -166,8 +196,8 @@ takeGEPass =
166196 forAll (chooseInt (n, max_value)) $ \list_length ->
167197 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
168198 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
169− Right parsed_list -> parsed_list == ls
170− Left _ -> False
199+ Right parsed_list -> checkListEqual parsed_list ls
200+ Left _ -> property False
171201
172202takeGE :: Property
173203takeGE =
@@ -177,8 +207,12 @@ takeGE =
177207 list_length = Prelude.length ls
178208 in
179209 case S.parse (P.takeGE n FL.toList) (S.fromList ls) of
180− Right parsed_list -> (n <= list_length) && (parsed_list == ls)
181− Left _ -> n > list_length
210+ Right parsed_list ->
211+ if (n <= list_length) then
212+ checkListEqual parsed_list ls
213+ else
214+ property False
215+ Left _ -> property (n > list_length)
182216
183217lookAheadPass :: Property
184218lookAheadPass =
@@ -193,8 +227,8 @@ lookAheadPass =
193227 forAll (chooseInt (n, max_value)) $ \list_length ->
194228 forAll (vectorOf list_length (chooseInt (min_value, max_value))) $ \ls ->
195229 case S.parse parseTwice (S.fromList ls) of
196− Right (ls_1, ls_2) -> (ls_1 == ls_2) && (ls_1 == Prelude.take n ls)
197− Left _ -> False
230+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
231+ Left _ -> property $ False
198232
199233lookAheadFail :: Property
200234lookAheadFail =
@@ -224,17 +258,17 @@ lookAhead =
224258 in
225259 forAll (listOf (chooseInt (min_value, max_value))) $ \ls ->
226260 case S.parse parseTwice (S.fromList ls) of
227− Right (ls_1, ls_2) -> (ls_1 == ls_2) && (ls_1 == Prelude.take n ls)
228− Left _ -> (list_length < n) || (list_length == n && n == 0)
261+ Right (ls_1, ls_2) -> checkListEqual ls_1 ls_2 .&&. checkListEqual ls_1 (Prelude.take n ls)
262+ Left _ -> property ((list_length < n) || (list_length == n && n == 0))
229263 where
230264 list_length = Prelude.length ls
231265
232266takeWhile :: Property
233267takeWhile =
234268 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
235− case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
236− Right parsed_list -> parsed_list == Prelude.takeWhile predicate ls
237− Left _ -> False
269+ case S.parse (P.takeWhile predicate FL.toList) (S.fromList ls) of
270+ Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile predicate ls)
271+ Left _ -> property False
238272 where
239273 predicate = (== 0)
240274
@@ -243,11 +277,15 @@ takeWhile1 =
243277 forAll (listOf (chooseInt (0, 1))) $ \ ls ->
244278 case S.parse (P.takeWhile1 predicate FL.toList) (S.fromList ls) of
245279 Right parsed_list -> case ls of
246− [] -> False
247− (x : _) -> predicate x && (parsed_list == Prelude.takeWhile predicate ls)
280+ [] -> property False
281+ (x : _) ->
282+ if predicate x then
283+ checkListEqual parsed_list (Prelude.takeWhile predicate ls)
284+ else
285+ property False
248286 Left _ -> case ls of
249− [] -> True
250− (x : _) -> not $ predicate x
287+ [] -> property True
288+ (x : _) -> property (not $ predicate x)
251289 where
252290 predicate = (== 0)
253291
@@ -255,8 +293,8 @@ sliceSepBy :: Property
255293sliceSepBy =
256294 forAll (listOf (chooseInt (0, 1))) $ \ls ->
257295 case S.parse (P.sliceSepBy predicate FL.toList) (S.fromList ls) of
258− Right parsed_list -> parsed_list == Prelude.takeWhile (not . predicate) ls
259− Left _ -> False
296+ Right parsed_list -> checkListEqual parsed_list (Prelude.takeWhile (not . predicate) ls)
297+ Left _ -> property False
260298 where
261299 predicate = (== 1)
262300
@@ -265,8 +303,8 @@ sliceSepBy =
265303-- forAll (chooseInt (min_value, max_value)) $ \n ->
266304-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
267305-- case S.parse (P.sliceSepByMax predicate n FL.toList) (S.fromList ls) of
268−-- Right parsed_list -> parsed_list == Prelude.take n (Prelude.takeWhile (not . predicate) ls)
269−-- Left _ -> False
306+-- Right parsed_list -> checkListEqual parsed_list (Prelude.take n (Prelude.takeWhile (not . predicate) ls))
307+-- Left _ -> property False
270308-- where
271309-- predicate = (== 1)
272310
@@ -307,8 +345,8 @@ sliceSepBy =
307345-- prsr = P.take n FL.toList
308346-- in
309347-- case S.parse (P.teeWith (,) prsr prsr) (S.fromList ls) of
310−-- Right (ls_1, ls_2) -> (Prelude.take n ls == ls_1) && (ls_1 == ls_2)
311−-- Left _ -> False
348+-- Right (ls_1, ls_2) -> checkListEqual (Prelude.take n ls) ls_1 .&&. checkListEqual ls_1 ls_2
349+-- Left _ -> property False
312350
313351-- teeWithFailLeft :: Property
314352-- teeWithFailLeft =
@@ -332,7 +370,7 @@ sliceSepBy =
332370-- deintercalate =
333371-- forAll (listOf (chooseInt (0, 1))) $ \ls ->
334372-- case S.parse (P.deintercalate concatFold prsr_1 concatFold prsr_2) (S.fromList ls) of
335−-- Right parsed_list_tuple -> parsed_list_tuple == partition (== 0) ls
373+-- Right parsed_list_tuple -> parsed_list_tuple == (partition (== 0) ls)
336374-- Left _ -> False
337375
338376-- where
@@ -349,8 +387,8 @@ sliceSepBy =
349387-- prsr_shortest = P.shortest prsr_1 prsr_2
350388-- in
351389-- case S.parse prsr_shortest (S.fromList ls) of
352−-- Right short_list -> short_list == Prelude.takeWhile (<= 2500) ls
353−-- Left _ -> False
390+-- Right short_list -> checkListEqual short_list (Prelude.takeWhile (<= 2500) ls)
391+-- Left _ -> property False
354392
355393-- shortestFailLeft :: Property
356394-- shortestFailLeft =