26f9f9a · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add tests for groupsBy

26f9f9aShruti Umat6 years ago

src/Streamly/Internal/Prelude.hs+2−2

compare with master

unifiedsplit

@@ -3659,8 +3659,8 @@ intervalsOf n f xs =

3659------------------------------------------------------------------------------

3660--

3661-- | @groupsBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the

3662−-- first group, if @a \`cmp` b@ is 'True' then @b@ is also assigned to the same

3662+-- first group, if @b \`cmp` a@ is 'True' then @b@ is also assigned to the same

3663−-- group. If @a \`cmp` c@ is 'True' then @c@ is also assigned to the same

3663+-- group. If @c \`cmp` a@ is 'True' then @c@ is also assigned to the same

3664-- group and so on. When the comparison fails a new group is started. Each

3665-- group is folded using the fold @f@ and the result of the fold is emitted in

3666-- the output stream.

test/Prop.hs+58−1

@@ -22,7 +22,7 @@ import GHC.Word (Word8)

22import Test.Hspec.QuickCheck

23import Test.QuickCheck

24 (counterexample, Property, withMaxSuccess, forAll, choose, Gen,

25− arbitrary, elements, frequency, listOf) --, listOf1, vectorOf, suchThat)

25+ arbitrary, elements, frequency, listOf, vectorOf) --, listOf1, suchThat)

26import Test.QuickCheck.Monadic (run, monadicIO, monitor, assert, PropertyM)

28import Test.Hspec as H

@@ -34,6 +34,9 @@ import qualified Streamly.Prelude as S

34import qualified Streamly.Data.Fold as FL

35import qualified Streamly.Internal.Data.Fold as FL

37+maxStreamLen :: Int

38+maxStreamLen = 1000

39+

37-- Coverage build takes too long with default number of tests

40-- Coverage build takes too long with default number of tests

38maxTestCount :: Int

41maxTestCount :: Int

39#ifdef DEVBUILD

42#ifdef DEVBUILD

@@ -990,6 +993,56 @@ monadBind constr eq t (a, b) = withMaxSuccess maxTestCount $

990 let list = a >>= \x -> (+ x) <$> b

993 let list = a >>= \x -> (+ x) <$> b

991 listEquals eq stream list

994 listEquals eq stream list

992

995

996+-------------------------------------------------------------------------------

997+-- Tests for S.groupsBy

998+-------------------------------------------------------------------------------

999+

1000+-- |

1001+-- If the list is empty, returns Nothing,

1002+-- else wraps the minimum value of the list in Just.

1003+maybeMinimum :: [Int] -> Maybe Int

1004+maybeMinimum [] = Nothing

1005+maybeMinimum ls = Just $ minimum ls

1006+

1007+

1008+-- |

1009+-- After grouping (and folding) Int stream using @>@ operation,

1010+-- the first @Int@ of every @[Int]@ in the @[Int]@ stream should be the minimum.

1011+testGroupsBy :: Property

1012+testGroupsBy =

1013+ forAll (choose (0, maxStreamLen)) $ \len ->

1014+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do

1015+ r <- run $ S.all (\ls ->

1016+ case ls of

1017+ [] -> True

1018+ (x:_) -> x == minimum ls)

1019+ $ S.groupsBy (>) FL.toList

1020+ $ S.fromList vec

1021+ assert $ r == True

1022+

1023+-- |

1024+-- Checks if the @[Int]@ is non-increasing.

1025+decreasing :: [Maybe Int] -> Bool

1026+decreasing [] = True

1027+decreasing xs = all (== True) $ zipWith (<=) (tail xs) xs

1028+

1029+

1030+-- |

1031+-- To check if the minimum elements (after grouping on @>@)

1032+-- are non-increasing (either decrease or remain the same).

1033+-- Had an element been strictly greater, it would have been grouped

1034+-- with that element only.

1035+testGroupsBySep :: Property

1036+testGroupsBySep =

1037+ forAll (choose (0, maxStreamLen)) $ \len ->

1038+ forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> monadicIO $ do

1039+ a <- run $ S.toList

1040+ $ S.map maybeMinimum

1041+ $ S.groupsBy (>) FL.toList

1042+ $ S.fromList vec

1043+ assert $ decreasing a == True

1044+

1045+

993main :: IO ()

1046main :: IO ()

994main = hspec

1047main = hspec

995 $ H.parallel

1048 $ H.parallel

@@ -1347,3 +1400,7 @@ main = hspec

1347 aheadOps $ eliminationOpsOrdered folded "aheadly folded"

1400 aheadOps $ eliminationOpsOrdered folded "aheadly folded"

1348 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"

1401 zipSerialOps $ eliminationOpsOrdered folded "zipSerially folded"

1349 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"

1402 zipAsyncOps $ eliminationOpsOrdered folded "zipAsyncly folded"

1403+

1404+ describe "Tests for S.groupsBy" $ do

1405+ prop "testGroupsBy" testGroupsBy

1406+ prop "testGroupsBySep" testGroupsBySep