diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index 9b16979050..bb172ccb03 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -2,6 +2,8 @@ ## Unreleased +* Fixed `Stream.postscanl` to omit the output of a scan that terminates without + consuming any input (e.g. `Scanl.take 0`). * Breaking: In `FileSystem.Path` module the default for `eqPath` changed on Windows to case-sensitive comparison. * Breaking: A leading "." component (e.g. "." or "./x") is no longer diff --git a/core/src/Streamly/Internal/Data/Stream/Transform.hs b/core/src/Streamly/Internal/Data/Stream/Transform.hs index 14736eda61..d465fee0f6 100644 --- a/core/src/Streamly/Internal/Data/Stream/Transform.hs +++ b/core/src/Streamly/Internal/Data/Stream/Transform.hs @@ -537,17 +537,24 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone -- Unfortunately, we cannot define lazy scans because the Partial constructor -- itself is strict. --- | Postscan a stream using the given fold. A postscan omits the initial --- (default) value of the accumulator and includes the final value. +-- | Postscan a stream using the given scan. A postscan emits one output per +-- input element, omitting the initial value of the accumulator. Equivalently, +-- @postscanl s = 'Data.List.drop' 1 . 'scanl' s@. -- -- >>> Stream.toList $ Stream.postscanl Scanl.latest (Stream.fromList []) -- [] -- --- Compare with 'scan' which includes the initial value as well: +-- Compare with 'scanl' which additionally emits the initial value: -- -- >>> Stream.toList $ Stream.scanl Scanl.latest (Stream.fromList []) -- [Nothing] -- +-- A scan that terminates at the initial step (e.g. @Scanl.take 0@) consumes no +-- input, so the postscan is empty: +-- +-- >>> Stream.toList $ Stream.postscanl (Scanl.take 0 Scanl.toList) (Stream.fromList [1,2,3::Int]) +-- [] +-- -- The following example extracts the input stream up to a point where the -- running average of elements is no more than 10: -- @@ -575,7 +582,12 @@ postscanl (Scanl fstep initial extract final) (Stream sstep state) = return $ case res of FL.Partial fs -> Skip $ ScanDo st fs - FL.Done b -> Yield b ScanDone + -- A scan that is Done at the initial step has consumed no + -- input, so a postscan (one output per consumed input) emits + -- nothing. This keeps the invariant + -- @postscanl s = drop 1 . scanl s@: the initial value is + -- always dropped, whether it comes from a Partial or a Done. + FL.Done _ -> Stop step gst (ScanDo st fs) = do res <- sstep (adaptState gst) st case res of diff --git a/streamly.cabal b/streamly.cabal index b3812e4366..0fe3d48d1a 100644 --- a/streamly.cabal +++ b/streamly.cabal @@ -129,7 +129,9 @@ extra-source-files: test/Streamly/Test/Data/*.hs test/Streamly/Test/Data/Array/*.hs test/Streamly/Test/Data/MutArray/*.hs + test/Streamly/Test/Data/Parser/*.hs test/Streamly/Test/Data/ParserK/*.hs + test/Streamly/Test/Data/RingArray/*.hs test/Streamly/Test/Data/Stream/*.hs test/Streamly/Test/Data/Stream/MkType/*.hs test/Streamly/Test/Data/Stream/Prelude/*.hs @@ -145,7 +147,6 @@ extra-source-files: test/Streamly/Test/Prelude.hs test/Streamly/Test/Prelude/*.hs test/Streamly/Test/Unicode/*.hs - test/Streamly/Test/Serialize/*.hs test/Streamly/Test/Data/Scanl/*.hs test/Streamly/Test/Data/Fold/*.hs test/Streamly/Test/Unicode/ucd/NormalizationTest.txt @@ -154,8 +155,7 @@ extra-source-files: test/lib/Streamly/Test/Common.hs test/lib/Streamly/Test/Control/Exception/Common.hs test/lib/Streamly/Test/Prelude/Common.hs - test/lib/Streamly/Test/Data/Parser/CommonTests.hs - test/lib/Streamly/Test/Data/Parser/CommonUtilities.hs + test/lib/Streamly/Test/Data/Parser/*.hs test/streamly-tests.cabal test/version-bounds.hs diff --git a/test/Streamly/Test/Serialize/Serializable.hs b/test/Streamly/Test/Data/Binary.hs similarity index 99% rename from test/Streamly/Test/Serialize/Serializable.hs rename to test/Streamly/Test/Data/Binary.hs index 0e8bb51a47..bb72125543 100644 --- a/test/Streamly/Test/Serialize/Serializable.hs +++ b/test/Streamly/Test/Data/Binary.hs @@ -194,7 +194,7 @@ charLatin1 = forAll (chooseChar (unsafeChr 0, unsafeChr 255)) $ \x -> monadicIO $ action x Encoder.charLatin1 Decoder.charLatin1 moduleName :: String -moduleName = "Serialize.Serializable" +moduleName = "Data.Binary" main :: IO () main = diff --git a/test/Streamly/Test/Data/Fold.hs b/test/Streamly/Test/Data/Fold.hs index 5c529bbe7f..25d77302a7 100644 --- a/test/Streamly/Test/Data/Fold.hs +++ b/test/Streamly/Test/Data/Fold.hs @@ -13,13 +13,10 @@ import qualified Streamly.Test.Data.Fold.Container as Container import qualified Streamly.Test.Data.Fold.Exception as Exception import qualified Streamly.Test.Data.Fold.Tee as Tee import qualified Streamly.Test.Data.Fold.Type as Type -import qualified Streamly.Test.Data.Fold.Window as Window - main :: IO () main = do Type.main Combinators.main Container.main - Window.main Exception.main Tee.main diff --git a/test/Streamly/Test/Data/Fold/Combinators.hs b/test/Streamly/Test/Data/Fold/Combinators.hs index c8a8561f6c..8527179aa9 100644 --- a/test/Streamly/Test/Data/Fold/Combinators.hs +++ b/test/Streamly/Test/Data/Fold/Combinators.hs @@ -9,16 +9,15 @@ module Streamly.Test.Data.Fold.Combinators (main) where -import Control.Monad.IO.Class (liftIO) import Data.IORef (newIORef, atomicModifyIORef) -import Data.List (sort, sortBy) -import Data.Ord (comparing, Down(..)) -import Data.Semigroup (Sum(..), getSum) +import Data.Int (Int64) +import Data.Semigroup (Sum(..)) import qualified Prelude import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.MutArray as MArray import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Fold as F import qualified Streamly.Internal.Data.Stream as Stream import Prelude hiding @@ -27,33 +26,34 @@ import Prelude hiding , maybe ) import Streamly.Test.Common (chooseInt, withNumTests) +import Streamly.Test.Data.Fold.Type (check, checkApprox, checkPostscanl) import Test.Hspec import Test.Hspec.QuickCheck import Test.QuickCheck ( Gen , Property - , arbitrary , choose , forAll - , listOf , listOf1 - , vectorOf - , generate ) import Test.QuickCheck.Monadic (monadicIO, assert, run) +------------------------------------------------------------------------------- +-- Shared Fold/Scanl tests +------------------------------------------------------------------------------- + +#include "Streamly/Test/Data/Scanl/CommonCombinators.hs" + +------------------------------------------------------------------------------- +-- Fold specific tests +------------------------------------------------------------------------------- + intMin :: Int intMin = minBound intMax :: Int intMax = maxBound -maxStreamLen :: Int -maxStreamLen = 1000 - -lesser :: (a -> a -> Ordering) -> a -> a -> a -lesser f x y = if f x y == LT then x else y - greater :: (a -> a -> Ordering) -> a -> a -> a greater f x y = if f x y == GT then x else y @@ -67,9 +67,6 @@ headl :: [a] -> Maybe a headl [] = Nothing headl (x:_) = Just x -chooseFloat :: (Float, Float) -> Gen Float -chooseFloat = choose - nth :: Int -> [a] -> Maybe a nth idx (x : xs) | idx == 0 = Just x @@ -83,64 +80,9 @@ neg f x = not (f x) predicate :: Int -> Bool predicate x = x * x < 100 -rollingHashFirstN :: Property -rollingHashFirstN = - forAll (choose (0, maxStreamLen)) $ \len -> - forAll (choose (0, len)) $ \n -> - forAll (vectorOf len (arbitrary :: Gen Int)) $ \vec -> - monadicIO $ do - a <- run - $ Stream.fold Fold.rollingHash - $ Stream.take n - $ Stream.fromList vec - b <- run - $ Stream.fold (Fold.rollingHashFirstN n) - $ Stream.fromList vec - assert $ a == b - head :: [Int] -> Expectation head ls = Stream.fold Fold.one (Stream.fromList ls) `shouldReturn` headl ls -sum :: [Int] -> Expectation -sum ls = Stream.fold Fold.sum (Stream.fromList ls) `shouldReturn` Prelude.sum ls - -product :: [Int] -> Expectation -product ls = - Stream.fold Fold.product (Stream.fromList ls) - `shouldReturn` Prelude.product ls - -maximumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation -maximumBy genmin f ls = - Stream.fold (Fold.maximumBy f) (Stream.fromList ls) - `shouldReturn` foldMaybe (greater f) genmin ls - -maximum :: (Show a, Ord a) => a -> [a] -> Expectation -maximum genmin ls = - Stream.fold Fold.maximum (Stream.fromList ls) - `shouldReturn` foldMaybe (greater compare) genmin ls - -minimumBy :: (Ord a, Show a) => a -> (a -> a -> Ordering) -> [a] -> Expectation -minimumBy genmax f ls = - Stream.fold (Fold.minimumBy f) (Stream.fromList ls) - `shouldReturn` foldMaybe (lesser f) genmax ls - -minimum :: (Show a, Ord a) => a -> [a] -> Expectation -minimum genmax ls = - Stream.fold Fold.minimum (Stream.fromList ls) - `shouldReturn` foldMaybe (lesser compare) genmax ls - -mean :: Property -mean = - forAll (listOf1 (chooseFloat (-100.0, 100.0))) - $ \ls0 -> withNumTests 1000 $ monadicIO $ action ls0 - - where - - action ls = do - v1 <- run $ Stream.fold Fold.mean (Stream.fromList ls) - let v2 = Prelude.sum ls / fromIntegral (Prelude.length ls) - assert (abs (v1 - v2) < 0.0001) - stdDev :: Property stdDev = forAll (listOf1 (chooseFloat (-100.0, 100.0))) @@ -169,42 +111,6 @@ variance = vr = se / fromIntegral (Prelude.length ls) assert (abs (v1 - vr) < 0.01) -mconcat :: Property -mconcat = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - v1 <- run $ Stream.fold Fold.mconcat (fmap Sum $ Stream.fromList ls) - let v2 = Prelude.sum ls - assert (getSum v1 == v2) - -foldMap :: Property -foldMap = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - v1 <- run $ Stream.fold (Fold.foldMap Sum) $ Stream.fromList ls - let v2 = Prelude.sum ls - assert (getSum v1 == v2) - -foldMapM :: Property -foldMapM = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - v1 <- run $ Stream.fold (Fold.foldMapM (return . Sum)) $ Stream.fromList ls - let v2 = Prelude.sum ls - assert (getSum v1 == v2) - drainBy :: [Int] -> Expectation drainBy ls = Stream.fold (Fold.drainBy return) (Stream.fromList ls) `shouldReturn` () @@ -307,40 +213,6 @@ and ls = Stream.fold Fold.and (Stream.fromList ls) `shouldReturn` Prelude.and ls or :: [Bool] -> Expectation or ls = Stream.fold Fold.or (Stream.fromList ls) `shouldReturn` Prelude.or ls -top :: Property -top = topBy True - -bottom :: Property -bottom = topBy False - -topBy :: Bool -> Property -topBy isTop = forAll (listOf (chooseInt (-50, 100))) $ \ls0 -> - monadicIO $ action ls0 - - where - - action ls = do - let n0 = Prelude.length ls - n <- liftIO $ generate $ chooseInt (-2, n0 + 2) - if isTop - then do - lst <- run $ Stream.fold (Fold.top n) (Stream.fromList ls) - >>= MArray.toList - assert ((Prelude.take n . sortBy (comparing Down)) ls == lst) - else do - lst <- run $ Stream.fold (Fold.bottom n) (Stream.fromList ls) - >>= MArray.toList - assert ((Prelude.take n . sort) ls == lst) - -mapMaybe :: [Int] -> Expectation -mapMaybe ls = - let maybeEven x = - if even x - then Just x - else Nothing - f = Fold.mapMaybe maybeEven Fold.toList - in Stream.fold f (Stream.fromList ls) `shouldReturn` filter even ls - teeWithLength :: Property teeWithLength = forAll (listOf1 (chooseInt (intMin, intMax))) @@ -367,6 +239,10 @@ teeWithMax = v3 = foldMaybe (greater compare) intMin ls assert (v1 == (v2, v3)) +-- In Scanl but not shared: partitionBy/partitionByM/partition diverge +-- semantically between Fold and Scanl. Fold returns the tuple of both branch +-- results; Scanl emits a single interleaved value per input (the just-updated +-- branch), so they are not the same combinator and cannot share a test. partitionByM :: Property partitionByM = forAll (listOf1 (chooseInt (intMin, intMax))) @@ -438,21 +314,6 @@ partitionByMinM2 = v3 = foldl (\b a -> if even a then b+1 else b) 0 ([1..49] :: [Int]) assert (v1 == (v2, v3)) -distribute :: Property -distribute = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - v1 <- - run $ Stream.fold (Fold.distribute [Fold.sum, Fold.length]) - $ Stream.fromList ls - let v2 = Prelude.sum ls - v3 = Prelude.length ls - assert (v1 == [v2, v3]) - partition :: Property partition = monadicIO $ do @@ -464,16 +325,6 @@ partition = let v2 = (4,["abc","xy","pp2"]) assert (v1 == v2) -unzip :: Property -unzip = - monadicIO $ do - v1 :: (Int, [String]) <- - run - $ Stream.fold (Fold.unzip Fold.sum Fold.toList) - $ Stream.fromList [(1, "aa"), (2, "bb"), (3, "cc")] - let v2 = (6, ["aa", "bb", "cc"]) - assert (v1 == v2) - splitAt :: Expectation splitAt = Stream.fold @@ -482,125 +333,6 @@ splitAt = `shouldReturn` ("Hello ","World!") -------------------------------------------------------------------------------- --- Accumulators -------------------------------------------------------------------------------- - -sconcat :: Expectation -sconcat = - Stream.fold (Fold.sconcat (Sum 10)) (fmap Sum $ Stream.fromList [1,2,3 :: Int]) - `shouldReturn` Sum 16 - -drainMapM :: Expectation -drainMapM = - Stream.fold (Fold.drainMapM return) (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` () - -the :: Expectation -the = do - Stream.fold Fold.the (Stream.fromList [3,3,3 :: Int]) - `shouldReturn` Just 3 - Stream.fold Fold.the (Stream.fromList [3,3,4 :: Int]) - `shouldReturn` Nothing - Stream.fold Fold.the (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - -rollingHash :: [Int] -> Expectation -rollingHash ls = do - h1 <- Stream.fold Fold.rollingHash (Stream.fromList ls) - h2 <- Stream.fold Fold.rollingHash (Stream.fromList ls) - h1 `shouldBe` h2 - -rollingHashWithSalt :: [Int] -> Expectation -rollingHashWithSalt ls = do - h1 <- Stream.fold (Fold.rollingHashWithSalt 0) (Stream.fromList ls) - h2 <- Stream.fold (Fold.rollingHashWithSalt 0) (Stream.fromList ls) - h1 `shouldBe` h2 - -rangeBy :: Expectation -rangeBy = do - Stream.fold (Fold.rangeBy compare) (Stream.fromList [3,1,4,1,5,9,2,6 :: Int]) - `shouldReturn` Just (1,9) - Stream.fold (Fold.rangeBy compare) (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - -range :: Expectation -range = do - Stream.fold Fold.range (Stream.fromList [3,1,4,1,5,9,2,6 :: Int]) - `shouldReturn` Just (1,9) - Stream.fold Fold.range (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - -toStream :: [Int] -> Expectation -toStream ls = do - strm <- Stream.fold Fold.toStream (Stream.fromList ls) - result <- Stream.fold Fold.toList strm - result `shouldBe` ls - -toStreamRev :: [Int] -> Expectation -toStreamRev ls = do - strm <- Stream.fold Fold.toStreamRev (Stream.fromList ls) - result <- Stream.fold Fold.toList strm - result `shouldBe` reverse ls - -------------------------------------------------------------------------------- --- Scanners -------------------------------------------------------------------------------- - -rollingMap :: Expectation -rollingMap = - Stream.fold - (Fold.rollingMap (\prev cur -> Prelude.maybe 0 (cur -) prev)) - (Stream.fromList [1,3,6 :: Int]) - `shouldReturn` 3 - -rollingMapM :: Expectation -rollingMapM = - Stream.fold - (Fold.rollingMapM (\prev cur -> return $ Prelude.maybe 0 (cur -) prev)) - (Stream.fromList [1,3,6 :: Int]) - `shouldReturn` 3 - -deleteBy :: Expectation -deleteBy = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.deleteBy (==) 3) - $ Stream.fromList [1,2,3,4,3,5 :: Int] - r `shouldBe` [1,2,4,3,5] - -uniqBy :: Expectation -uniqBy = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.uniqBy (==)) - $ Stream.fromList [1,1,2,3,3,3,4 :: Int] - r `shouldBe` [1,2,3,4] - -uniq :: Expectation -uniq = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan Fold.uniq - $ Stream.fromList [1,1,2,3,3,3,4 :: Int] - r `shouldBe` [1,2,3,4] - -findIndices :: Expectation -findIndices = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.findIndices even) - $ Stream.fromList [1,2,3,4,5,6 :: Int] - r `shouldBe` [1,3,5] - -elemIndices :: Expectation -elemIndices = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.elemIndices 3) - $ Stream.fromList [1,3,2,3,4,3 :: Int] - r `shouldBe` [1,3,5] - ------------------------------------------------------------------------------- -- Singleton folds ------------------------------------------------------------------------------- @@ -620,11 +352,6 @@ maybe = do Stream.fold (Fold.maybe f) (Stream.fromList [1,2,3 :: Int]) `shouldReturn` Nothing -drainN :: Expectation -drainN = - Stream.fold (Fold.drainN 3) (Stream.fromList [1..10 :: Int]) - `shouldReturn` () - genericIndex :: Expectation genericIndex = do Stream.fold (Fold.genericIndex (2 :: Int)) (Stream.fromList [1,2,3,4,5 :: Int]) @@ -639,44 +366,6 @@ findM = do Stream.fold (Fold.findM (return . even)) (Stream.fromList [1,3,5 :: Int]) `shouldReturn` Nothing -------------------------------------------------------------------------------- --- Trimmers -------------------------------------------------------------------------------- - -takingEndByM :: Expectation -takingEndByM = do - r <- Stream.fold (Fold.takingEndByM (return . (== 3))) - (Stream.fromList [1,2,3,4,5 :: Int]) - r `shouldBe` Just 3 - -takingEndBy :: Expectation -takingEndBy = do - r <- Stream.fold (Fold.takingEndBy (== 3)) - (Stream.fromList [1,2,3,4,5 :: Int]) - r `shouldBe` Just 3 - -takingEndByM_ :: Expectation -takingEndByM_ = do - r <- Stream.fold (Fold.takingEndByM_ (return . (== 3))) - (Stream.fromList [1,2,3,4,5 :: Int]) - r `shouldBe` Nothing - -droppingWhileM :: Expectation -droppingWhileM = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.droppingWhileM (return . (< 3))) - $ Stream.fromList [1,2,3,4,5 :: Int] - r `shouldBe` [3,4,5] - -droppingWhile :: Expectation -droppingWhile = do - r <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan (Fold.droppingWhile (< 3)) - $ Stream.fromList [1,2,3,4,5 :: Int] - r `shouldBe` [3,4,5] - ------------------------------------------------------------------------------- -- Running a fold ------------------------------------------------------------------------------- @@ -704,16 +393,6 @@ slide2 = (Stream.fromList [1,3,6,10 :: Int]) `shouldReturn` 4 -indexed :: Expectation -indexed = - Stream.fold (Fold.indexed Fold.toList) (Stream.fromList ['a','b','c']) - `shouldReturn` [(0,'a'),(1,'b'),(2,'c')] - -sampleFromthen :: Expectation -sampleFromthen = - Stream.fold (Fold.sampleFromthen 0 2 Fold.toList) (Stream.fromList [1..6 :: Int]) - `shouldReturn` [1,3,5] - takeEndBySeq :: Expectation takeEndBySeq = Stream.fold @@ -737,18 +416,6 @@ distributeScan = do $ Stream.fromList [1..5 :: Int] r `shouldBe` [[], [], [2, 3], [], []] -unzipWith :: Expectation -unzipWith = - Stream.fold (Fold.unzipWith (\x -> (x, x * 2)) Fold.sum Fold.sum) - (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` (6, 12) - -unzipWithM :: Expectation -unzipWithM = - Stream.fold (Fold.unzipWithM (\x -> return (x, x * 2)) Fold.sum Fold.sum) - (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` (6, 12) - unzipWithFstM :: Property unzipWithFstM = monadicIO $ do @@ -792,21 +459,15 @@ moduleName = "Data.Fold.Combinators" main :: IO () main = hspec $ do describe moduleName $ do - prop "mconcat" mconcat - prop "foldMap" foldMap - prop "foldMapM" foldMapM + -- Tests shared with the Scanl suite (see Scanl/CommonCombinators.hs) + describe "common" commonCombinatorsSpec + + -- Before adding any tests here consider if they can be added to the + -- common tests above. prop "drainBy" drainBy prop "head" head - prop "sum" sum - prop "product" product - prop "maximumBy" $ maximumBy intMin compare - prop "maximum" $ maximum intMin - prop "minimumBy" $ minimumBy intMax compare - prop "minimum" $ minimum intMax - prop "mean" mean prop "stdDev" stdDev prop "variance" variance - prop "rollingHashFirstN" rollingHashFirstN prop "index" index prop "find" $ find predicate prop "lookup" lookup @@ -819,55 +480,24 @@ main = hspec $ do prop "any" $ any predicate prop "and" and prop "or" or - prop "top" top - prop "bottom" bottom - prop "mapMaybe" mapMaybe prop "teeWithLength" teeWithLength prop "teeWithMax" teeWithMax prop "partitionByM" partitionByM prop "partitionByFstM" partitionByFstM prop "partitionByMinM1" partitionByMinM1 prop "partitionByMinM2" partitionByMinM2 - prop "distribute" distribute prop "partition" partition - prop "unzip" unzip prop "splitAt" splitAt - it "sconcat" sconcat - it "drainMapM" drainMapM - it "the" the - prop "rollingHash" rollingHash - prop "rollingHashWithSalt" rollingHashWithSalt - it "rangeBy" rangeBy - it "range" range - prop "toStream" toStream - prop "toStreamRev" toStreamRev - it "rollingMap" rollingMap - it "rollingMapM" rollingMapM - it "deleteBy" deleteBy - it "uniqBy" uniqBy - it "uniq" uniq - it "findIndices" findIndices - it "elemIndices" elemIndices it "satisfy" satisfy it "maybe" maybe - it "drainN" drainN it "genericIndex" genericIndex it "findM" findM - it "takingEndByM" takingEndByM - it "takingEndBy" takingEndBy - it "takingEndByM_" takingEndByM_ - it "droppingWhileM" droppingWhileM - it "droppingWhile" droppingWhile prop "drive" drive it "addStream" addStream it "slide2" slide2 - it "indexed" indexed - it "sampleFromthen" sampleFromthen it "takeEndBySeq" takeEndBySeq it "takeEndBySeq_" takeEndBySeq_ it "distributeScan" distributeScan - it "unzipWith" unzipWith - it "unzipWithM" unzipWithM prop "unzipWithFstM" unzipWithFstM prop "unzipWithMinM" unzipWithMinM it "partitionBy" partitionBy diff --git a/test/Streamly/Test/Data/Fold/Container.hs b/test/Streamly/Test/Data/Fold/Container.hs index 32fc9cbfe2..6ae595f3fb 100644 --- a/test/Streamly/Test/Data/Fold/Container.hs +++ b/test/Streamly/Test/Data/Fold/Container.hs @@ -10,15 +10,16 @@ module Streamly.Test.Data.Fold.Container (main) where import qualified Data.IntSet as IntSet -import qualified Data.Map +import qualified Data.Map as Map import qualified Data.Set as Set import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Fold as F import qualified Streamly.Internal.Data.Stream as Stream +import Streamly.Test.Data.Fold.Type (check, checkPostscanl) import Test.Hspec -import Test.Hspec.QuickCheck -import Test.QuickCheck (Property) -import Test.QuickCheck.Monadic (monadicIO, assert) + +#include "Streamly/Test/Data/Scanl/CommonContainer.hs" demux :: Expectation demux = @@ -40,7 +41,7 @@ demux = (Fold.demuxKvToMap table) input `shouldReturn` - Data.Map.fromList [("PRODUCT", 8),("SUM", 4),("abc",3),("xyz",2)] + Map.fromList [("PRODUCT", 8),("SUM", 4),("abc",3),("xyz",2)] demuxWith :: Expectation demuxWith = @@ -56,7 +57,7 @@ demuxWith = (Fold.demuxToContainer getKey (getFold . getKey)) input `shouldReturn` - Data.Map.fromList [("PRODUCT",3),("SUM",6)] + Map.fromList [("PRODUCT",3),("SUM",6)] classifyWith :: Expectation classifyWith = @@ -65,7 +66,7 @@ classifyWith = (Fold.toContainer fst (Fold.lmap snd Fold.toList)) input `shouldReturn` - Data.Map.fromList + Map.fromList [("ONE",[1.0, 1.1 :: Double]), ("TWO",[2.0, 2.2])] classify :: Expectation @@ -82,7 +83,7 @@ classify = (Fold.kvToMap (Fold.lmap snd Fold.toList)) input `shouldReturn` - Data.Map.fromList + Map.fromList [("ONE",[1.0, 1.1 :: Double]), ("TWO",[2.0, 2.2])] classifyScan :: Expectation @@ -100,48 +101,12 @@ classifyScan = (Stream.postscanlMaybe (Fold.classifyScan getKey innerFold) input) `shouldReturn` [("ONE", 4), ("TWO", 6)] -nub :: Property -nub = monadicIO $ do - vals <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan Fold.nub - $ Stream.fromList [1::Int, 1, 2, 3, 4, 4, 5, 1, 5, 7] - assert (vals == [1, 2, 3, 4, 5, 7]) - -toSet :: Expectation -toSet = - Stream.fold Fold.toSet (Stream.fromList [1,2,3,2,1 :: Int]) - `shouldReturn` Set.fromList [1,2,3] - -toIntSet :: Expectation -toIntSet = - Stream.fold Fold.toIntSet (Stream.fromList [1,2,3,2,1 :: Int]) - `shouldReturn` IntSet.fromList [1,2,3] - -countDistinct :: Expectation -countDistinct = - Stream.fold Fold.countDistinct (Stream.fromList [1,2,3,2,1 :: Int]) - `shouldReturn` 3 - -countDistinctInt :: Expectation -countDistinctInt = - Stream.fold Fold.countDistinctInt (Stream.fromList [1,2,3,2,1 :: Int]) - `shouldReturn` 3 - -nubInt :: Property -nubInt = monadicIO $ do - vals <- Stream.fold Fold.toList - $ Stream.catMaybes - $ Stream.postscan Fold.nubInt - $ Stream.fromList [1::Int, 1, 2, 3, 4, 4, 5, 1, 5, 7] - assert (vals == [1, 2, 3, 4, 5, 7]) - frequency :: Expectation frequency = Stream.fold Fold.frequency (Stream.fromList ["a","b","a","c","b","a" :: String]) `shouldReturn` - Data.Map.fromList [("a",3),("b",2),("c",1)] + Map.fromList [("a",3),("b",2),("c",1)] demuxerToMap :: Expectation demuxerToMap = @@ -154,7 +119,7 @@ demuxerToMap = (Fold.demuxerToMap getKey getFold) input `shouldReturn` - Data.Map.fromList [("SUM", 4 :: Int), ("X", 3)] + Map.fromList [("SUM", 4 :: Int), ("X", 3)] demuxerToContainer :: Expectation demuxerToContainer = @@ -167,7 +132,7 @@ demuxerToContainer = (Fold.demuxerToContainer getKey getFold) input `shouldReturn` - Data.Map.fromList [("SUM", 4 :: Int), ("X", 3)] + Map.fromList [("SUM", 4 :: Int), ("X", 3)] demuxKvToContainer :: Expectation demuxKvToContainer = @@ -180,7 +145,7 @@ demuxKvToContainer = (Fold.demuxKvToContainer table) input `shouldReturn` - Data.Map.fromList [("PRODUCT",8 :: Int),("SUM",4)] + Map.fromList [("PRODUCT",8 :: Int),("SUM",4)] toMap :: Expectation toMap = @@ -189,7 +154,7 @@ toMap = (Fold.toMap fst (Fold.lmap snd Fold.toList)) input `shouldReturn` - Data.Map.fromList [("ONE",[1.0,1.1 :: Double]), ("TWO",[2.0,2.2])] + Map.fromList [("ONE",[1.0,1.1 :: Double]), ("TWO",[2.0,2.2])] demuxScan :: Expectation demuxScan = do @@ -208,17 +173,16 @@ moduleName = "Data.Fold.Container" main :: IO () main = hspec $ do describe moduleName $ do - prop "demux" demux - prop "demuxWith" demuxWith - prop "classifyWith" classifyWith - prop "classify" classify - prop "classifyScan" classifyScan - prop "nub" nub - it "toSet" toSet - it "toIntSet" toIntSet - it "countDistinct" countDistinct - it "countDistinctInt" countDistinctInt - prop "nubInt" nubInt + describe "common" commonContainerSpec + + -- Before adding any tests here consider if it can be added to the + -- common tests above. + + it "demux" demux + it "demuxWith" demuxWith + it "classifyWith" classifyWith + it "classify" classify + it "classifyScan" classifyScan it "frequency" frequency it "demuxerToMap" demuxerToMap it "demuxerToContainer" demuxerToContainer diff --git a/test/Streamly/Test/Data/Fold/Type.hs b/test/Streamly/Test/Data/Fold/Type.hs index 291ed86a9c..632dde24b5 100644 --- a/test/Streamly/Test/Data/Fold/Type.hs +++ b/test/Streamly/Test/Data/Fold/Type.hs @@ -7,10 +7,12 @@ -- Stability : experimental -- Portability : GHC -module Streamly.Test.Data.Fold.Type (main) where +module Streamly.Test.Data.Fold.Type + (main, check, checkApprox, checkPostscanl) where import Data.Functor.Identity (Identity(..), runIdentity) import qualified Streamly.Internal.Data.Fold as Fold +import qualified Streamly.Internal.Data.Fold as F import qualified Streamly.Internal.Data.Scanl as Scanl import qualified Streamly.Internal.Data.Stream as Stream @@ -23,6 +25,37 @@ import Test.Hspec.QuickCheck import Test.QuickCheck (Property, forAll, listOf, listOf1, property) import Test.QuickCheck.Monadic (monadicIO, assert, run) +------------------------------------------------------------------------------- +-- Shared Fold/Scanl tests (see Scanl/CommonType.hs) +------------------------------------------------------------------------------- + +-- | A Fold is exercised by folding a stream to a single final value. The shared +-- @expected@ value is the inclusive prescan list; the fold result is its last +-- element. +type Op = F.Fold + +check :: (Eq b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +check cons xs expected = + Stream.fold cons (Stream.fromList xs) `shouldReturn` Prelude.last expected + +-- | Epsilon-equality counterpart of 'check' for Fractional results whose +-- floating-point output is only approximately equal to the reference (e.g. +-- 'mean'). The fold result must be within 1e-4 of the last expected prescan +-- value. +checkApprox :: + (Ord b, Fractional b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +checkApprox cons xs expected = do + res <- Stream.fold cons (Stream.fromList xs) + res `shouldSatisfy` \r -> abs (r - Prelude.last expected) < 1e-4 + +-- | Postscan-only counterpart of 'check' (for combinators whose scanl initial +-- is undefined). The fold result equals the last postscanl output. +checkPostscanl :: (Eq b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +checkPostscanl cons xs expected = + Stream.fold cons (Stream.fromList xs) `shouldReturn` Prelude.last expected + +#include "Streamly/Test/Data/Scanl/CommonType.hs" + intMin :: Int intMin = minBound @@ -92,9 +125,6 @@ foldrM' ls = -- Folds ------------------------------------------------------------------------------- -drain :: [Int] -> Expectation -drain ls = Stream.fold Fold.drain (Stream.fromList ls) `shouldReturn` () - fromPure :: Expectation fromPure = Stream.fold (Fold.fromPure (42 :: Int)) (Stream.fromList [1,2,3 :: Int]) @@ -112,18 +142,6 @@ fromScanl ls = Stream.fold (Fold.fromScanl (Scanl.scanl' (+) 0)) (Stream.fromList ls) `shouldReturn` Prelude.sum ls -length :: [Int] -> Expectation -length ls = - Stream.fold Fold.length (Stream.fromList ls) - `shouldReturn` Prelude.length ls - -toList :: [Int] -> Expectation -toList ls = Stream.fold Fold.toList (Stream.fromList ls) `shouldReturn` ls - -toListRev :: [Int] -> Expectation -toListRev ls = - Stream.fold Fold.toListRev (Stream.fromList ls) `shouldReturn` reverse ls - toStreamK :: [Int] -> Expectation toStreamK ls = do sk <- Stream.fold Fold.toStreamK (Stream.fromList ls) @@ -136,49 +154,9 @@ toStreamKRev ls = do result <- Stream.fold Fold.toList (Stream.fromStreamK sk) result `shouldBe` reverse ls -genericLength :: [Int] -> Expectation -genericLength ls = - Stream.fold (Fold.genericLength :: Fold.Fold IO Int Int) (Stream.fromList ls) - `shouldReturn` Prelude.length ls - -latest :: Expectation -latest = do - Stream.fold Fold.latest (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` Just 3 - Stream.fold Fold.latest (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - last :: [String] -> Expectation last ls = Stream.fold Fold.last (Stream.fromList ls) `shouldReturn` safeLast ls -------------------------------------------------------------------------------- --- Mapping -------------------------------------------------------------------------------- - -rmapM :: Property -rmapM = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - let addLen x = return $ x + Prelude.length ls - fld = Fold.rmapM addLen Fold.sum - v2 = foldl (+) (Prelude.length ls) ls - v1 <- run $ Stream.fold fld $ Stream.fromList ls - assert (v1 == v2) - -lmap :: [Int] -> Expectation -lmap ls = - Stream.fold (Fold.lmap (* 2) Fold.sum) (Stream.fromList ls) - `shouldReturn` Prelude.sum (fmap (* 2) ls) - -lmapM :: [Int] -> Expectation -lmapM ls = - Stream.fold (Fold.lmapM (\x -> return (x * 2)) Fold.sum) (Stream.fromList ls) - `shouldReturn` Prelude.sum (fmap (* 2) ls) - ------------------------------------------------------------------------------- -- Scanning ------------------------------------------------------------------------------- @@ -245,17 +223,34 @@ postscanlMaybe = (Stream.fromList [1,2,3,4,5,6 :: Int]) `shouldReturn` [2,4,6] +-- When the scanner is Done at the initial step it consumes no input, so with +-- postscanl the collector sees nothing, whereas with scanl it sees the default +-- (initial) value. +postscanlDoneAtInit :: Expectation +postscanlDoneAtInit = + Stream.fold + (Fold.postscanl (Scanl.take 0 Scanl.sum) Fold.toList) + (Stream.fromList [1,2,3 :: Int]) + `shouldReturn` [] + +scanlDoneAtInit :: Expectation +scanlDoneAtInit = + Stream.fold + (Fold.scanl (Scanl.take 0 Scanl.sum) Fold.toList) + (Stream.fromList [1,2,3 :: Int]) + `shouldReturn` [0] + +postscanlMaybeDoneAtInit :: Expectation +postscanlMaybeDoneAtInit = + Stream.fold + (Fold.postscanlMaybe (fmap Just (Scanl.take 0 Scanl.sum)) Fold.toList) + (Stream.fromList [1,2,3 :: Int]) + `shouldReturn` ([] :: [Int]) + ------------------------------------------------------------------------------- -- Filtering ------------------------------------------------------------------------------- -catMaybes :: Expectation -catMaybes = - Stream.fold - (Fold.catMaybes Fold.toList) - (Stream.fromList [Just 1, Nothing, Just 3, Nothing, Just 5 :: Maybe Int]) - `shouldReturn` [1,3,5] - scanMaybe :: Expectation scanMaybe = Stream.fold @@ -265,74 +260,10 @@ scanMaybe = (Stream.fromList [1,2,3,4,5,6 :: Int]) `shouldReturn` [2,4,6] -filter :: [Int] -> Expectation -filter ls = - Stream.fold (Fold.filter even Fold.toList) (Stream.fromList ls) - `shouldReturn` Prelude.filter even ls - -filtering :: Expectation -filtering = do - Stream.fold (Fold.filtering even) (Stream.fromList [1,2,3,4,5 :: Int]) - `shouldReturn` Nothing - Stream.fold (Fold.filtering even) (Stream.fromList [1,2,3,4 :: Int]) - `shouldReturn` Just 4 - Stream.fold (Fold.filtering even) (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - -filterM :: [Int] -> Expectation -filterM ls = - Stream.fold (Fold.filterM (return . even) Fold.toList) (Stream.fromList ls) - `shouldReturn` Prelude.filter even ls - -catLefts :: Expectation -catLefts = - Stream.fold - (Fold.catLefts Fold.toList) - (Stream.fromList [Left 1, Right "a", Left 3, Right "b" :: Either Int String]) - `shouldReturn` [1,3] - -catRights :: Expectation -catRights = - Stream.fold - (Fold.catRights Fold.toList) - (Stream.fromList [Left "a", Right 2, Left "b", Right 4 :: Either String Int]) - `shouldReturn` [2,4] - -catEithers :: Expectation -catEithers = - Stream.fold - (Fold.catEithers Fold.toList) - (Stream.fromList [Left 1, Right 2, Left 3, Right 4 :: Either Int Int]) - `shouldReturn` [1,2,3,4] - ------------------------------------------------------------------------------- -- Trimming ------------------------------------------------------------------------------- -take :: [Int] -> Property -take ls = - forAll (chooseInt (-1, Prelude.length ls + 2)) $ \n -> - Stream.fold (Fold.take n Fold.toList) (Stream.fromList ls) - `shouldReturn` Prelude.take n ls - -taking :: Expectation -taking = do - Stream.fold (Fold.taking 3) (Stream.fromList [1,2,3,4,5 :: Int]) - `shouldReturn` Just 3 - Stream.fold (Fold.taking 0) (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` Nothing - Stream.fold (Fold.taking 3) (Stream.fromList ([] :: [Int])) - `shouldReturn` Nothing - -dropping :: Expectation -dropping = do - Stream.fold (Fold.dropping 2) (Stream.fromList [1,2,3,4,5 :: Int]) - `shouldReturn` Just 5 - Stream.fold (Fold.dropping 0) (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` Just 3 - Stream.fold (Fold.dropping 10) (Stream.fromList [1,2,3 :: Int]) - `shouldReturn` Nothing - takeEndBy_ :: Property takeEndBy_ = forAll (listOf (chooseInt (0, 1))) $ \ls -> @@ -461,22 +392,6 @@ duplicate = do -- Parallel distribution ------------------------------------------------------------------------------- -teeWith :: Property -teeWith = - forAll (listOf1 (chooseInt (intMin, intMax))) - $ \ls0 -> monadicIO $ action ls0 - - where - - action ls = do - v1 <- - run - $ Stream.fold (Fold.teeWith (,) Fold.sum Fold.length) - $ Stream.fromList ls - let v2 = Prelude.sum ls - v3 = Prelude.length ls - assert (v1 == (v2, v3)) - teeWithFstLength :: Property teeWithFstLength = forAll (listOf1 (chooseInt (intMin, intMax))) @@ -607,24 +522,6 @@ isClosed = do b2 <- Fold.isClosed closed b2 `shouldBe` True -------------------------------------------------------------------------------- --- Transforming inner monad -------------------------------------------------------------------------------- - -morphInner :: Expectation -morphInner = do - let identityFold = Fold.foldl' (+) (0 :: Int) - ioFold = Fold.morphInner (return . runIdentity) identityFold - result <- Stream.fold ioFold (Stream.fromList [1,2,3]) - result `shouldBe` 6 - -generalizeInner :: Expectation -generalizeInner = do - let identityFold = Fold.foldl' (+) (0 :: Int) :: Fold.Fold Identity Int Int - ioFold = Fold.generalizeInner identityFold - result <- Stream.fold ioFold (Stream.fromList [1,2,3]) - result `shouldBe` 6 - ------------------------------------------------------------------------------- -- foldBreak ------------------------------------------------------------------------------- @@ -648,6 +545,18 @@ moduleName = "Data.Fold.Type" main :: IO () main = hspec $ do describe moduleName $ do + -- Tests shared with the Scanl suite (see Scanl/CommonType.hs) + describe "common" commonTypeSpec + + -- Even though the following operations are common with scans, we have + -- some additional tests which are not written in a way which can be + -- shared with scans. + prop "takeEndBy_" takeEndBy_ + it "takeEndBy" takeEndBy + prop "takeEndByOrMax" takeEndByOrMax + + -- Before adding any tests here consider if it can be added to the + -- common tests above. prop "foldl'" foldl' prop "foldlM'" foldlM' it "foldl1'" foldl1' @@ -657,38 +566,21 @@ main = hspec $ do it "fromPure" fromPure it "fromEffect" fromEffect prop "fromScanl" fromScanl - prop "drain" drain - prop "length" length - prop "toList" toList - prop "toListRev" toListRev prop "toStreamK" toStreamK prop "toStreamKRev" toStreamKRev - prop "genericLength" genericLength - it "latest" latest prop "last" last - prop "rmapM" rmapM - prop "lmap" lmap - prop "lmapM" lmapM prop "scan" scan prop "postscan" postscan prop "postscanl" postscanl prop "scanl" scanlFold prop "scanlMany" scanlMany it "postscanlMaybe" postscanlMaybe - it "catMaybes" catMaybes + it "postscanl done-at-init" postscanlDoneAtInit + it "postscanlMaybe done-at-init" postscanlMaybeDoneAtInit + it "scanl done-at-init" scanlDoneAtInit it "scanMaybe" scanMaybe - prop "filter" filter - it "filtering" filtering - prop "filterM" filterM - it "catLefts" catLefts - it "catRights" catRights - it "catEithers" catEithers - prop "take" take - it "taking" taking - it "dropping" dropping - prop "takeEndBy_" takeEndBy_ - it "takeEndBy" takeEndBy - prop "takeEndByOrMax" takeEndByOrMax + + it "foldMaybes" foldMaybes it "foldEithers" foldEithers it "ifThen" ifThen @@ -698,7 +590,6 @@ main = hspec $ do it "groupsOf" groupsOf it "concatMap" concatMap it "duplicate" duplicate - prop "teeWith" teeWith prop "teeWithFstLength" teeWithFstLength prop "teeWithMinLength1" teeWithMinLength1 prop "teeWithMinLength2" teeWithMinLength2 @@ -713,6 +604,4 @@ main = hspec $ do it "finalM" finalM it "close" closeFold it "isClosed" isClosed - it "morphInner" morphInner - it "generalizeInner" generalizeInner prop "foldBreak" foldBreak diff --git a/test/Streamly/Test/Data/Parser.hs b/test/Streamly/Test/Data/Parser.hs index 83e452d263..594473dcdd 100644 --- a/test/Streamly/Test/Data/Parser.hs +++ b/test/Streamly/Test/Data/Parser.hs @@ -5,9 +5,7 @@ #endif module Main (main) where -import Control.Applicative ((<|>)) import Control.Exception (displayException) -import Control.Monad.IO.Class (MonadIO(..)) import Data.Char (isSpace) import Data.Foldable (for_) import Data.Word (Word8, Word32, Word64) @@ -17,7 +15,9 @@ import Test.QuickCheck.Monadic (monadicIO, assert, run) import Prelude hiding (sequence) +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) import qualified Streamly.Test.Data.Parser.CommonTests as Common +import qualified Streamly.Test.Data.Parser.Type as Type import qualified Streamly.Data.Stream as S import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.Fold as FL @@ -115,20 +115,6 @@ parseMany = listEquals (==) outs ins -parserSequence :: Property -parserSequence = - forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ins -> - monadicIO $ do - let parsers = S.fromList - $ fmap (\xs -> P.fromFold $ FL.take (length xs) FL.sum) ins - let sequencedParser = P.sequence parsers FL.sum - outs <- - S.parse sequencedParser $ S.concatMap S.fromList (S.fromList ins) - return $ - case outs of - Right x -> x == sum (map sum ins) - Left _ -> False - ------------------------------------------------------------------------------- -- Test for a particular case hit during fs events testing ------------------------------------------------------------------------------- @@ -308,18 +294,6 @@ sanityParseIterate jumps = it (show jumps) $ do $ SI.parseIteratePos (const (jumpParser jumps)) [] $ S.fromList tape res `shouldBe` (expectedResultMany jumps tape) -------------------------------------------------------------------------------- --- Instances -------------------------------------------------------------------------------- - -{-# INLINE alt #-} -alt :: MonadIO m => S.Stream m Int -> m (Either P.ParseError [Int]) -alt = - S.parse - ( Common.takeWhileFailD (<= 5) FL.toList - <|> P.takeWhile (<= 7) FL.toList - ) - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -333,15 +307,14 @@ main = do H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do - Common.mainCommon Common.TMParserStream + Type.spec + Common.mainCommon TMParserStream parserSanityTests "Stream.parseBreak" sanityParseBreak - -- parserSanityTests "A.sanityParseBreakChunksK" sanityParseBreakChunksK parserSanityTests "Stream.parseMany" sanityParseMany parserSanityTests "Stream.parseIterate" sanityParseIterate describe "Stream parsing" $ do prop "parseMany" parseMany prop "parseMany2Events" parseMany2Events - prop "parserSequence" parserSequence describe "test for sequence parser" $ do parseManyWordQuotedBy @@ -356,5 +329,3 @@ main = do quotedWordTest "\"hello\\\"\\\\w\\'orld\"" ["hello\"\\w\\'orld"] - - it "alt [1..20]" $ alt (S.fromList [1..20]) `shouldReturn` Right [1..7] diff --git a/test/Streamly/Test/Data/Parser/Type.hs b/test/Streamly/Test/Data/Parser/Type.hs new file mode 100644 index 0000000000..7a200f3a51 --- /dev/null +++ b/test/Streamly/Test/Data/Parser/Type.hs @@ -0,0 +1,13 @@ +module Streamly.Test.Data.Parser.Type (spec) where + +import Test.Hspec + +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) +import qualified Streamly.Test.Data.Parser.CommonTypeTests as CommonType + +------------------------------------------------------------------------------- +-- Spec +------------------------------------------------------------------------------- + +spec :: Spec +spec = CommonType.mainCommonType TMParserStream diff --git a/test/Streamly/Test/Data/ParserK.hs b/test/Streamly/Test/Data/ParserK.hs index 55c06b63d7..afea0361cb 100644 --- a/test/Streamly/Test/Data/ParserK.hs +++ b/test/Streamly/Test/Data/ParserK.hs @@ -5,101 +5,23 @@ module Main (main) where -import Control.Applicative ((<|>)) -import Control.Monad.IO.Class (MonadIO(..)) -import Data.Either (fromRight) -import Streamly.Internal.Data.Parser (ParseError(..)) -import Test.Hspec (Spec, hspec, describe, it, expectationFailure, shouldBe, shouldReturn) +import Test.Hspec (hspec, describe, it, shouldBe) import Test.Hspec.QuickCheck -import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Parser as Parser import qualified Streamly.Internal.Data.ParserK as ParserK -import qualified Streamly.Internal.Data.Stream as Stream import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Test.Hspec as H +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) import Streamly.Test.Data.Parser.CommonUtilities import qualified Streamly.Test.Data.Parser.CommonTests as Common +import qualified Streamly.Test.Data.ParserK.Type as Type import Prelude hiding (sequence) maxTestCount :: Int maxTestCount = 100 -toParser :: Spec -toParser = do - let p = ParserK.toParser (ParserK.toParserK Parser.one) - runP xs = Stream.parsePos p (Stream.fromList xs) - describe "toParser . toParserK" $ do - it "empty stream" $ do - r1 <- runP ([] :: [Int]) - case r1 of - Left e -> print e - Right x -> - expectationFailure $ "Expecting failure, got: " ++ show x - it "exact stream" $ do - r2 <- runP [0::Int] - fromRight undefined r2 `shouldBe` 0 - it "longer stream" $ do - r3 <- runP [0,1::Int] - fromRight undefined r3 `shouldBe` 0 - - let p1 = ParserK.toParserK $ ParserK.toParser (ParserK.toParserK Parser.one) - runP1 xs = StreamK.parsePos p1 (StreamK.fromStream $ Stream.fromList xs) - describe "toParserK . toParser . toParserK" $ do - it "empty stream" $ do - r1 <- runP1 ([] :: [Int]) - case r1 of - Left e -> print e - Right x -> - expectationFailure $ "Expecting failure, got: " ++ show x - it "exact stream" $ do - r2 <- runP1 [0::Int] - fromRight undefined r2 `shouldBe` 0 - it "longer stream" $ do - r3 <- runP1 [0,1::Int] - fromRight undefined r3 `shouldBe` 0 - - -- NOTE: Without fusionBreaker this test would pass even if toParser has - -- incorrect implementation because of fusion rules. - let p2 = Parser.takeWhile (<= 3) FL.toList - runP2 xs = Stream.parseBreakPos p2 (Stream.fromList xs) - - p3 = ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList) - runP3 xs = StreamK.parseBreakPos p3 (StreamK.fromList xs) - - p4 = - ParserK.toParser - $ fusionBreaker - $ ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList) - runP4 xs = Stream.parseBreakPos p4 (Stream.fromList xs) - describe "toParser . toParserK" $ do - it "(<= 3) for [1, 2, 3, 4, 5]" $ do - (a, b) <- runP2 ([1, 2, 3, 4, 5] :: [Int]) - fromRight undefined a `shouldBe` [1, 2, 3] - rest <- Stream.toList b - rest `shouldBe` [4, 5] - it "(<= 3) for [1, 2, 3, 4, 5]" $ do - (a, b) <- runP3 ([1, 2, 3, 4, 5] :: [Int]) - fromRight undefined a `shouldBe` [1, 2, 3] - rest <- StreamK.toList b - rest `shouldBe` [4, 5] - it "(<= 3) for [1, 2, 3, 4, 5]" $ do - (a, b) <- runP4 ([1, 2, 3, 4, 5] :: [Int]) - fromRight undefined a `shouldBe` [1,2,3] - rest <- Stream.toList b - rest `shouldBe` [4, 5] - it "(<= 3) for [1, 2, 3]" $ do - (a, b) <- runP4 ([1, 2, 3] :: [Int]) - fromRight undefined a `shouldBe` [1, 2, 3] - rest <- Stream.toList b - rest `shouldBe` [] - -{-# NOINLINE fusionBreaker #-} -fusionBreaker :: a -> a -fusionBreaker = id - ------------------------------------------------------------------------------- -- Parser driver sanity tests ------------------------------------------------------------------------------- @@ -112,28 +34,6 @@ sanityParseBreak jumps = it (show jumps) $ do lst <- StreamK.toList rest (val, lst) `shouldBe` (expectedResult jumps tape) - -------------------------------------------------------------------------------- --- Instances -------------------------------------------------------------------------------- - -{-# INLINE takeWhileFail #-} -takeWhileFail :: MonadIO m => - (a -> Bool) -> FL.Fold m a b -> ParserK.ParserK a m b -takeWhileFail p f = ParserK.toParserK (Common.takeWhileFailD p f) - -{-# INLINE takeWhileK #-} -takeWhileK :: MonadIO m => (a -> Bool) -> ParserK.ParserK a m [a] -takeWhileK p = ParserK.toParserK $ Parser.takeWhile p FL.toList - -{-# INLINE alt2 #-} -alt2 :: MonadIO m => StreamK.StreamK m Int -> m (Either ParseError [Int]) -alt2 = - StreamK.parse - ( takeWhileFail (<= 5) FL.toList - <|> takeWhileK (<= 7) - ) - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- @@ -147,7 +47,6 @@ main = H.parallel $ modifyMaxSuccess (const maxTestCount) $ do describe moduleName $ do - Common.mainCommon Common.TMParserKStreamK - toParser + Type.spec + Common.mainCommon TMParserKStreamK parserSanityTests "StreamK.parseBreak" sanityParseBreak - it "alt2 [1..20]" $ alt2 (StreamK.fromList [1..20]) `shouldReturn` Right [1..7] diff --git a/test/Streamly/Test/Data/ParserK/Chunked.hs b/test/Streamly/Test/Data/ParserK/Chunked.hs index 0a420dd5fc..30930b51a3 100644 --- a/test/Streamly/Test/Data/ParserK/Chunked.hs +++ b/test/Streamly/Test/Data/ParserK/Chunked.hs @@ -7,8 +7,10 @@ import qualified Streamly.Internal.Data.Array as A import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Test.Hspec as H +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) import Streamly.Test.Data.Parser.CommonUtilities import qualified Streamly.Test.Data.Parser.CommonTests as Common +import qualified Streamly.Test.Data.Parser.CommonTypeTests as CommonType maxTestCount :: Int maxTestCount = 100 @@ -30,5 +32,6 @@ main = H.parallel $ modifyMaxSuccess (const maxTestCount) $ describe moduleName $ do - Common.mainCommon Common.TMParserKStreamKChunks + CommonType.mainCommonType TMParserKStreamKChunks + Common.mainCommon TMParserKStreamKChunks parserSanityTests "StreamK.parseBreakChunks" sanityParseBreakChunks diff --git a/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs b/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs index 496bd3e0b9..995140f6f4 100644 --- a/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs +++ b/test/Streamly/Test/Data/ParserK/ChunkedGeneric.hs @@ -7,8 +7,10 @@ import qualified Streamly.Internal.Data.Array.Generic as AG import qualified Streamly.Internal.Data.StreamK as StreamK import qualified Test.Hspec as H +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) import Streamly.Test.Data.Parser.CommonUtilities import qualified Streamly.Test.Data.Parser.CommonTests as Common +import qualified Streamly.Test.Data.Parser.CommonTypeTests as CommonType maxTestCount :: Int maxTestCount = 100 @@ -30,5 +32,6 @@ main = H.parallel $ modifyMaxSuccess (const maxTestCount) $ describe moduleName $ do - Common.mainCommon Common.TMParserKStreamKChunksGeneric + CommonType.mainCommonType TMParserKStreamKChunksGeneric + Common.mainCommon TMParserKStreamKChunksGeneric parserSanityTests "StreamK.parseBreakChunksGeneric" sanityParseBreakChunksGeneric diff --git a/test/Streamly/Test/Data/ParserK/Type.hs b/test/Streamly/Test/Data/ParserK/Type.hs new file mode 100644 index 0000000000..f4748e828f --- /dev/null +++ b/test/Streamly/Test/Data/ParserK/Type.hs @@ -0,0 +1,100 @@ +module Streamly.Test.Data.ParserK.Type (spec) where + +import Data.Either (fromRight) +import Test.Hspec + (Spec, describe, it, expectationFailure, shouldBe) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Parser as Parser +import qualified Streamly.Internal.Data.ParserK as ParserK +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.StreamK as StreamK + +import Streamly.Test.Data.Parser.CommonTestDriver (TestMode(..)) +import qualified Streamly.Test.Data.Parser.CommonTypeTests as CommonType + +------------------------------------------------------------------------------- +-- Adapting from/to Parser +------------------------------------------------------------------------------- + +toParser :: Spec +toParser = do + let p = ParserK.toParser (ParserK.toParserK Parser.one) + runP xs = Stream.parsePos p (Stream.fromList xs) + describe "toParser . toParserK" $ do + it "empty stream" $ do + r1 <- runP ([] :: [Int]) + case r1 of + Left e -> print e + Right x -> + expectationFailure $ "Expecting failure, got: " ++ show x + it "exact stream" $ do + r2 <- runP [0::Int] + fromRight undefined r2 `shouldBe` 0 + it "longer stream" $ do + r3 <- runP [0,1::Int] + fromRight undefined r3 `shouldBe` 0 + + let p1 = ParserK.toParserK $ ParserK.toParser (ParserK.toParserK Parser.one) + runP1 xs = StreamK.parsePos p1 (StreamK.fromStream $ Stream.fromList xs) + describe "toParserK . toParser . toParserK" $ do + it "empty stream" $ do + r1 <- runP1 ([] :: [Int]) + case r1 of + Left e -> print e + Right x -> + expectationFailure $ "Expecting failure, got: " ++ show x + it "exact stream" $ do + r2 <- runP1 [0::Int] + fromRight undefined r2 `shouldBe` 0 + it "longer stream" $ do + r3 <- runP1 [0,1::Int] + fromRight undefined r3 `shouldBe` 0 + + -- NOTE: Without fusionBreaker this test would pass even if toParser has + -- incorrect implementation because of fusion rules. + let p2 = Parser.takeWhile (<= 3) FL.toList + runP2 xs = Stream.parseBreakPos p2 (Stream.fromList xs) + + p3 = ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList) + runP3 xs = StreamK.parseBreakPos p3 (StreamK.fromList xs) + + p4 = + ParserK.toParser + $ fusionBreaker + $ ParserK.toParserK (Parser.takeWhile (<= 3) FL.toList) + runP4 xs = Stream.parseBreakPos p4 (Stream.fromList xs) + describe "toParser . toParserK" $ do + it "(<= 3) for [1, 2, 3, 4, 5]" $ do + (a, b) <- runP2 ([1, 2, 3, 4, 5] :: [Int]) + fromRight undefined a `shouldBe` [1, 2, 3] + rest <- Stream.toList b + rest `shouldBe` [4, 5] + it "(<= 3) for [1, 2, 3, 4, 5]" $ do + (a, b) <- runP3 ([1, 2, 3, 4, 5] :: [Int]) + fromRight undefined a `shouldBe` [1, 2, 3] + rest <- StreamK.toList b + rest `shouldBe` [4, 5] + it "(<= 3) for [1, 2, 3, 4, 5]" $ do + (a, b) <- runP4 ([1, 2, 3, 4, 5] :: [Int]) + fromRight undefined a `shouldBe` [1,2,3] + rest <- Stream.toList b + rest `shouldBe` [4, 5] + it "(<= 3) for [1, 2, 3]" $ do + (a, b) <- runP4 ([1, 2, 3] :: [Int]) + fromRight undefined a `shouldBe` [1, 2, 3] + rest <- Stream.toList b + rest `shouldBe` [] + +{-# NOINLINE fusionBreaker #-} +fusionBreaker :: a -> a +fusionBreaker = id + +------------------------------------------------------------------------------- +-- Spec +------------------------------------------------------------------------------- + +spec :: Spec +spec = do + CommonType.mainCommonType TMParserKStreamK + toParser diff --git a/test/Streamly/Test/Data/RingArray.hs b/test/Streamly/Test/Data/RingArray.hs index d3cf19f0a9..483f4ad922 100644 --- a/test/Streamly/Test/Data/RingArray.hs +++ b/test/Streamly/Test/Data/RingArray.hs @@ -8,15 +8,358 @@ module Streamly.Test.Data.RingArray (main) where +import Data.Maybe (fromJust, isNothing) +import Data.Proxy (Proxy(..)) +import Data.Word (Word8) +import Streamly.Internal.Data.RingArray (RingArray) +import Streamly.Internal.Data.MutByteArray (sizeOf) import Streamly.Test.Common (performGCSweep) +import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.MutArray as MutArray import qualified Streamly.Internal.Data.Array as Array import qualified Streamly.Internal.Data.RingArray as RingArray +import qualified Streamly.Internal.Data.Stream as Stream import Prelude as P import Test.Hspec as H +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +-- | Size of an 'Int' element in bytes. +iSize :: Int +iSize = sizeOf (Proxy :: Proxy Int) + +-- | A simple, easy to eyeball, base list. The oldest (ring head) element is +-- 10, the newest is 50. +base :: [Int] +base = [10, 20, 30, 40, 50] + +-- | Build a ring (with the head at index 0) from a list of Ints. +fromList :: [Int] -> IO (RingArray Int) +fromList xs = do + marr <- MutArray.fromList xs + pure $ fromJust $ RingArray.castMutArray marr + +-- | Build a Word8 ring (with the head at index 0) from a list of Word8. +fromListW8 :: [Word8] -> IO (RingArray Word8) +fromListW8 xs = do + marr <- MutArray.fromList xs + pure $ fromJust $ RingArray.castMutArray marr + +baseRing :: IO (RingArray Int) +baseRing = fromList base + +------------------------------------------------------------------------------- +-- Casting from MutArray +------------------------------------------------------------------------------- + +testCastMutArray :: IO () +testCastMutArray = do + marr <- MutArray.fromList base + let ring = fromJust $ RingArray.castMutArray marr + RingArray.toList ring `shouldReturn` base + +-- A sliced MutArray (one that does not start at offset 0) cannot be cast. +testCastMutArraySlice :: IO () +testCastMutArraySlice = do + marr <- MutArray.fromList base + let slc = MutArray.unsafeSliceOffLen 1 3 marr + isNothing (RingArray.castMutArray slc) `shouldBe` True + +testCastMutArrayWith :: IO () +testCastMutArrayWith = do + marr <- MutArray.fromList base + let ring = fromJust $ RingArray.castMutArrayWith 2 marr + -- Head at index 2 (value 30), reading wraps around. + RingArray.toList ring `shouldReturn` [30, 40, 50, 10, 20] + +testUnsafeCastMutArray :: IO () +testUnsafeCastMutArray = do + marr <- MutArray.fromList base + let ring = RingArray.unsafeCastMutArray marr + RingArray.toList ring `shouldReturn` base + +testUnsafeCastMutArrayWith :: IO () +testUnsafeCastMutArrayWith = do + marr <- MutArray.fromList base + let ring = RingArray.unsafeCastMutArrayWith 2 marr + RingArray.toList ring `shouldReturn` [30, 40, 50, 10, 20] + +------------------------------------------------------------------------------- +-- Size +------------------------------------------------------------------------------- + +testLength :: IO () +testLength = do + ring <- baseRing + RingArray.length ring `shouldBe` 5 + +testByteLength :: IO () +testByteLength = do + ring <- baseRing + RingArray.byteLength ring `shouldBe` 5 * iSize + +------------------------------------------------------------------------------- +-- Random access +------------------------------------------------------------------------------- + +testGetIndex :: IO () +testGetIndex = do + ring <- baseRing + RingArray.getIndex 0 ring `shouldReturn` Just 10 + RingArray.getIndex 4 ring `shouldReturn` Just 50 + -- Negative indices count from the newest element. + RingArray.getIndex (-1) ring `shouldReturn` Just 50 + RingArray.getIndex (-5) ring `shouldReturn` Just 10 + -- Out of bounds. + RingArray.getIndex (5 * iSize) ring `shouldReturn` Nothing + RingArray.getIndex (-5 * iSize) ring `shouldReturn` Nothing + +testUnsafeGetIndex :: IO () +testUnsafeGetIndex = do + ring <- baseRing + RingArray.unsafeGetIndex 0 ring `shouldReturn` 10 + RingArray.unsafeGetIndex 2 ring `shouldReturn` 30 + RingArray.unsafeGetIndex (-1) ring `shouldReturn` 50 + +testUnsafeGetHead :: IO () +testUnsafeGetHead = do + ring <- baseRing + RingArray.unsafeGetHead ring `shouldReturn` 10 + +------------------------------------------------------------------------------- +-- Moving the head +------------------------------------------------------------------------------- + +testMoveForward :: IO () +testMoveForward = do + ring <- baseRing + let ring1 = RingArray.moveForward ring + RingArray.unsafeGetHead ring1 `shouldReturn` 20 + RingArray.toList ring1 `shouldReturn` [20, 30, 40, 50, 10] + +testMoveReverse :: IO () +testMoveReverse = do + ring <- baseRing + -- Moving back from the oldest element wraps to the newest. + let ring1 = RingArray.moveReverse ring + RingArray.unsafeGetHead ring1 `shouldReturn` 50 + RingArray.toList ring1 `shouldReturn` [50, 10, 20, 30, 40] + +testMoveBy :: IO () +testMoveBy = do + ring <- baseRing + RingArray.toList (RingArray.moveBy 0 ring) `shouldReturn` base + RingArray.toList (RingArray.moveBy 2 ring) `shouldReturn` [30, 40, 50, 10, 20] + RingArray.toList (RingArray.moveBy (-2) ring) + `shouldReturn` [40, 50, 10, 20, 30] + +testMoveRoundTrip :: IO () +testMoveRoundTrip = do + ring <- baseRing + let ring1 = RingArray.moveReverse (RingArray.moveForward ring) + RingArray.toList ring1 `shouldReturn` base + +------------------------------------------------------------------------------- +-- Streams, unfolds and conversion +------------------------------------------------------------------------------- + +testRead :: IO () +testRead = do + ring <- baseRing + Stream.toList (RingArray.read ring) `shouldReturn` base + +testReadRev :: IO () +testReadRev = do + ring <- baseRing + Stream.toList (RingArray.readRev ring) `shouldReturn` reverse base + +testReader :: IO () +testReader = do + ring <- baseRing + Stream.toList (Stream.unfold RingArray.reader ring) `shouldReturn` base + +testReaderRev :: IO () +testReaderRev = do + ring <- baseRing + Stream.toList (Stream.unfold RingArray.readerRev ring) + `shouldReturn` reverse base + +testToList :: IO () +testToList = do + ring <- baseRing + RingArray.toList ring `shouldReturn` base + +testToMutArray :: IO () +testToMutArray = do + ring <- baseRing + marr <- RingArray.toMutArray ring + MutArray.toList marr `shouldReturn` base + -- The order is head-first even when the head has moved. + marr1 <- RingArray.toMutArray (RingArray.moveBy 2 ring) + MutArray.toList marr1 `shouldReturn` [30, 40, 50, 10, 20] + +------------------------------------------------------------------------------- +-- In-place mutation +------------------------------------------------------------------------------- + +testPutIndex :: IO () +testPutIndex = do + ring <- baseRing + RingArray.putIndex 0 ring 99 + RingArray.toList ring `shouldReturn` [99, 20, 30, 40, 50] + + ring1 <- baseRing + RingArray.putIndex 2 ring1 99 + RingArray.toList ring1 `shouldReturn` [10, 20, 99, 40, 50] + + ring2 <- baseRing + RingArray.putIndex (-1) ring2 99 + RingArray.toList ring2 `shouldReturn` [10, 20, 30, 40, 99] + +testReplace_ :: IO () +testReplace_ = do + ring <- baseRing + ring1 <- RingArray.replace_ ring 99 + -- The oldest (10) is overwritten with 99 and becomes the newest. + RingArray.toList ring1 `shouldReturn` [20, 30, 40, 50, 99] + +testReplace :: IO () +testReplace = do + ring <- baseRing + (ring1, old) <- RingArray.replace ring 99 + old `shouldBe` 10 + RingArray.toList ring1 `shouldReturn` [20, 30, 40, 50, 99] + +------------------------------------------------------------------------------- +-- Casting the element type +------------------------------------------------------------------------------- + +testUnsafeCast :: IO () +testUnsafeCast = do + ring <- baseRing + let ring1 = RingArray.unsafeCast ring :: RingArray Int + RingArray.toList ring1 `shouldReturn` base + +testAsBytes :: IO () +testAsBytes = do + ring <- baseRing + let bytes = RingArray.asBytes ring + RingArray.length bytes `shouldBe` 5 * iSize + RingArray.byteLength bytes `shouldBe` 5 * iSize + +testCastJust :: IO () +testCastJust = do + ring <- baseRing + let r = RingArray.cast ring :: Maybe (RingArray Word8) + RingArray.length (fromJust r) `shouldBe` 5 * iSize + +testCastNothing :: IO () +testCastNothing = do + -- A 5-byte ring cannot be cast to Int (8 bytes): 5 is not a multiple of 8. + ring <- fromListW8 [1, 2, 3, 4, 5] + let r = RingArray.cast ring :: Maybe (RingArray Int) + isNothing r `shouldBe` True + +------------------------------------------------------------------------------- +-- Casting to MutArray +------------------------------------------------------------------------------- + +testAsMutArray :: IO () +testAsMutArray = do + ring <- baseRing + let (marr, h) = RingArray.asMutArray ring + h `shouldBe` 0 + MutArray.toList marr `shouldReturn` base + -- The underlying array is unchanged; only the head offset is returned. + let (marr1, h1) = RingArray.asMutArray (RingArray.moveBy 2 ring) + h1 `shouldBe` 2 * iSize + MutArray.toList marr1 `shouldReturn` base + +testAsMutArray_ :: IO () +testAsMutArray_ = do + ring <- baseRing + MutArray.toList (RingArray.asMutArray_ ring) `shouldReturn` base + +------------------------------------------------------------------------------- +-- Folds +------------------------------------------------------------------------------- + +testFoldlM' :: IO () +testFoldlM' = do + ring <- baseRing + r <- RingArray.foldlM' (\b a -> pure (b + a)) 0 ring + r `shouldBe` sum base + +testFold :: IO () +testFold = do + ring <- baseRing + RingArray.fold Fold.sum ring `shouldReturn` sum base + RingArray.fold Fold.toList ring `shouldReturn` base + -- Folds the whole ring starting at the head. + RingArray.fold Fold.toList (RingArray.moveBy 2 ring) + `shouldReturn` [30, 40, 50, 10, 20] + +------------------------------------------------------------------------------- +-- Debugging +------------------------------------------------------------------------------- + +testShowRing :: IO () +testShowRing = do + ring <- baseRing + s <- RingArray.showRing ring + s `shouldBe` show base + +------------------------------------------------------------------------------- +-- Stream of rings +------------------------------------------------------------------------------- + +-- Note: the rings produced are mutable references, so each must be converted +-- to a list within the stream before the next iteration mutates it. + +testRingsOf :: IO () +testRingsOf = do + res <- Stream.toList + $ Stream.mapM RingArray.toList + $ RingArray.ringsOf 3 (Stream.fromList [1 .. 5 :: Int]) + res `shouldBe` [[1], [1, 2], [1, 2, 3], [2, 3, 4], [3, 4, 5]] + +testScanRingsOf :: IO () +testScanRingsOf = do + res <- Stream.toList + $ Stream.mapM RingArray.toList + $ Stream.postscanl (RingArray.scanRingsOf 3) (Stream.fromList [1 .. 5 :: Int]) + res `shouldBe` [[1], [1, 2], [1, 2, 3], [2, 3, 4], [3, 4, 5]] + +testScanFoldRingsBy :: IO () +testScanFoldRingsBy = do + res <- Stream.toList + $ Stream.postscanl + (RingArray.scanFoldRingsBy Fold.sum 3) (Stream.fromList [1 .. 5 :: Int]) + -- Sliding window sums of size up to 3. + res `shouldBe` [1, 3, 6, 9, 12] + +testScanCustomFoldRingsBy :: IO () +testScanCustomFoldRingsBy = do + res <- Stream.toList + $ Stream.postscanl + (RingArray.scanCustomFoldRingsBy + (pure . RingArray.length) 3) + (Stream.fromList [1 .. 5 :: Int]) + res `shouldBe` [1, 2, 3, 3, 3] + +testCreateOfLast :: IO () +testCreateOfLast = do + ring <- Stream.fold (RingArray.createOfLast 3) (Stream.fromList [1 .. 5 :: Int]) + RingArray.toList ring `shouldReturn` [3, 4, 5] + +------------------------------------------------------------------------------- +-- Fast byte comparisons +------------------------------------------------------------------------------- + eqArrayN :: [Int] -> [Int] -> Int -> Int -> Bool -> IO () eqArrayN lstArr lstRing startR nBytes expected = do let arr = Array.fromList lstArr @@ -37,12 +380,75 @@ eqArray lstArr lstRing startR expected = do res <- RingArray.eqArray ring arr res `shouldBe` expected +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + moduleName :: String moduleName = "Data.RingArray" main :: IO () main = hspec $ do describe moduleName $ do + describe "Casting from MutArray" $ do + it "castMutArray" testCastMutArray + it "castMutArray on a slice fails" testCastMutArraySlice + it "castMutArrayWith" testCastMutArrayWith + it "unsafeCastMutArray" testUnsafeCastMutArray + it "unsafeCastMutArrayWith" testUnsafeCastMutArrayWith + + describe "Size" $ do + it "length" testLength + it "byteLength" testByteLength + + describe "Random access" $ do + it "getIndex" testGetIndex + it "unsafeGetIndex" testUnsafeGetIndex + it "unsafeGetHead" testUnsafeGetHead + + describe "Moving the head" $ do + it "moveForward" testMoveForward + it "moveReverse" testMoveReverse + it "moveBy" testMoveBy + it "moveForward then moveReverse is identity" testMoveRoundTrip + + describe "Streams and conversion" $ do + it "read" testRead + it "readRev" testReadRev + it "reader" testReader + it "readerRev" testReaderRev + it "toList" testToList + it "toMutArray" testToMutArray + + describe "In-place mutation" $ do + it "putIndex" testPutIndex + it "replace_" testReplace_ + it "replace" testReplace + + describe "Casting the element type" $ do + it "unsafeCast" testUnsafeCast + it "asBytes" testAsBytes + it "cast (Just)" testCastJust + it "cast (Nothing)" testCastNothing + + describe "Casting to MutArray" $ do + it "asMutArray" testAsMutArray + it "asMutArray_" testAsMutArray_ + + describe "Folds" $ do + it "foldlM'" testFoldlM' + it "fold" testFold + + describe "Debugging" $ do + it "showRing" testShowRing + + describe "Stream of rings" $ do + it "ringsOf" testRingsOf + it "scanRingsOf" testScanRingsOf + it "scanFoldRingsBy" testScanFoldRingsBy + it "scanCustomFoldRingsBy" testScanCustomFoldRingsBy + it "createOfLast" testCreateOfLast + describe "Eq" $ do let lstArr = [0..99] lstRing = [50..99] ++ [0..49] diff --git a/test/Streamly/Test/Data/RingArray/Generic.hs b/test/Streamly/Test/Data/RingArray/Generic.hs new file mode 100644 index 0000000000..c06b18617e --- /dev/null +++ b/test/Streamly/Test/Data/RingArray/Generic.hs @@ -0,0 +1,186 @@ +-- | +-- Module : Streamly.Test.Data.RingArray.Generic +-- Copyright : (c) 2026 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.RingArray.Generic (main) where + +import Streamly.Internal.Data.RingArray.Generic (RingArray(..)) + +import qualified Streamly.Internal.Data.MutArray.Generic as MutArray +import qualified Streamly.Internal.Data.RingArray.Generic as RingArray +import qualified Streamly.Internal.Data.Stream as Stream + +import Prelude as P +import Test.Hspec as H + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +-- | Read the entire ring, starting at the ring head (oldest element), into a +-- list. +ringToList :: RingArray a -> IO [a] +ringToList rng = do + marr <- RingArray.toMutArray 0 (ringMax rng) rng + MutArray.toList marr + +-- | Build a ring containing the last @n@ elements of the given list. +fromListLastN :: Int -> [a] -> IO (RingArray a) +fromListLastN n xs = Stream.fold (RingArray.createOf n) (Stream.fromList xs) + +------------------------------------------------------------------------------- +-- Generation +------------------------------------------------------------------------------- + +testEmptyOf :: IO () +testEmptyOf = do + rng <- RingArray.emptyOf 5 :: IO (RingArray Int) + ringHead rng `shouldBe` 0 + ringMax rng `shouldBe` 5 + +testEmptyOfZero :: IO () +testEmptyOfZero = do + rng <- RingArray.emptyOf 0 :: IO (RingArray Int) + ringHead rng `shouldBe` 0 + ringMax rng `shouldBe` 0 + ringToList rng `shouldReturn` ([] :: [Int]) + +testCreateOfFull :: IO () +testCreateOfFull = do + -- More elements than capacity: keep the newest n. + rng <- fromListLastN 3 [1 .. 5 :: Int] + ringMax rng `shouldBe` 3 + ringToList rng `shouldReturn` [3, 4, 5] + +testCreateOfExact :: IO () +testCreateOfExact = do + rng <- fromListLastN 3 [1 .. 3 :: Int] + ringMax rng `shouldBe` 3 + ringToList rng `shouldReturn` [1, 2, 3] + +testCreateOfUnderfull :: IO () +testCreateOfUnderfull = do + -- Fewer elements than capacity: only the inserted elements, in order. + rng <- fromListLastN 3 [1, 2 :: Int] + ringToList rng `shouldReturn` [1, 2] + +testCreateOfZero :: IO () +testCreateOfZero = do + rng <- fromListLastN 0 [1 .. 5 :: Int] + ringMax rng `shouldBe` 0 + ringToList rng `shouldReturn` ([] :: [Int]) + +------------------------------------------------------------------------------- +-- Modification +------------------------------------------------------------------------------- + +testUnsafeInsertRingWith :: IO () +testUnsafeInsertRingWith = do + rng <- RingArray.emptyOf 3 :: IO (RingArray Int) + -- The head returned wraps around when it reaches ringMax. + h1 <- RingArray.unsafeInsertRingWith rng 10 + h1 `shouldBe` 1 + h2 <- RingArray.unsafeInsertRingWith rng { ringHead = h1 } 20 + h2 `shouldBe` 2 + h3 <- RingArray.unsafeInsertRingWith rng { ringHead = h2 } 30 + h3 `shouldBe` 0 + -- Overwrites the oldest element (10). + h4 <- RingArray.unsafeInsertRingWith rng { ringHead = h3 } 40 + h4 `shouldBe` 1 + ringToList rng { ringHead = h4 } `shouldReturn` [20, 30, 40] + +testSeek :: IO () +testSeek = do + rng <- fromListLastN 3 [1 .. 3 :: Int] + -- Clockwise. + (ringToList =<< RingArray.seek 1 rng) `shouldReturn` [2, 3, 1] + -- Counter clockwise. + (ringToList =<< RingArray.seek (-1) rng) `shouldReturn` [3, 1, 2] + -- A full rotation is a no-op. + (ringToList =<< RingArray.seek 3 rng) `shouldReturn` [1, 2, 3] + +testSeekEmpty :: IO () +testSeekEmpty = do + rng <- RingArray.emptyOf 0 :: IO (RingArray Int) + rng1 <- RingArray.seek 2 rng + ringHead rng1 `shouldBe` 0 + ringMax rng1 `shouldBe` 0 + +------------------------------------------------------------------------------- +-- Conversion +------------------------------------------------------------------------------- + +testToMutArray :: IO () +testToMutArray = do + rng <- fromListLastN 3 [1 .. 3 :: Int] + -- Full read. + marr <- RingArray.toMutArray 0 3 rng + MutArray.toList marr `shouldReturn` [1, 2, 3] + -- Partial read. + marr1 <- RingArray.toMutArray 0 2 rng + MutArray.toList marr1 `shouldReturn` [1, 2] + -- Read with a head adjustment. + marr2 <- RingArray.toMutArray 1 3 rng + MutArray.toList marr2 `shouldReturn` [2, 3, 1] + +testToMutArrayWrap :: IO () +testToMutArrayWrap = do + -- A full ring whose head is in the middle requires wrap-around handling. + rng <- fromListLastN 3 [1 .. 5 :: Int] + marr <- RingArray.toMutArray 0 3 rng + MutArray.toList marr `shouldReturn` [3, 4, 5] + +testToMutArrayEmpty :: IO () +testToMutArrayEmpty = do + rng <- RingArray.emptyOf 0 :: IO (RingArray Int) + marr <- RingArray.toMutArray 0 5 rng + MutArray.toList marr `shouldReturn` ([] :: [Int]) + +testCopyToMutArray :: IO () +testCopyToMutArray = do + rng <- fromListLastN 3 [1 .. 5 :: Int] + marr <- RingArray.copyToMutArray 0 3 rng + MutArray.toList marr `shouldReturn` [3, 4, 5] + -- The copy is independent of the ring's underlying memory. + _ <- RingArray.unsafeInsertRingWith rng 99 + MutArray.toList marr `shouldReturn` [3, 4, 5] + +testCopyToMutArrayEmpty :: IO () +testCopyToMutArrayEmpty = do + rng <- RingArray.emptyOf 0 :: IO (RingArray Int) + marr <- RingArray.copyToMutArray 0 5 rng + MutArray.toList marr `shouldReturn` ([] :: [Int]) + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +moduleName :: String +moduleName = "Data.RingArray.Generic" + +main :: IO () +main = hspec $ do + describe moduleName $ do + describe "Generation" $ do + it "emptyOf" testEmptyOf + it "emptyOf 0" testEmptyOfZero + it "createOf (more than capacity)" testCreateOfFull + it "createOf (exactly capacity)" testCreateOfExact + it "createOf (fewer than capacity)" testCreateOfUnderfull + it "createOf 0" testCreateOfZero + + describe "Modification" $ do + it "unsafeInsertRingWith" testUnsafeInsertRingWith + it "seek" testSeek + it "seek on empty ring" testSeekEmpty + + describe "Conversion" $ do + it "toMutArray" testToMutArray + it "toMutArray (wrap around)" testToMutArrayWrap + it "toMutArray (empty ring)" testToMutArrayEmpty + it "copyToMutArray" testCopyToMutArray + it "copyToMutArray (empty ring)" testCopyToMutArrayEmpty diff --git a/test/Streamly/Test/Data/Scanl.hs b/test/Streamly/Test/Data/Scanl.hs new file mode 100644 index 0000000000..e757c13a52 --- /dev/null +++ b/test/Streamly/Test/Data/Scanl.hs @@ -0,0 +1,21 @@ +-- | +-- Module : Streamly.Test.Data.Scanl +-- Copyright : (c) 2024 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Main (main) where + +import qualified Streamly.Test.Data.Scanl.Combinators as Combinators +import qualified Streamly.Test.Data.Scanl.Container as Container +import qualified Streamly.Test.Data.Scanl.Type as Type +import qualified Streamly.Test.Data.Scanl.Window as Window + +main :: IO () +main = do + Type.main + Combinators.main + Container.main + Window.main diff --git a/test/Streamly/Test/Data/Scanl/Combinators.hs b/test/Streamly/Test/Data/Scanl/Combinators.hs new file mode 100644 index 0000000000..d6213f1eb9 --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/Combinators.hs @@ -0,0 +1,38 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +-- | +-- Module : Streamly.Test.Data.Scanl.Combinators +-- Copyright : (c) 2024 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.Scanl.Combinators (main) where + +import Data.Int (Int64) +import Data.Semigroup (Sum(..)) +import qualified Streamly.Internal.Data.MutArray as MArray +import qualified Streamly.Internal.Data.Scanl as F +import qualified Streamly.Internal.Data.Stream as Stream + +import qualified Prelude +import Prelude hiding (maximum, minimum, product, sum, mconcat, foldMap, maybe) + +import Streamly.Test.Common (withNumTests) +import Streamly.Test.Data.Scanl.Type (check, checkApprox, checkPostscanl) +import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (Gen, Property, choose, forAll, listOf1) + +#include "Streamly/Test/Data/Scanl/CommonCombinators.hs" + +moduleName :: String +moduleName = "Data.Scanl.Combinators" + +main :: IO () +main = hspec $ + describe moduleName $ + describe "common" commonCombinatorsSpec + + -- Before adding any tests here consider if it can be added to the + -- common tests above. diff --git a/test/Streamly/Test/Data/Scanl/CommonCombinators.hs b/test/Streamly/Test/Data/Scanl/CommonCombinators.hs new file mode 100644 index 0000000000..929a39e69e --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/CommonCombinators.hs @@ -0,0 +1,324 @@ +-- +-- See test/Streamly/Test/Data/Scanl/Type.hs for Scanl/Fold test sharing +-- mechanism. + +------------------------------------------------------------------------------- +-- Accumulators +------------------------------------------------------------------------------- + +-- 'product' short-circuits at a 0 input (0 is absorbing), terminating the scan +-- at, and including, that zero. Fixed examples are used to avoid Int-overflow +-- artifacts that a property over arbitrary Ints would hit. +productS :: Expectation +productS = do + check F.product ([2, 3, 4] :: [Int]) [1, 2, 6, 24] + check F.product ([2, 0, 3] :: [Int]) [1, 2, 0] + check F.product ([0] :: [Int]) [1, 0] + check F.product ([] :: [Int]) [1] + -- Short-circuit: the element after the first 0 is bottom, so this throws + -- (and fails) if 'product' consumes past the 0. + check F.product ([2, 0, error "product consumed past 0"] :: [Int]) [1, 2, 0] + +sumS :: [Int] -> Expectation +sumS ls = check F.sum ls (Prelude.scanl (+) 0 ls) + +toListRevS :: [Int] -> Expectation +toListRevS ls = check F.toListRev ls (Prelude.scanl (flip (:)) [] ls) + +mconcatS :: [Int] -> Expectation +mconcatS ls = + check F.mconcat (Prelude.map Sum ls) + (Prelude.scanl (<>) (Sum 0) (Prelude.map Sum ls)) + +foldMapS :: [Int] -> Expectation +foldMapS ls = + check (F.foldMap Sum) ls (Prelude.scanl (\acc x -> acc <> Sum x) (Sum 0) ls) + +foldMapMS :: [Int] -> Expectation +foldMapMS ls = + check (F.foldMapM (return . Sum)) ls + (Prelude.scanl (\acc x -> acc <> Sum x) (Sum 0) ls) + +theS :: Expectation +theS = do + check F.the ([3, 3, 3] :: [Int]) [Nothing, Just 3, Just 3, Just 3] + check F.the ([3, 3, 4] :: [Int]) [Nothing, Just 3, Just 3, Nothing] + check F.the ([] :: [Int]) [Nothing] + -- Short-circuit: the element after the first mismatch is bottom, so this + -- throws (and fails) if 'the' consumes past the mismatch. + check F.the ([3, 3, 4, error "the consumed past mismatch"] :: [Int]) + [Nothing, Just 3, Just 3, Nothing] + +-- Polynomial rolling hash: +-- +-- H = salt * k ^ n + c1 * k ^ (n - 1) + c2 * k ^ (n - 2) + ... + cn * k ^ 0 +-- +-- where c1..cn are the inputs and k is a fixed multiplier. This is computed +-- incrementally by the step @cksum * k + fromEnum a@ starting from @salt@, so +-- the inclusive prescan over the input is the reference @expected@. +-- +-- 'rollingHashK' and 'rollingHashDefaultSalt' deliberately duplicate the source +-- constants (rather than importing them) so this test fails if either changes: +-- the hash values are an output contract, and a change to 'k' or the default +-- salt alters every computed hash. +rollingHashK :: Int64 +rollingHashK = 2891336453 + +rollingHashDefaultSalt :: Int64 +rollingHashDefaultSalt = -2578643520546668380 + +rollingHashRef :: Int64 -> [Int] -> [Int64] +rollingHashRef salt = + Prelude.scanl + (\cksum a -> cksum * rollingHashK + fromIntegral (fromEnum a)) salt + +rollingHashWithSaltS :: [Int] -> Expectation +rollingHashWithSaltS ls = + check (F.rollingHashWithSalt salt) ls (rollingHashRef salt ls) + + where + + salt = 0 + +rollingHashS :: [Int] -> Expectation +rollingHashS ls = check F.rollingHash ls (rollingHashRef rollingHashDefaultSalt ls) + +-- 'rollingHashFirstN n' is 'rollingHash' truncated to the first n inputs, so its +-- reference is the rollingHash prescan capped at n+1 outputs (the initial value +-- plus one per consumed input). Checked for every n from 0 up to past the end of +-- the stream. +rollingHashFirstNS :: [Int] -> Expectation +rollingHashFirstNS ls = + Prelude.mapM_ + (\n -> + check + (F.rollingHashFirstN n) + ls + (Prelude.take (n + 1) (rollingHashRef rollingHashDefaultSalt ls))) + [0 .. Prelude.length ls + 2] + +------------------------------------------------------------------------------- +-- Statistical +------------------------------------------------------------------------------- + +chooseFloat :: (Float, Float) -> Gen Float +chooseFloat = choose + +-- 'mean' produces a numerically stable floating-point average that is only +-- approximately equal to the naive sum/count reference, so it uses +-- 'checkApprox' (epsilon comparison) rather than the exact-equality 'check'. +-- The mean of the empty prefix is 0 (the scan's initial value). +meanS :: Property +meanS = + forAll (listOf1 (chooseFloat (-100.0, 100.0))) + $ \ls -> withNumTests 1000 $ checkApprox F.mean ls (expected ls) + + where + + expected ls = + [ if k == 0 + then 0 + else Prelude.sum (Prelude.take k ls) / fromIntegral k + | k <- [0 .. Prelude.length ls] + ] + +------------------------------------------------------------------------------- +-- Filtering / mapping +------------------------------------------------------------------------------- + +mapMaybeS :: [Int] -> Expectation +mapMaybeS ls = + check + (F.mapMaybe (\x -> if even x then Just x else Nothing) F.toList) + ls + (Prelude.scanl (\acc x -> if even x then acc ++ [x] else acc) [] ls) + +drainMapMS :: [Int] -> Expectation +drainMapMS ls = check (F.drainMapM return) ls (Prelude.scanl (\_ _ -> ()) () ls) + +------------------------------------------------------------------------------- +-- Distributing / unzipping (fixed examples) +------------------------------------------------------------------------------- + +distributeS :: [Int] -> Expectation +distributeS ls = + check (F.distribute [F.sum, F.length]) ls + [[Prelude.sum (Prelude.take k ls), k] | k <- [0 .. Prelude.length ls]] + +unzipWithS :: Expectation +unzipWithS = + check (F.unzipWith (\x -> (x, x * 2)) F.sum F.sum) ([1, 2, 3] :: [Int]) + [(0, 0), (1, 2), (3, 6), (6, 12)] + +unzipWithMS :: Expectation +unzipWithMS = + check (F.unzipWithM (\x -> return (x, x * 2)) F.sum F.sum) ([1, 2, 3] :: [Int]) + [(0, 0), (1, 2), (3, 6), (6, 12)] + +indexedS :: Expectation +indexedS = + check (F.indexed F.toList) "abc" + [ [] + , [(0, 'a')] + , [(0, 'a'), (1, 'b')] + , [(0, 'a'), (1, 'b'), (2, 'c')] + ] + +sampleFromthenS :: Expectation +sampleFromthenS = + check (F.sampleFromthen 0 2 F.toList) ([1 .. 6] :: [Int]) + [[], [1], [1], [1, 3], [1, 3], [1, 3, 5], [1, 3, 5]] + +sconcatS :: Expectation +sconcatS = + check (F.sconcat (Sum 10)) (Prelude.map Sum ([1, 2, 3] :: [Int])) + [Sum 10, Sum 11, Sum 13, Sum 16] + +unzipS :: Expectation +unzipS = + check (F.unzip F.sum F.toList) ([(1, 'a'), (2, 'b'), (3, 'c')] :: [(Int, Char)]) + [(0, ""), (1, "a"), (3, "ab"), (6, "abc")] + +drainNS :: Expectation +drainNS = check (F.drainN 3) ([1, 2, 3, 4, 5] :: [Int]) [(), (), (), ()] + +------------------------------------------------------------------------------- +-- Scanners (emit Maybe; the per-input view, verified in full) +------------------------------------------------------------------------------- + +deleteByS :: Expectation +deleteByS = + check (F.deleteBy (==) 3) ([1, 2, 3, 4, 3, 5] :: [Int]) + [Nothing, Just 1, Just 2, Nothing, Just 4, Just 3, Just 5] + +findIndicesS :: Expectation +findIndicesS = + check (F.findIndices even) ([1, 2, 3, 4, 5, 6] :: [Int]) + [Nothing, Nothing, Just 1, Nothing, Just 3, Nothing, Just 5] + +elemIndicesS :: Expectation +elemIndicesS = + check (F.elemIndices 3) ([1, 3, 2, 3, 4, 3] :: [Int]) + [Nothing, Nothing, Just 1, Nothing, Just 3, Nothing, Just 5] + +droppingWhileS :: Expectation +droppingWhileS = + check (F.droppingWhile (< 3)) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Nothing, Nothing, Just 3, Just 4, Just 5] + +droppingWhileMS :: Expectation +droppingWhileMS = + check (F.droppingWhileM (return . (< 3))) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Nothing, Nothing, Just 3, Just 4, Just 5] + +takingEndByS :: Expectation +takingEndByS = + check (F.takingEndBy (== 3)) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Just 1, Just 2, Just 3] + +takingEndByMS :: Expectation +takingEndByMS = + check (F.takingEndByM (return . (== 3))) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Just 1, Just 2, Just 3] + +takingEndByM_S :: Expectation +takingEndByM_S = + check (F.takingEndByM_ (return . (== 3))) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Just 1, Just 2, Nothing] + +------------------------------------------------------------------------------- +-- Non-Eq results: convert the emitted value to a list via rmapM so the +-- per-step output can be compared. toStream/toStreamRev emit a Stream; +-- top/bottom emit a MutArray. +------------------------------------------------------------------------------- + +toStreamS :: [Int] -> Expectation +toStreamS ls = + check (F.rmapM Stream.toList F.toStream) ls + (Prelude.scanl (\acc x -> acc ++ [x]) [] ls) + +toStreamRevS :: [Int] -> Expectation +toStreamRevS ls = + check (F.rmapM Stream.toList F.toStreamRev) ls (Prelude.scanl (flip (:)) [] ls) + +topS :: Expectation +topS = do + check (F.rmapM MArray.toList (F.top 3)) ([5, 1, 4, 2, 3] :: [Int]) + [[], [5], [5, 1], [5, 4, 1], [5, 4, 2], [5, 4, 3]] + -- top 0 is Done at the initial step (keeps nothing) + check (F.rmapM MArray.toList (F.top 0)) ([5, 1, 4] :: [Int]) [[]] + +bottomS :: Expectation +bottomS = + check (F.rmapM MArray.toList (F.bottom 3)) ([5, 1, 4, 2, 3] :: [Int]) + [[], [5], [1, 5], [1, 4, 5], [1, 2, 4], [1, 2, 3]] + +------------------------------------------------------------------------------- +-- Postscan-only scanners (scanl initial is undefined: error "Empty stream"). +-- Use checkPostscanl; the @expected@ is the postscanl output. +------------------------------------------------------------------------------- + +rollingMapS :: Expectation +rollingMapS = + checkPostscanl (F.rollingMap (\prev cur -> Prelude.maybe 0 (cur -) prev)) + ([1, 3, 6] :: [Int]) [0, 2, 3] + +rollingMapMS :: Expectation +rollingMapMS = + checkPostscanl + (F.rollingMapM (\prev cur -> return (Prelude.maybe 0 (cur -) prev))) + ([1, 3, 6] :: [Int]) [0, 2, 3] + +uniqS :: Expectation +uniqS = + checkPostscanl F.uniq ([1, 1, 2, 3, 3, 3, 4] :: [Int]) + [Just 1, Nothing, Just 2, Just 3, Nothing, Nothing, Just 4] + +uniqByS :: Expectation +uniqByS = + checkPostscanl (F.uniqBy (==)) ([1, 1, 2, 3, 3, 3, 4] :: [Int]) + [Just 1, Nothing, Just 2, Just 3, Nothing, Nothing, Just 4] + +------------------------------------------------------------------------------- +-- Common test spec for Scanl and Fold +------------------------------------------------------------------------------- + +commonCombinatorsSpec :: Spec +commonCombinatorsSpec = do + prop "sum" sumS + prop "toListRev" toListRevS + it "product" productS + prop "mconcat" mconcatS + prop "foldMap" foldMapS + prop "foldMapM" foldMapMS + it "the" theS + prop "mean" meanS + prop "rollingHashWithSalt" rollingHashWithSaltS + prop "rollingHash" rollingHashS + prop "rollingHashFirstN" rollingHashFirstNS + prop "mapMaybe" mapMaybeS + prop "drainMapM" drainMapMS + prop "distribute" distributeS + it "unzipWith" unzipWithS + it "unzipWithM" unzipWithMS + it "indexed" indexedS + it "sampleFromthen" sampleFromthenS + it "sconcat" sconcatS + it "unzip" unzipS + it "drainN" drainNS + it "deleteBy" deleteByS + it "findIndices" findIndicesS + it "elemIndices" elemIndicesS + it "droppingWhile" droppingWhileS + it "droppingWhileM" droppingWhileMS + it "takingEndBy" takingEndByS + it "takingEndByM" takingEndByMS + it "takingEndByM_" takingEndByM_S + it "rollingMap" rollingMapS + it "rollingMapM" rollingMapMS + it "uniq" uniqS + it "uniqBy" uniqByS + prop "toStream" toStreamS + prop "toStreamRev" toStreamRevS + it "top" topS + it "bottom" bottomS diff --git a/test/Streamly/Test/Data/Scanl/CommonContainer.hs b/test/Streamly/Test/Data/Scanl/CommonContainer.hs new file mode 100644 index 0000000000..bdf96051a4 --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/CommonContainer.hs @@ -0,0 +1,51 @@ +-- See test/Streamly/Test/Data/Scanl/Type.hs for Scanl/Fold test sharing +-- mechanism. +-- +toSetS :: Expectation +toSetS = + check F.toSet ([1, 2, 3, 2, 1] :: [Int]) + [ Set.empty + , Set.fromList [1] + , Set.fromList [1, 2] + , Set.fromList [1, 2, 3] + , Set.fromList [1, 2, 3] + , Set.fromList [1, 2, 3] + ] + +toIntSetS :: Expectation +toIntSetS = + check F.toIntSet ([1, 2, 3, 2, 1] :: [Int]) + [ IntSet.empty + , IntSet.fromList [1] + , IntSet.fromList [1, 2] + , IntSet.fromList [1, 2, 3] + , IntSet.fromList [1, 2, 3] + , IntSet.fromList [1, 2, 3] + ] + +countDistinctS :: Expectation +countDistinctS = + check F.countDistinct ([1, 2, 3, 2, 1] :: [Int]) [0, 1, 2, 3, 3, 3] + +countDistinctIntS :: Expectation +countDistinctIntS = + check F.countDistinctInt ([1, 2, 3, 2, 1] :: [Int]) [0, 1, 2, 3, 3, 3] + +nubS :: Expectation +nubS = + checkPostscanl F.nub ([1, 1, 2, 3, 3] :: [Int]) + [Just 1, Nothing, Just 2, Just 3, Nothing] + +nubIntS :: Expectation +nubIntS = + checkPostscanl F.nubInt ([1, 1, 2, 3, 3] :: [Int]) + [Just 1, Nothing, Just 2, Just 3, Nothing] + +commonContainerSpec :: Spec +commonContainerSpec = do + it "toSet" toSetS + it "toIntSet" toIntSetS + it "countDistinct" countDistinctS + it "countDistinctInt" countDistinctIntS + it "nub" nubS + it "nubInt" nubIntS diff --git a/test/Streamly/Test/Data/Scanl/CommonType.hs b/test/Streamly/Test/Data/Scanl/CommonType.hs new file mode 100644 index 0000000000..57ad81570a --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/CommonType.hs @@ -0,0 +1,233 @@ +-- +-- See test/Streamly/Test/Data/Scanl/Type.hs for Scanl/Fold test sharing +-- mechanism. +-- +------------------------------------------------------------------------------- +-- Accumulators +------------------------------------------------------------------------------- + +lengthS :: [Int] -> Expectation +lengthS ls = check F.length ls (Prelude.scanl (\c _ -> c + 1) (0 :: Int) ls) + +genericLengthS :: [Int] -> Expectation +genericLengthS ls = + check (F.genericLength :: Op IO Int Int) ls + (Prelude.scanl (\c _ -> c + 1) 0 ls) + +toListS :: [Int] -> Expectation +toListS ls = check F.toList ls (Prelude.scanl (\acc x -> acc ++ [x]) [] ls) + +latestS :: [Int] -> Expectation +latestS ls = check F.latest ls (Prelude.scanl (\_ x -> Just x) Nothing ls) + +drainS :: [Int] -> Expectation +drainS ls = check F.drain ls (Prelude.scanl (\_ _ -> ()) () ls) + +maximumS :: [Int] -> Expectation +maximumS ls = + check F.maximum ls + (Prelude.scanl (\acc x -> Just (Prelude.maybe x (max x) acc)) Nothing ls) + +maximumByS :: [Int] -> Expectation +maximumByS ls = + check (F.maximumBy compare) ls + (Prelude.scanl (\acc x -> Just (Prelude.maybe x (max x) acc)) Nothing ls) + +minimumS :: [Int] -> Expectation +minimumS ls = + check F.minimum ls + (Prelude.scanl (\acc x -> Just (Prelude.maybe x (min x) acc)) Nothing ls) + +minimumByS :: [Int] -> Expectation +minimumByS ls = + check (F.minimumBy compare) ls + (Prelude.scanl (\acc x -> Just (Prelude.maybe x (min x) acc)) Nothing ls) + +rangeS :: [Int] -> Expectation +rangeS ls = + check F.range ls + (Prelude.scanl + (\acc x -> + Just (Prelude.maybe (x, x) (\(lo, hi) -> (min lo x, max hi x)) acc)) + Nothing + ls) + +rangeByS :: [Int] -> Expectation +rangeByS ls = + check (F.rangeBy compare) ls + (Prelude.scanl + (\acc x -> + Just (Prelude.maybe (x, x) (\(lo, hi) -> (min lo x, max hi x)) acc)) + Nothing + ls) + +------------------------------------------------------------------------------- +-- Mapping +------------------------------------------------------------------------------- + +lmapS :: [Int] -> Expectation +lmapS ls = + check (F.lmap (* 2) F.sum) ls (Prelude.scanl (\acc x -> acc + x * 2) 0 ls) + +lmapMS :: [Int] -> Expectation +lmapMS ls = + check (F.lmapM (\x -> return (x * 2)) F.sum) ls + (Prelude.scanl (\acc x -> acc + x * 2) 0 ls) + +rmapMS :: [Int] -> Expectation +rmapMS ls = + check (F.rmapM (\x -> return (x + Prelude.length ls)) F.sum) ls + (Prelude.map (+ Prelude.length ls) (Prelude.scanl (+) 0 ls)) + +------------------------------------------------------------------------------- +-- Filtering +------------------------------------------------------------------------------- + +filterS :: [Int] -> Expectation +filterS ls = + check (F.filter even F.toList) ls + (Prelude.scanl (\acc x -> if even x then acc ++ [x] else acc) [] ls) + +filterMS :: [Int] -> Expectation +filterMS ls = + check (F.filterM (return . even) F.toList) ls + (Prelude.scanl (\acc x -> if even x then acc ++ [x] else acc) [] ls) + +filteringS :: [Int] -> Expectation +filteringS ls = + check (F.filtering even) ls + (Prelude.scanl (\_ x -> if even x then Just x else Nothing) Nothing ls) + +catMaybesS :: Expectation +catMaybesS = + check + (F.catMaybes F.toList) + ([Just 1, Nothing, Just 3, Nothing, Just 5] :: [Maybe Int]) + [[], [1], [1], [1, 3], [1, 3], [1, 3, 5]] + +catLeftsS :: Expectation +catLeftsS = + check + (F.catLefts F.toList) + ([Left 1, Right "a", Left 3, Right "b"] :: [Either Int String]) + [[], [1], [1], [1, 3], [1, 3]] + +catRightsS :: Expectation +catRightsS = + check + (F.catRights F.toList) + ([Left "a", Right 2, Left "b", Right 4] :: [Either String Int]) + [[], [], [2], [2], [2, 4]] + +catEithersS :: Expectation +catEithersS = + check + (F.catEithers F.toList) + ([Left 1, Right 2, Left 3, Right 4] :: [Either Int Int]) + [[], [1], [1, 2], [1, 2, 3], [1, 2, 3, 4]] + +------------------------------------------------------------------------------- +-- Trimming (terminating scans truncate at the terminating step) +------------------------------------------------------------------------------- + +takeS :: [Int] -> Property +takeS ls = + forAll (chooseInt (-1, len + 2)) $ \n -> + -- scanl: initial, then one output per consumed input. n<=0 is + -- Done-at-initial, emitting just the initial extract. + let sc = if n <= 0 + then [[]] + else [Prelude.take k ls | k <- [0 .. min n len]] + in check (F.take n F.toList) ls sc + where + len = Prelude.length ls + +takingS :: Expectation +takingS = do + check (F.taking 3) ([1, 2, 3, 4, 5] :: [Int]) [Nothing, Just 1, Just 2, Just 3] + check (F.taking 0) ([1, 2, 3] :: [Int]) [Nothing] + check (F.taking 3) ([] :: [Int]) [Nothing] + +droppingS :: Expectation +droppingS = do + check (F.dropping 2) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Nothing, Nothing, Just 3, Just 4, Just 5] + check (F.dropping 0) ([1, 2, 3] :: [Int]) + [Nothing, Just 1, Just 2, Just 3] + check (F.dropping 10) ([1, 2, 3] :: [Int]) + [Nothing, Nothing, Nothing, Nothing] + +takeEndBy_S :: Expectation +takeEndBy_S = + check (F.takeEndBy_ (== 1) F.toList) ([3, 2, 1, 4] :: [Int]) + [[], [3], [3, 2], [3, 2]] + +takeEndByS :: Expectation +takeEndByS = + check (F.takeEndBy (== 1) F.toList) ([3, 2, 1, 4] :: [Int]) + [[], [3], [3, 2], [3, 2, 1]] + +------------------------------------------------------------------------------- +-- Tuple result +------------------------------------------------------------------------------- + +teeWithS :: [Int] -> Expectation +teeWithS ls = + check + (F.teeWith (,) F.sum F.length) + ls + (Prelude.zip (Prelude.scanl (+) 0 ls) [0 .. Prelude.length ls]) + +------------------------------------------------------------------------------- +-- Transforming inner monad +------------------------------------------------------------------------------- + +morphInnerS :: [Int] -> Expectation +morphInnerS ls = + check + (F.morphInner (return . runIdentity) (F.sum :: Op Identity Int Int)) + ls + (Prelude.scanl (+) 0 ls) + +generalizeInnerS :: [Int] -> Expectation +generalizeInnerS ls = + check + (F.generalizeInner (F.sum :: Op Identity Int Int)) + ls + (Prelude.scanl (+) 0 ls) + +------------------------------------------------------------------------------- +-- Spec registered identically by both suites +------------------------------------------------------------------------------- + +commonTypeSpec :: Spec +commonTypeSpec = do + prop "length" lengthS + prop "genericLength" genericLengthS + prop "toList" toListS + prop "latest" latestS + prop "drain" drainS + prop "maximum" maximumS + prop "maximumBy" maximumByS + prop "minimum" minimumS + prop "minimumBy" minimumByS + prop "range" rangeS + prop "rangeBy" rangeByS + prop "lmap" lmapS + prop "lmapM" lmapMS + prop "rmapM" rmapMS + prop "filter" filterS + prop "filterM" filterMS + prop "filtering" filteringS + it "catMaybes" catMaybesS + it "catLefts" catLeftsS + it "catRights" catRightsS + it "catEithers" catEithersS + prop "take" takeS + it "taking" takingS + it "dropping" droppingS + it "takeEndBy_" takeEndBy_S + it "takeEndBy" takeEndByS + prop "teeWith" teeWithS + prop "morphInner" morphInnerS + prop "generalizeInner" generalizeInnerS diff --git a/test/Streamly/Test/Data/Scanl/Container.hs b/test/Streamly/Test/Data/Scanl/Container.hs new file mode 100644 index 0000000000..0ba5b52551 --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/Container.hs @@ -0,0 +1,30 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +-- | +-- Module : Streamly.Test.Data.Scanl.Container +-- Copyright : (c) 2024 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.Scanl.Container (main) where + +import qualified Data.IntSet as IntSet +import qualified Data.Set as Set +import qualified Streamly.Internal.Data.Scanl as F + +import Streamly.Test.Data.Scanl.Type (check, checkPostscanl) +import Test.Hspec + +#include "Streamly/Test/Data/Scanl/CommonContainer.hs" + +moduleName :: String +moduleName = "Data.Scanl.Container" + +main :: IO () +main = hspec $ + describe moduleName $ + describe "common" commonContainerSpec + + -- Before adding any tests here consider if it can be added to the + -- common tests above. diff --git a/test/Streamly/Test/Data/Scanl/Type.hs b/test/Streamly/Test/Data/Scanl/Type.hs new file mode 100644 index 0000000000..bcc31620e7 --- /dev/null +++ b/test/Streamly/Test/Data/Scanl/Type.hs @@ -0,0 +1,149 @@ +{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} +-- | +-- Module : Streamly.Test.Data.Scanl.Type +-- Copyright : (c) 2024 Composewell Technologies +-- License : BSD-3-Clause +-- Maintainer : streamly@composewell.com +-- Stability : experimental +-- Portability : GHC + +module Streamly.Test.Data.Scanl.Type + (main, check, checkApprox, checkPostscanl) where + +import Data.Functor.Identity (Identity, runIdentity) +import qualified Streamly.Internal.Data.Scanl as F +import qualified Streamly.Internal.Data.Stream as Stream + +import Prelude hiding (last, length, take, filter, scanl, foldl', concatMap) +import qualified Prelude + +import Streamly.Test.Common (chooseInt) +import Test.Hspec +import Test.Hspec.QuickCheck (prop) +import Test.QuickCheck (Property, forAll) + +------------------------------------------------------------------------------- +-- Scanl and Fold test sharing mechanism +------------------------------------------------------------------------------- + +-- Shared tests are written in CPP files that are included in both Fold tests +-- and Scanl tests. For example, "Streamly/Test/Data/Scanl/CommonType.hs" +-- contains tests that are common to Scanl/Type.hs module and the Fold module. +-- +-- The including module must bring the following into scope BEFORE the #include: +-- * qualifier F -- Streamly.Internal.Data.{Fold,Scanl} +-- * qualifier Stream -- Streamly.Internal.Data.Stream +-- * type Op -- F.Fold or F.Scanl +-- * check :: (Eq b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +-- * checkApprox :: (Ord b, Fractional b, Show b) +-- => Op IO a b -> [a] -> [b] -> Expectation +-- (epsilon-equality counterpart of 'check' for floating-point results) +-- plus the usual hspec / QuickCheck imports, Data.Functor.Identity, and +-- Streamly.Test.Common (chooseInt). +-- +-- In every shared test the @expected@ value is the *inclusive prescan list* +-- (Prelude.scanl f z), i.e. exactly what Stream.scanl emits: the leading +-- initial value followed by one output per input (filtering scans emit the +-- unchanged accumulator for filtered elements; terminating scans truncate at, +-- and including, the terminating step). From this list: +-- * the Fold includer checks the final value (Prelude.last expected) +-- * the Scanl includer checks the full Stream.scanl output (== expected) and +-- the Stream.postscanl output (== drop 1 expected, the initial omitted) +-- +-- Combinators are grouped by their *Scanl* source submodule (these Common*.hs +-- fragments live under Scanl/, so Scanl is the authoritative source for +-- placement). + +-- | A Scanl is exercised by scanning a stream and verifying the resulting +-- stream of intermediate outputs. The shared @expected@ value is the inclusive +-- prescan list (what 'Stream.scanl' emits); 'Stream.postscanl' is the same with +-- the leading initial value dropped. +type Op = F.Scanl + +check :: (Eq b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +check cons xs expected = do + Stream.toList (Stream.scanl cons (Stream.fromList xs)) + `shouldReturn` expected + Stream.toList (Stream.postscanl cons (Stream.fromList xs)) + `shouldReturn` drop 1 expected + +-- | Epsilon-equality counterpart of 'check' for Fractional results whose +-- floating-point output is only approximately equal to the reference (e.g. +-- 'mean'). Each emitted value must be within 1e-4 of the expected prescan value. +checkApprox :: + (Ord b, Fractional b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +checkApprox cons xs expected = do + out <- Stream.toList (Stream.scanl cons (Stream.fromList xs)) + out `shouldSatisfy` approxEqList expected + pout <- Stream.toList (Stream.postscanl cons (Stream.fromList xs)) + pout `shouldSatisfy` approxEqList (drop 1 expected) + + where + + approxEqList as bs = + Prelude.length as == Prelude.length bs + && and (zipWith (\a b -> abs (a - b) < 1e-4) as bs) + +-- | For combinators that only support postscan (their scanl initial value is +-- undefined, e.g. rollingMap), so 'check' cannot be used. @expected@ is the +-- Stream.postscanl output (one value per input, no leading initial). +checkPostscanl :: (Eq b, Show b) => Op IO a b -> [a] -> [b] -> Expectation +checkPostscanl cons xs expected = + Stream.toList (Stream.postscanl cons (Stream.fromList xs)) + `shouldReturn` expected + +#include "Streamly/Test/Data/Scanl/CommonType.hs" + +------------------------------------------------------------------------------- +-- Scanl-only tests. +------------------------------------------------------------------------------- + +scanlVsPostscanl :: Expectation +scanlVsPostscanl = do + a <- Stream.toList (Stream.scanl F.sum (Stream.fromList [1, 2, 3 :: Int])) + a `shouldBe` [0, 1, 3, 6] + b <- Stream.toList (Stream.postscanl F.sum (Stream.fromList [1, 2, 3 :: Int])) + b `shouldBe` [1, 3, 6] + +-- 'Scanl.postscanl' composes two scans. Verify both the normal case and the +-- case where the inner scan is Done at the initial step (its value is dropped, +-- so the resulting scan is also Done at init and postscanl emits nothing). +postscanlCompose :: Expectation +postscanlCompose = do + Stream.toList + (Stream.postscanl (F.postscanl F.sum F.toList) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [[1], [1, 3], [1, 3, 6]] + -- scanl additionally emits the initial value of the composed scan + Stream.toList + (Stream.scanl (F.postscanl F.sum F.toList) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [[], [1], [1, 3], [1, 3, 6]] + -- done-at-init: postscanl emits nothing, scanl emits the default value + Stream.toList + (Stream.postscanl (F.postscanl (F.take 0 F.sum) F.toList) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` ([] :: [[Int]]) + Stream.toList + (Stream.scanl (F.postscanl (F.take 0 F.sum) F.toList) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [[] :: [Int]] + +postscanlMaybeCompose :: Expectation +postscanlMaybeCompose = do + Stream.toList + (Stream.postscanl (F.postscanlMaybe (F.filtering even) F.length) (Stream.fromList [1 .. 6 :: Int])) + `shouldReturn` [0, 1, 1, 2, 2, 3] + Stream.toList + (Stream.postscanl (F.postscanlMaybe (fmap Just (F.take 0 F.sum)) F.length) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` ([] :: [Int]) + +moduleName :: String +moduleName = "Data.Scanl.Type" + +main :: IO () +main = hspec $ + describe moduleName $ do + describe "common" commonTypeSpec + + -- Before adding any tests here consider if it can be added to the + -- common tests above. + it "scanl emits initial, postscanl omits it" scanlVsPostscanl + it "postscanl (compose)" postscanlCompose + it "postscanlMaybe (compose)" postscanlMaybeCompose diff --git a/test/Streamly/Test/Data/Fold/Window.hs b/test/Streamly/Test/Data/Scanl/Window.hs similarity index 87% rename from test/Streamly/Test/Data/Fold/Window.hs rename to test/Streamly/Test/Data/Scanl/Window.hs index 946eebc8dd..fab487df45 100644 --- a/test/Streamly/Test/Data/Fold/Window.hs +++ b/test/Streamly/Test/Data/Scanl/Window.hs @@ -1,4 +1,4 @@ -module Streamly.Test.Data.Fold.Window (main) where +module Streamly.Test.Data.Scanl.Window (main) where import Test.Hspec (hspec, describe, it, runIO) import Streamly.Internal.Data.Scanl (Incr(..)) @@ -45,8 +45,8 @@ main = hspec $ do testFunc tc f sI sW = do let c = S.fromList tc - a <- runIO $ S.fold Fold.toList $ S.postscanl f $ fmap Insert c - b <- runIO $ S.fold Fold.toList $ S.postscanl + a <- runIO $ S.toList $ S.postscanl f $ fmap Insert c + b <- runIO $ S.toList $ S.postscanl (Scanl.incrScan winSize f) c it "Infinite" $ a == sI it ("Finite " ++ show winSize) $ b == sW @@ -62,23 +62,23 @@ main = hspec $ do [[1.0],[1.0,4.0],[1.0,4.0,3.0],[4.0,3.0,2.1],[3.0,2.1,-5.1] ,[2.1,-5.1,-2.0],[-5.1,-2.0,7.0],[-2.0,7.0,3.0],[7.0,3.0,-2.5] ] - (RingArray.scanFoldRingsBy Fold.toList) + (RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.toList)) describe "minimum" $ do testFunc2 testCase1 [Just 1.0,Just 1.0,Just 1.0,Just 2.1,Just (-5.1),Just (-5.1) ,Just (-5.1),Just (-2.0),Just (-2.5)] - (RingArray.scanFoldRingsBy Fold.minimum) + (RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.minimum)) describe "maximum" $ do testFunc2 testCase1 [Just 1.0,Just 4.0,Just 4.0,Just 4.0,Just 3.0,Just 2.1 ,Just 7.0,Just 7.0,Just 7.0] - (RingArray.scanFoldRingsBy Fold.maximum) + (RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.maximum)) describe "range" $ do testFunc2 testCase1 [Just (1.0,1.0),Just (1.0,4.0),Just (1.0,4.0),Just (2.1,4.0) ,Just (-5.1,3.0),Just (-5.1,2.1),Just (-5.1,7.0) ,Just (-2.0,7.0),Just (-2.5,7.0)] - (RingArray.scanFoldRingsBy Fold.range) + (RingArray.scanFoldRingsBy (Fold.fromScanl Scanl.range)) describe "sum" $ do let scanInf = [1, 2, 3, 4, 5, 12] :: [Double] scanWin = [1, 2, 3, 3, 3, 9] :: [Double] diff --git a/test/Streamly/Test/Data/SmallArray.hs b/test/Streamly/Test/Data/SmallArray.hs index 07dd546958..11713bc4bb 100644 --- a/test/Streamly/Test/Data/SmallArray.hs +++ b/test/Streamly/Test/Data/SmallArray.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} - -- | -- Module : Streamly.Test.Data.SmallArray -- Copyright : (c) 2020 Composewell technologies diff --git a/test/Streamly/Test/Data/Stream/MkType/Ahead.hs b/test/Streamly/Test/Data/Stream/MkType/Ahead.hs index b26e4610ef..f03c2e7b05 100644 --- a/test/Streamly/Test/Data/Stream/MkType/Ahead.hs +++ b/test/Streamly/Test/Data/Stream/MkType/Ahead.hs @@ -1,6 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Streamly.Test.Data.Stream.Ahead diff --git a/test/Streamly/Test/Data/Stream/MkType/ZipAsync.hs b/test/Streamly/Test/Data/Stream/MkType/ZipAsync.hs index 8e762fa468..f2a265d64d 100644 --- a/test/Streamly/Test/Data/Stream/MkType/ZipAsync.hs +++ b/test/Streamly/Test/Data/Stream/MkType/ZipAsync.hs @@ -1,6 +1,5 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Streamly.Test.Data.Stream.ZipAsync diff --git a/test/Streamly/Test/Data/Stream/MkType/ZipSerial.hs b/test/Streamly/Test/Data/Stream/MkType/ZipSerial.hs index 5234a6d182..9c057372b4 100644 --- a/test/Streamly/Test/Data/Stream/MkType/ZipSerial.hs +++ b/test/Streamly/Test/Data/Stream/MkType/ZipSerial.hs @@ -2,7 +2,6 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} -{-# OPTIONS_GHC -Wno-deprecations #-} -- | -- Module : Streamly.Test.Data.Stream.ZipSerial diff --git a/test/Streamly/Test/Data/Stream/Serial.hs b/test/Streamly/Test/Data/Stream/Serial.hs index 8366df3c21..79a2fb67bc 100644 --- a/test/Streamly/Test/Data/Stream/Serial.hs +++ b/test/Streamly/Test/Data/Stream/Serial.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} -- XXX We are using head/tail at one place #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} @@ -142,27 +141,27 @@ splitterProperties sep desc = do $ do forM_ [0, 1, 2, 4] - $ intercalateSplitEqId splitOnSeq_ intercalate IS.intercalate + $ intercalateSplitEqId splitOnSeq_ intercalate sIntercalate forM_ [0, 1, 2, 4] $ concatSplitIntercalateEqConcat splitOnSeq_ intercalate - IS.intercalate + sIntercalate -- Exclusive case - splitIntercalateEqId splitOnSeq_ intercalate IS.intercalate + splitIntercalateEqId splitOnSeq_ intercalate sIntercalate describe (desc <> " splitOn") $ do - intercalateSplitEqId splitOn_ intercalate IS.intercalate 1 + intercalateSplitEqId splitOn_ intercalate sIntercalate 1 concatSplitIntercalateEqConcat - splitOn_ intercalate IS.intercalate 1 + splitOn_ intercalate sIntercalate 1 -- Exclusive case - splitIntercalateEqId splitOn_ intercalate IS.intercalate + splitIntercalateEqId splitOn_ intercalate sIntercalate describe (desc <> " splitOnSuffixSeq") $ do @@ -171,32 +170,32 @@ splitterProperties sep desc = do $ intercalateSplitEqIdNoSepEnd splitOnSuffixSeq_ intercalate - IS.intercalate + sIntercalate forM_ [0, 1, 2, 4] $ concatSplitIntercalateEqConcat splitOnSuffixSeq_ intercalateSuffix - IS.intercalateSuffix + sIntercalateSuffix -- Exclusive case splitIntercalateEqId splitOnSuffixSeq_ intercalateSuffix - IS.intercalateSuffix + sIntercalateSuffix describe (desc <> " splitOnSuffix") $ do intercalateSplitEqIdNoSepEnd - splitOnSuffix_ intercalate IS.intercalate 1 + splitOnSuffix_ intercalate sIntercalate 1 concatSplitIntercalateEqConcat - splitOnSuffix_ intercalateSuffix IS.intercalateSuffix 1 + splitOnSuffix_ intercalateSuffix sIntercalateSuffix 1 -- Exclusive case splitIntercalateEqId - splitOnSuffix_ intercalateSuffix IS.intercalateSuffix + splitOnSuffix_ intercalateSuffix sIntercalateSuffix where @@ -214,6 +213,10 @@ splitterProperties sep desc = do intercalateSuffix xs yss = intercalate xs yss ++ xs + sIntercalate u x = IS.unfoldEachSepBySeq x u + + sIntercalateSuffix u x = IS.unfoldEachEndBySeq x u + nonSepElem :: Gen a nonSepElem = suchThat arbitrary (/= sep) @@ -439,7 +442,7 @@ foldIterateM = let s1 = Prelude.sum lst strm = S.fromList lst ms2 <- - S.fold FL.last + S.fold FL.latest $ fmap getSum $ IS.foldIterateM (return . FL.take 1 . FL.sconcat) diff --git a/test/Streamly/Test/Data/Stream/Serial/Common.hs b/test/Streamly/Test/Data/Stream/Serial/Common.hs index 956fde7d89..8676010e63 100644 --- a/test/Streamly/Test/Data/Stream/Serial/Common.hs +++ b/test/Streamly/Test/Data/Stream/Serial/Common.hs @@ -1,5 +1,4 @@ {-# Language NoMonoLocalBinds #-} -{-# OPTIONS_GHC -Wno-deprecations #-} -- XXX We are using head/tail at one place #if __GLASGOW_HASKELL__ >= 908 {-# OPTIONS_GHC -Wno-x-partial #-} @@ -1054,8 +1053,8 @@ transformCombineOpsCommon constr desc eq = do prop (desc <> " unfoldMany") $ forAll (choose (0, 100)) $ \n -> transform (concatMap (const [1..n])) - (S.unfoldMany (UF.lmap (const undefined) - $ UF.both [1..n] UF.fromList)) + (S.unfoldEach (UF.lmap (const undefined) + $ UF.supply [1..n] UF.fromList)) toListFL :: Monad m => FL.Fold m a [a] toListFL = FL.toList diff --git a/test/Streamly/Test/Data/Stream/Top.hs b/test/Streamly/Test/Data/Stream/Top.hs index 05c5b4377c..85d61d2220 100644 --- a/test/Streamly/Test/Data/Stream/Top.hs +++ b/test/Streamly/Test/Data/Stream/Top.hs @@ -1,5 +1,3 @@ -{-# OPTIONS_GHC -Wno-deprecations #-} - module Streamly.Test.Data.Stream.Top (main) where import Data.List (deleteFirstsBy, intersect, sort, unionBy) diff --git a/test/Streamly/Test/Data/Stream/Transform.hs b/test/Streamly/Test/Data/Stream/Transform.hs index 37ed14b49b..07baafe7af 100644 --- a/test/Streamly/Test/Data/Stream/Transform.hs +++ b/test/Streamly/Test/Data/Stream/Transform.hs @@ -149,6 +149,27 @@ testPostscanlEmpty = toList (Stream.postscanl Scanl.sum (Stream.fromList ([] :: [Int]))) `shouldReturn` [] +-- A scan that is Done at the initial step consumes no input, so postscanl +-- (one output per consumed input) emits nothing, while scanl still emits the +-- initial value. +testScanlDoneAtInit :: Expectation +testScanlDoneAtInit = + toList (Stream.scanl (Scanl.take 0 Scanl.sum) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [0] + +testPostscanlDoneAtInit :: Expectation +testPostscanlDoneAtInit = + toList (Stream.postscanl (Scanl.take 0 Scanl.sum) (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [] + +testPostscanlMaybeDoneAtInit :: Expectation +testPostscanlMaybeDoneAtInit = + toList + (Stream.postscanlMaybe + (fmap Just (Scanl.take 0 Scanl.sum)) + (Stream.fromList [1, 2, 3 :: Int])) + `shouldReturn` [] + testScanlMany :: Expectation testScanlMany = toList (Stream.scanlMany Scanl.sum (Stream.fromList [1, 2, 3 :: Int])) @@ -566,6 +587,9 @@ main = hspec it "scanl (Scanl) empty" testScanlScanlEmpty it "postscanl" testPostscanl it "postscanl empty" testPostscanlEmpty + it "scanl (Scanl) done-at-init" testScanlDoneAtInit + it "postscanl done-at-init" testPostscanlDoneAtInit + it "postscanlMaybe done-at-init" testPostscanlMaybeDoneAtInit it "scanlMany" testScanlMany it "scanr" testScanr it "pipe map" testPipe diff --git a/test/Streamly/Test/Data/Unfold.hs b/test/Streamly/Test/Data/Unfold.hs index 66ff36342d..d3d3e17eae 100644 --- a/test/Streamly/Test/Data/Unfold.hs +++ b/test/Streamly/Test/Data/Unfold.hs @@ -492,6 +492,18 @@ postscan = mList = scanl1 (+) ls in testUnfold unf ls mList +-- A scan that is Done at the initial step consumes no input, so postscanl emits +-- nothing, while scanl emits the default (initial) value. +postscanlDoneAtInit :: Bool +postscanlDoneAtInit = + let unf = UF.postscanl (Scanl.take 0 Scanl.sum) UF.fromList + in testUnfold unf ([1, 2, 3] :: [Int]) [] + +scanlDoneAtInit :: Bool +scanlDoneAtInit = + let unf = UF.scanl (Scanl.take 0 Scanl.sum) UF.fromList + in testUnfold unf ([1, 2, 3] :: [Int]) [0] + fold :: Bool fold = runIdentity (UF.fold Fold.sum UF.fromList [1..10 :: Int]) == 55 @@ -997,8 +1009,10 @@ testTransformation = $ do -- prop "map" map prop "postscan" postscan + prop "postscanl done-at-init" postscanlDoneAtInit prop "fold" fold prop "scanl" scanl + prop "scanl done-at-init" scanlDoneAtInit prop "scanlMany" scanlMany prop "foldMany" foldMany prop "either" either diff --git a/test/lib/Streamly/Test/Data/Parser/CommonTestDriver.hs b/test/lib/Streamly/Test/Data/Parser/CommonTestDriver.hs new file mode 100644 index 0000000000..759eed034c --- /dev/null +++ b/test/lib/Streamly/Test/Data/Parser/CommonTestDriver.hs @@ -0,0 +1,112 @@ +{-# Language NoMonoLocalBinds #-} +-- | Common infrastructure shared by the Parser and ParserK common test +-- suites: the test-case types, the test driver that adapts a single test to +-- the various parser/stream backends, and the shared size constants. +module Streamly.Test.Data.Parser.CommonTestDriver + ( TestMode(..) + , ParserTestCase + , ParserTestCase_Temp + , runParserTC + , runParserTC_temp + , min_value + , mid_value + , max_value + , max_length + ) where + +import Streamly.Internal.Data.MutByteArray (Unbox) +import Streamly.Internal.Data.Parser (ParseErrorPos) + +import qualified Streamly.Internal.Data.Stream as S +import qualified Streamly.Internal.Data.Array as A +import qualified Streamly.Internal.Data.Array.Generic as GA +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Parser as P +import qualified Streamly.Internal.Data.ParserK as PK +import qualified Streamly.Internal.Data.StreamK as K + +min_value :: Int +min_value = 0 + +mid_value :: Int +mid_value = 5000 + +max_value :: Int +max_value = 10000 + +max_length :: Int +max_length = 1000 + +-- TODO: Replace ParserTestCase_Temp with ParserTestCase in all the test cases. + +type ParserTestCase a m b c = + (P.Parser a m b -> [a] -> m (Either ParseErrorPos b, [a])) -> c + +type ParserTestCase_Temp a m b c = + forall t. ([a] -> t) + -> (P.Parser a m b -> t -> m (Either ParseErrorPos b)) + -> c + +------------------------------------------------------------------------------- +-- Test driver +------------------------------------------------------------------------------- + +data TestMode + = TMParserStream + | TMParserKStreamK + | TMParserKStreamKChunks + | TMParserKStreamKChunksGeneric + deriving (Show) + +runParserTC :: (Unbox a, Monad m) => TestMode -> ParserTestCase a m b c -> c +runParserTC tm runner = + case tm of + TMParserStream -> + runner $ \p -> mapMTup S.toList . S.parseBreakPos p . S.fromList + TMParserKStreamK -> + runner $ \p -> + mapMTup K.toList . K.parseBreakPos (PK.toParserK p) . K.fromList + TMParserKStreamKChunks -> + runner $ \p -> + mapMTup + (fmap (concatMap A.toList) . K.toList) + . A.parseBreakPos (A.toParserK p) + . producerChunks A.fromList + TMParserKStreamKChunksGeneric -> + runner $ \p -> + mapMTup + (fmap (concatMap GA.toList) . K.toList) + . GA.parseBreakPos (GA.toParserK p) + . producerChunks GA.fromList + + where + mapMTup f tupM = do + (t, a) <- tupM + (t,) <$> f a + + cSize = 50 + -- Not using A.createOf here because of the MonadIO constraint + producerChunks fl = + K.fromStream + . S.groupsOf cSize (fl <$> FL.toList) + . S.fromList + +runParserTC_temp :: (Unbox a, Monad m) => TestMode -> ParserTestCase_Temp a m b c -> c +runParserTC_temp tm runner = + case tm of + TMParserStream -> runner S.fromList S.parsePos + TMParserKStreamK -> runner K.fromList (K.parsePos . PK.toParserK) + TMParserKStreamKChunks -> + runner (producerChunks A.fromList) (A.parsePos . A.toParserK) + TMParserKStreamKChunksGeneric -> + runner + (producerChunks GA.fromList) + (GA.parsePos . GA.toParserK) + + where + cSize = 50 + -- Not using A.createOf here because of the MonadIO constraint + producerChunks fl = + K.fromStream + . S.groupsOf cSize (fl <$> FL.toList) + . S.fromList diff --git a/test/lib/Streamly/Test/Data/Parser/CommonTests.hs b/test/lib/Streamly/Test/Data/Parser/CommonTests.hs index 53aa339946..e6dd0ce19a 100644 --- a/test/lib/Streamly/Test/Data/Parser/CommonTests.hs +++ b/test/lib/Streamly/Test/Data/Parser/CommonTests.hs @@ -17,76 +17,43 @@ -- One problem is that this module becomes very big for compilation. We can -- break this further and keep them as a part of "other-modules" in -- Test.Parser test-suite. -module Streamly.Test.Data.Parser.CommonTests (mainCommon, TestMode(..), takeWhileFailD) where +module Streamly.Test.Data.Parser.CommonTests (mainCommon) where -import Control.Applicative ((<|>)) import Control.Exception (displayException, try, evaluate, SomeException) import Data.List (isSuffixOf) -import Streamly.Internal.Data.Fold (Fold(..)) -import Streamly.Internal.Data.MutByteArray (Unbox) import Streamly.Test.Common (listEquals, checkListEqual, chooseInt) -import Streamly.Internal.Data.Parser (ParseErrorPos(..), Parser(..), Step(..), Initial(..), Final(..)) import Test.QuickCheck - (arbitrary, forAll, elements, Property, property, listOf, - vectorOf, Gen, (.&&.), ioProperty) -import Test.QuickCheck.Monadic (monadicIO, assert, run, PropertyM) + (arbitrary, forAll, elements, Gen, Property, property, listOf, + vectorOf, (.&&.), ioProperty) +import Test.QuickCheck.Monadic (monadicIO, assert) import Prelude hiding (sequence, take, takeWhile) -import qualified Control.Monad.Fail as Fail import qualified Data.List as List import qualified Prelude import qualified Streamly.Internal.Data.Stream as S -import qualified Streamly.Internal.Data.Array as A -import qualified Streamly.Internal.Data.Array.Generic as GA import qualified Streamly.Internal.Data.Fold as FL import qualified Streamly.Internal.Data.Parser as P -import qualified Streamly.Internal.Data.ParserK as PK -import qualified Streamly.Internal.Data.StreamK as K import Test.Hspec import Test.Hspec.QuickCheck -#if MIN_VERSION_QuickCheck(2,14,0) +import Control.Monad.Identity (Identity(runIdentity)) -import Test.QuickCheck (chooseAny) -import Control.Monad.Identity (Identity(runIdentity, Identity)) - -#else - -import System.Random (Random(random)) -import Test.QuickCheck.Gen (Gen(MkGen)) - --- | Generates a random element over the natural range of `a`. -chooseAny :: Random a => Gen a -chooseAny = MkGen (\r _ -> let (x,_) = random r in x) - -#endif - -min_value :: Int -min_value = 0 - -mid_value :: Int -mid_value = 5000 - -max_value :: Int -max_value = 10000 - -max_length :: Int -max_length = 1000 +import Streamly.Test.Data.Parser.CommonTestDriver + ( TestMode + , ParserTestCase + , ParserTestCase_Temp + , runParserTC + , runParserTC_temp + , min_value + , mid_value + , max_value + , max_length + ) -- Accumulator Tests --- TODO: Replace ParserTestCase_Temp with ParserTestCase in all the test cases. - -type ParserTestCase a m b c = - (P.Parser a m b -> [a] -> m (Either ParseErrorPos b, [a])) -> c - -type ParserTestCase_Temp a m b c = - forall t. ([a] -> t) - -> (P.Parser a m b -> t -> m (Either ParseErrorPos b)) - -> c - fromFold :: ParserTestCase Int IO Int Property fromFold consumer = forAll (listOf $ chooseInt (min_value, max_value)) $ \ls -> @@ -98,43 +65,6 @@ fromFold consumer = Right o1 -> o1 == o2 Left _ -> False -fromPure :: ParserTestCase Int Identity Int Property -fromPure consumer = - forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ consumer (P.fromPure x) [1 :: Int] of - (Right r, rest) -> r == x && rest == [1 :: Int] - (Left _, _) -> False - -fromEffect :: ParserTestCase Int Identity Int Property -fromEffect consumer = - forAll (chooseInt (min_value, max_value)) $ \x -> - case runIdentity $ consumer (P.fromEffect $ return x) [1 :: Int] of - (Right r, rest) -> r == x && rest == [1 :: Int] - (Left _, _) -> False - -die :: ParserTestCase Int Identity Int Property -die consumer = - property $ - case runIdentity $ consumer (P.die "die test") [0 :: Int] of - (Right _, _) -> False - (Left _, rest) -> rest == [0 :: Int] - -dieM :: ParserTestCase Int Identity Int Property -dieM consumer = - property $ - case runIdentity $ consumer (P.dieM (Identity "die test")) [0 :: Int] of - (Right _, _) -> False - (Left _, rest) -> rest == [0 :: Int] - -parserFail :: ParserTestCase Int Identity Int Property -parserFail consumer = - property $ - case runIdentity $ consumer (Fail.fail err) [0 :: Int] of - (Right _, _) -> False - (Left (ParseErrorPos _ e), rest) -> err == e && rest == [0 :: Int] - where - err = "Testing MonadFail.fail." - -- Element Parser Tests peekPass :: ParserTestCase Int Identity Int Property @@ -570,35 +500,6 @@ wordBy producer consumer = let wrds = words lst in if wrds == [] && length lst > 0 then [""] else wrds -splitWith :: ParserTestCase_Temp Int Identity (Int, Int) Property -splitWith producer consumer = - forAll (listOf (chooseInt (0, 1))) $ \ls -> - case runIdentity $ consumer (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (producer ls) of - Right (result_first, result_second) -> case ls of - 0 : 1 : _ -> (result_first == 0) && (result_second == 1) - _ -> False - Left _ -> case ls of - 0 : 1 : _ -> False - _ -> True - -splitWithFailLeft :: ParserTestCase_Temp Int Identity (Int, Int) Property -splitWithFailLeft producer consumer = - property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of - Right _ -> False - Left _ -> True) - -splitWithFailRight :: ParserTestCase_Temp Int Identity (Int, Int) Property -splitWithFailRight producer consumer = - property (case runIdentity $ consumer (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of - Right _ -> False - Left _ -> True) - -splitWithFailBoth :: ParserTestCase_Temp Int Identity (Int, Int) Property -splitWithFailBoth producer consumer = - property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of - Right _ -> False - Left _ -> True) - -- teeWithPass :: ParserTestCase_Temp Int Identity Int Property -- teeWithPass producer consumer = -- forAll (chooseInt (min_value, max_value)) $ \n -> @@ -750,73 +651,15 @@ someFail producer consumer = Right _ -> False Left _ -> True) -------------------------------------------------------------------------------- --- Instances -------------------------------------------------------------------------------- - -applicative :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property -applicative producer consumer = - forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> - forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> - let parser = - (,) - <$> P.fromFold (FL.take (length list1) FL.toList) - <*> P.fromFold (FL.take (length list2) FL.toList) - in - case runIdentity $ consumer parser (producer $ list1 ++ list2) of - Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 - Left _ -> False - -sequence :: ParserTestCase_Temp Int IO [[Int]] Property -sequence producer consumer = - forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins -> - let p xs = P.fromFold (FL.take (length xs) FL.toList) - in monadicIO $ do - outs <- run $ - consumer - (Prelude.sequence $ fmap p ins) - (producer $ concat ins) - return $ - case outs of - Right ls -> ls == ins - Left _ -> False - -altEOF1 :: ParserTestCase_Temp Int (PropertyM IO) Int Property -altEOF1 producer consumer = - monadicIO $ do - s1 <- consumer - (P.satisfy (> 0) <|> return 66) - (producer ([]::[Int])) - return $ - case s1 of - Right x -> x == 66 - Left _ -> False - -altEOF2 :: ParserTestCase_Temp Int (PropertyM IO) [Int] Property -altEOF2 producer consumer = - monadicIO $ do - s1 <- consumer - ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList)) - (producer ([51]::[Int])) - return $ - case s1 of - Right x -> x == [51] - Left _ -> False - -monad :: ParserTestCase_Temp Int (PropertyM IO) ([Int], [Int]) Property -monad producer consumer = - forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> - forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> - let parser = do - olist1 <- P.fromFold (FL.take (length list1) FL.toList) - olist2 <- P.fromFold (FL.take (length list2) FL.toList) - return (olist1, olist2) - in monadicIO $ do - s <- consumer parser (producer $ list1 ++ list2) - return $ - case s of - Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 - Left _ -> False +parserSequence :: ParserTestCase_Temp Int Identity Int Property +parserSequence producer consumer = + forAll (vectorOf 11 (listOf (arbitrary :: Gen Int))) $ \ins -> + let parsers = S.fromList + $ fmap (\xs -> P.fromFold $ FL.take (Prelude.length xs) FL.sum) ins + sequencedParser = P.sequence parsers FL.sum + in case runIdentity $ consumer sequencedParser (producer (concat ins)) of + Right x -> x == sum (map sum ins) + Left _ -> False takeEndBy1 :: ParserTestCase_Temp Int Identity [Int] Property takeEndBy1 producer consumer = @@ -1085,113 +928,18 @@ takeStartBy_ producer consumer = predicate = odd parser = P.takeBeginBy_ predicate FL.toList -{-# INLINE takeWhileFailD #-} -takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b -takeWhileFailD predicate (Fold fstep finitial _ ffinal) = - Parser step initial extract - - where - - initial = do - res <- finitial - return $ case res of - FL.Partial s -> IPartial s - FL.Done b -> IDone b - - step s a = - if predicate a - then do - fres <- fstep s a - return - $ case fres of - FL.Partial s1 -> SContinue 1 s1 - FL.Done b -> SDone 1 b - else return $ SError "fail" - - extract s = fmap (FDone 0) (ffinal s) - ------------------------------------------------------------------------------- -- Main ------------------------------------------------------------------------------- -data TestMode - = TMParserStream - | TMParserKStreamK - | TMParserKStreamKChunks - | TMParserKStreamKChunksGeneric - deriving (Show) - -runParserTC :: (Unbox a, Monad m) => TestMode -> ParserTestCase a m b c -> c -runParserTC tm runner = - case tm of - TMParserStream -> - runner $ \p -> mapMTup S.toList . S.parseBreakPos p . S.fromList - TMParserKStreamK -> - runner $ \p -> - mapMTup K.toList . K.parseBreakPos (PK.toParserK p) . K.fromList - TMParserKStreamKChunks -> - runner $ \p -> - mapMTup - (fmap (concatMap A.toList) . K.toList) - . A.parseBreakPos (A.toParserK p) - . producerChunks A.fromList - TMParserKStreamKChunksGeneric -> - runner $ \p -> - mapMTup - (fmap (concatMap GA.toList) . K.toList) - . GA.parseBreakPos (GA.toParserK p) - . producerChunks GA.fromList - - where - mapMTup f tupM = do - (t, a) <- tupM - (t,) <$> f a - - cSize = 50 - -- Not using A.createOf here because of the MonadIO constraint - producerChunks fl = - K.fromStream - . S.groupsOf cSize (fl <$> FL.toList) - . S.fromList - -runParserTC_temp :: (Unbox a, Monad m) => TestMode -> ParserTestCase_Temp a m b c -> c -runParserTC_temp tm runner = - case tm of - TMParserStream -> runner S.fromList S.parsePos - TMParserKStreamK -> runner K.fromList (K.parsePos . PK.toParserK) - TMParserKStreamKChunks -> - runner (producerChunks A.fromList) (A.parsePos . A.toParserK) - TMParserKStreamKChunksGeneric -> - runner - (producerChunks GA.fromList) - (GA.parsePos . GA.toParserK) - - where - cSize = 50 - -- Not using A.createOf here because of the MonadIO constraint - producerChunks fl = - K.fromStream - . S.groupsOf cSize (fl <$> FL.toList) - . S.fromList - {-# NOINLINE mainCommon #-} mainCommon :: TestMode -> Spec mainCommon ptt = do + -- This file has tests corresponding to Parser.hs source file that are common + -- to Parser and ParserK. describe (show ptt) $ do - describe "Instances" $ do - prop "applicative" $ runParserTC_temp ptt applicative - prop "Alternative: end of input 1" $ runParserTC_temp ptt altEOF1 - prop "Alternative: end of input 2" $ runParserTC_temp ptt altEOF2 - prop "monad" $ runParserTC_temp ptt monad - prop "sequence" $ runParserTC_temp ptt sequence - describe "test for accumulator" $ do prop "P.fromFold FL.sum = FL.sum" $ runParserTC ptt fromFold - prop "fromPure value provided" $ runParserTC ptt fromPure - prop "fromPure monadic value provided" $ runParserTC ptt fromEffect - prop "fail err = Left (SomeException (ParseError err))" $ runParserTC ptt parserFail - prop "always fail" $ runParserTC ptt die - prop "always fail but monadic" $ runParserTC ptt dieM describe "test for element parser" $ do prop "peek = head with list length > 0" $ runParserTC ptt peekPass @@ -1227,10 +975,6 @@ mainCommon ptt = do prop "groupByRolling" $ runParserTC_temp ptt groupByRolling prop "many (P.wordBy ' ') = words'" $ runParserTC_temp ptt wordBy -- prop "choice" choice - prop "parse 0, then 1, else fail" $ runParserTC_temp ptt splitWith - prop "fail due to die as left parser" $ runParserTC_temp ptt splitWithFailLeft - prop "fail due to die as right parser" $ runParserTC_temp ptt splitWithFailRight - prop "fail due to die as both parsers" $ runParserTC_temp ptt splitWithFailBoth -- prop "" teeWithPass -- prop "" teeWithFailLeft -- prop "" teeWithFailRight @@ -1246,6 +990,7 @@ mainCommon ptt = do prop ("P.some concatFold $ P.takeEndBy_ (== 1) FL.toList =" ++ "Prelude.filter (== 0)") $ runParserTC_temp ptt some prop "fail due to parser being die" $ runParserTC_temp ptt someFail + prop "parserSequence" $ runParserTC_temp ptt parserSequence prop "takeEndBy_" $ runParserTC ptt takeEndBy_ prop "takeEndByOrMax_" $ runParserTC ptt takeEndByOrMax_ prop "takeEndBy1" $ runParserTC_temp ptt takeEndBy1 diff --git a/test/lib/Streamly/Test/Data/Parser/CommonTypeTests.hs b/test/lib/Streamly/Test/Data/Parser/CommonTypeTests.hs new file mode 100644 index 0000000000..3507701be8 --- /dev/null +++ b/test/lib/Streamly/Test/Data/Parser/CommonTypeTests.hs @@ -0,0 +1,259 @@ +{-# Language NoMonoLocalBinds #-} +-- | Common tests corresponding to the +-- @Streamly.Internal.Data.Parser.Type@ module (the parser type, its +-- instances and the primitive combinators defined alongside it). +module Streamly.Test.Data.Parser.CommonTypeTests (mainCommonType) where + +import Control.Applicative ((<|>)) +import Streamly.Internal.Data.Fold (Fold(..)) +import Streamly.Internal.Data.Parser + (ParseErrorPos(..), Parser(..), Step(..), Initial(..), Final(..)) +import Streamly.Test.Common (chooseInt) +import Test.QuickCheck + (forAll, Property, property, listOf, vectorOf, Gen) +import Test.QuickCheck.Monadic (monadicIO, run, PropertyM) + +import Prelude hiding (sequence) + +import qualified Control.Monad.Fail as Fail +import qualified Prelude +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Parser as P + +import Test.Hspec +import Test.Hspec.QuickCheck + +import Streamly.Test.Data.Parser.CommonTestDriver + ( TestMode + , ParserTestCase + , ParserTestCase_Temp + , runParserTC + , runParserTC_temp + , min_value + , max_value + ) + +#if MIN_VERSION_QuickCheck(2,14,0) + +import Test.QuickCheck (chooseAny) +import Control.Monad.Identity (Identity(runIdentity, Identity)) + +#else + +import System.Random (Random(random)) +import Test.QuickCheck.Gen (Gen(MkGen)) + +-- | Generates a random element over the natural range of `a`. +chooseAny :: Random a => Gen a +chooseAny = MkGen (\r _ -> let (x,_) = random r in x) + +#endif + +-- | A 'takeWhile' that fails (instead of succeeding) when the predicate stops +-- holding. Used to exercise Alternative backtracking after a parser fails +-- mid-stream having already consumed input. +{-# INLINE takeWhileFailD #-} +takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b +takeWhileFailD predicate (Fold fstep finitial _ ffinal) = + Parser step initial extract + + where + + initial = do + res <- finitial + return $ case res of + FL.Partial s -> IPartial s + FL.Done b -> IDone b + + step s a = + if predicate a + then do + fres <- fstep s a + return + $ case fres of + FL.Partial s1 -> SContinue 1 s1 + FL.Done b -> SDone 1 b + else return $ SError "fail" + + extract s = fmap (FDone 0) (ffinal s) + +-- Accumulator Tests + +fromPure :: ParserTestCase Int Identity Int Property +fromPure consumer = + forAll (chooseInt (min_value, max_value)) $ \x -> + case runIdentity $ consumer (P.fromPure x) [1 :: Int] of + (Right r, rest) -> r == x && rest == [1 :: Int] + (Left _, _) -> False + +fromEffect :: ParserTestCase Int Identity Int Property +fromEffect consumer = + forAll (chooseInt (min_value, max_value)) $ \x -> + case runIdentity $ consumer (P.fromEffect $ return x) [1 :: Int] of + (Right r, rest) -> r == x && rest == [1 :: Int] + (Left _, _) -> False + +die :: ParserTestCase Int Identity Int Property +die consumer = + property $ + case runIdentity $ consumer (P.die "die test") [0 :: Int] of + (Right _, _) -> False + (Left _, rest) -> rest == [0 :: Int] + +dieM :: ParserTestCase Int Identity Int Property +dieM consumer = + property $ + case runIdentity $ consumer (P.dieM (Identity "die test")) [0 :: Int] of + (Right _, _) -> False + (Left _, rest) -> rest == [0 :: Int] + +parserFail :: ParserTestCase Int Identity Int Property +parserFail consumer = + property $ + case runIdentity $ consumer (Fail.fail err) [0 :: Int] of + (Right _, _) -> False + (Left (ParseErrorPos _ e), rest) -> err == e && rest == [0 :: Int] + where + err = "Testing MonadFail.fail." + +splitWith :: ParserTestCase_Temp Int Identity (Int, Int) Property +splitWith producer consumer = + forAll (listOf (chooseInt (0, 1))) $ \ls -> + case runIdentity $ consumer (P.splitWith (,) (P.satisfy (== 0)) (P.satisfy (== 1))) (producer ls) of + Right (result_first, result_second) -> case ls of + 0 : 1 : _ -> (result_first == 0) && (result_second == 1) + _ -> False + Left _ -> case ls of + 0 : 1 : _ -> False + _ -> True + +splitWithFailLeft :: ParserTestCase_Temp Int Identity (Int, Int) Property +splitWithFailLeft producer consumer = + property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.fromPure (1 :: Int))) (producer [1 :: Int]) of + Right _ -> False + Left _ -> True) + +splitWithFailRight :: ParserTestCase_Temp Int Identity (Int, Int) Property +splitWithFailRight producer consumer = + property (case runIdentity $ consumer (P.splitWith (,) (P.fromPure (1 :: Int)) (P.die "die")) (producer [1 :: Int]) of + Right _ -> False + Left _ -> True) + +splitWithFailBoth :: ParserTestCase_Temp Int Identity (Int, Int) Property +splitWithFailBoth producer consumer = + property (case runIdentity $ consumer (P.splitWith (,) (P.die "die") (P.die "die")) (producer [1 :: Int]) of + Right _ -> False + Left _ -> True) + +------------------------------------------------------------------------------- +-- Instances +------------------------------------------------------------------------------- + +applicative :: ParserTestCase_Temp Int Identity ([Int], [Int]) Property +applicative producer consumer = + forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> + forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> + let parser = + (,) + <$> P.fromFold (FL.take (length list1) FL.toList) + <*> P.fromFold (FL.take (length list2) FL.toList) + in + case runIdentity $ consumer parser (producer $ list1 ++ list2) of + Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 + Left _ -> False + +sequence :: ParserTestCase_Temp Int IO [[Int]] Property +sequence producer consumer = + forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins -> + let p xs = P.fromFold (FL.take (length xs) FL.toList) + in monadicIO $ do + outs <- run $ + consumer + (Prelude.sequence $ fmap p ins) + (producer $ concat ins) + return $ + case outs of + Right ls -> ls == ins + Left _ -> False + +altEOF1 :: ParserTestCase_Temp Int (PropertyM IO) Int Property +altEOF1 producer consumer = + monadicIO $ do + s1 <- consumer + (P.satisfy (> 0) <|> return 66) + (producer ([]::[Int])) + return $ + case s1 of + Right x -> x == 66 + Left _ -> False + +altEOF2 :: ParserTestCase_Temp Int (PropertyM IO) [Int] Property +altEOF2 producer consumer = + monadicIO $ do + s1 <- consumer + ((P.takeEQ 2 FL.toList) <|> (P.takeEQ 1 FL.toList)) + (producer ([51]::[Int])) + return $ + case s1 of + Right x -> x == [51] + Left _ -> False + +-- The left parser consumes 1..5 and then fails on 6 (mid-stream, with input +-- still available); the alternative backtracks and re-runs from the start, +-- consuming 1..7. +alt :: ParserTestCase_Temp Int (PropertyM IO) [Int] Property +alt producer consumer = + monadicIO $ do + s1 <- consumer + (takeWhileFailD (<= 5) FL.toList <|> P.takeWhile (<= 7) FL.toList) + (producer [1..20]) + return $ + case s1 of + Right x -> x == [1..7] + Left _ -> False + +monad :: ParserTestCase_Temp Int (PropertyM IO) ([Int], [Int]) Property +monad producer consumer = + forAll (listOf (chooseAny :: Gen Int)) $ \ list1 -> + forAll (listOf (chooseAny :: Gen Int)) $ \ list2 -> + let parser = do + olist1 <- P.fromFold (FL.take (length list1) FL.toList) + olist2 <- P.fromFold (FL.take (length list2) FL.toList) + return (olist1, olist2) + in monadicIO $ do + s <- consumer parser (producer $ list1 ++ list2) + return $ + case s of + Right (olist1, olist2) -> olist1 == list1 && olist2 == list2 + Left _ -> False + +------------------------------------------------------------------------------- +-- Main +------------------------------------------------------------------------------- + +{-# NOINLINE mainCommonType #-} +mainCommonType :: TestMode -> Spec +mainCommonType ptt = do + -- This file has tests corresponding to Parser/Type.hs source file that are + -- common to Parser and ParserK. + describe (show ptt) $ do + describe "Instances" $ do + prop "applicative" $ runParserTC_temp ptt applicative + prop "Alternative: end of input 1" $ runParserTC_temp ptt altEOF1 + prop "Alternative: end of input 2" $ runParserTC_temp ptt altEOF2 + prop "Alternative: backtrack after mid-stream failure" $ runParserTC_temp ptt alt + prop "monad" $ runParserTC_temp ptt monad + prop "sequence" $ runParserTC_temp ptt sequence + + describe "test for accumulator" $ do + prop "fromPure value provided" $ runParserTC ptt fromPure + prop "fromPure monadic value provided" $ runParserTC ptt fromEffect + prop "fail err = Left (SomeException (ParseError err))" $ runParserTC ptt parserFail + prop "always fail" $ runParserTC ptt die + prop "always fail but monadic" $ runParserTC ptt dieM + + describe "test for sequence parser" $ do + prop "parse 0, then 1, else fail" $ runParserTC_temp ptt splitWith + prop "fail due to die as left parser" $ runParserTC_temp ptt splitWithFailLeft + prop "fail due to die as right parser" $ runParserTC_temp ptt splitWithFailRight + prop "fail due to die as both parsers" $ runParserTC_temp ptt splitWithFailBoth diff --git a/test/streamly-tests.cabal b/test/streamly-tests.cabal index 089e0e6cce..bca6a4d7de 100644 --- a/test/streamly-tests.cabal +++ b/test/streamly-tests.cabal @@ -194,12 +194,12 @@ library exposed-modules: Streamly.Test.Common Streamly.Test.Data.Parser.CommonUtilities + Streamly.Test.Data.Parser.CommonTestDriver + Streamly.Test.Data.Parser.CommonTypeTests Streamly.Test.Data.Parser.CommonTests Streamly.Test.Control.Exception.Common if !flag(use-streamly-core) && flag(dev) exposed-modules: Streamly.Test.Prelude.Common - if flag(limit-build-mem) - ghc-options: +RTS -M1500M -RTS ------------------------------------------------------------------------------- -- Test suite options @@ -262,7 +262,7 @@ test-suite Data.Array.Generic test-suite Data.Binary import: test-options type: exitcode-stdio-1.0 - main-is: Streamly/Test/Serialize/Serializable.hs + main-is: Streamly/Test/Data/Binary.hs test-suite Data.Fold import: test-options @@ -276,7 +276,18 @@ test-suite Data.Fold Streamly.Test.Data.Fold.Exception Streamly.Test.Data.Fold.Tee Streamly.Test.Data.Fold.Type - Streamly.Test.Data.Fold.Window + +test-suite Data.Scanl + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/Scanl.hs + hs-source-dirs: . + ghc-options: -main-is Main.main + other-modules: + Streamly.Test.Data.Scanl.Combinators + Streamly.Test.Data.Scanl.Container + Streamly.Test.Data.Scanl.Type + Streamly.Test.Data.Scanl.Window -- The Streamly.Data.List needs to be fixed to enable this -- test-suite Data.List @@ -362,6 +373,7 @@ test-suite Data.Parser import: test-options type: exitcode-stdio-1.0 main-is: Streamly/Test/Data/Parser.hs + other-modules: Streamly.Test.Data.Parser.Type if flag(limit-build-mem) ghc-options: +RTS -M1000M -RTS @@ -369,6 +381,7 @@ test-suite Data.ParserK import: test-options type: exitcode-stdio-1.0 main-is: Streamly/Test/Data/ParserK.hs + other-modules: Streamly.Test.Data.ParserK.Type test-suite Data.ParserK.Chunked import: test-options @@ -386,6 +399,12 @@ test-suite Data.RingArray main-is: Streamly/Test/Data/RingArray.hs ghc-options: -main-is Streamly.Test.Data.RingArray.main +test-suite Data.RingArray.Generic + import: test-options + type: exitcode-stdio-1.0 + main-is: Streamly/Test/Data/RingArray/Generic.hs + ghc-options: -main-is Streamly.Test.Data.RingArray.Generic.main + test-suite Data.Scanl.Concurrent import: test-options type: exitcode-stdio-1.0