From a447c096b0fbd776e86b2d24b01faebb64e18dad Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Mon, 22 Jun 2026 23:57:00 +0530 Subject: [PATCH 1/3] Remove deprecated StreamD module --- core/docs/Changelog.md | 2 ++ .../src/Streamly/Internal/Data/Stream/StreamD.hs | 16 ---------------- core/streamly-core.cabal | 1 - 3 files changed, 2 insertions(+), 17 deletions(-) delete mode 100644 core/src/Streamly/Internal/Data/Stream/StreamD.hs diff --git a/core/docs/Changelog.md b/core/docs/Changelog.md index bb172ccb03..d0af7fafcf 100644 --- a/core/docs/Changelog.md +++ b/core/docs/Changelog.md @@ -14,6 +14,8 @@ default. Literally identical relative paths (e.g. `./x` and `./x`, or `c:` and `c:` on Windows) now compare equal. Pass `allowRelativeEquality False` to restore the previous strict behaviour. +* Internal: Removed deprecated module `Streamly.Internal.Data.Stream.StreamD`. + Use `Streamly.Internal.Data.Stream` instead. ## 0.3.1 (May 2026) diff --git a/core/src/Streamly/Internal/Data/Stream/StreamD.hs b/core/src/Streamly/Internal/Data/Stream/StreamD.hs deleted file mode 100644 index 4d2d86c599..0000000000 --- a/core/src/Streamly/Internal/Data/Stream/StreamD.hs +++ /dev/null @@ -1,16 +0,0 @@ --- | --- Module : Streamly.Internal.Data.Stream.StreamD --- Copyright : (c) 2018 Composewell Technologies --- License : BSD-3-Clause --- Maintainer : streamly@composewell.com --- Stability : experimental --- Portability : GHC - -module Streamly.Internal.Data.Stream.StreamD -{-# DEPRECATED "Please use \"Streamly.Internal.Data.Stream\" instead." #-} - ( - module Streamly.Internal.Data.Stream - ) -where - -import Streamly.Internal.Data.Stream diff --git a/core/streamly-core.cabal b/core/streamly-core.cabal index 7616b79ec4..7f803e5558 100644 --- a/core/streamly-core.cabal +++ b/core/streamly-core.cabal @@ -480,7 +480,6 @@ library -- Deprecated in 0.2.0 , Streamly.Internal.Data.MutArray.Stream , Streamly.Internal.Data.Array.Stream - , Streamly.Internal.Data.Stream.StreamD , Streamly.Internal.Data.Fold.Chunked -- Only those modules should be here which are fully re-exported via some From 9082622204a0a6d43de31ce492729ecdd11f1975 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 24 Jun 2026 12:43:14 +0530 Subject: [PATCH 2/3] Add missing Scanl benchmarks --- benchmark/Streamly/Benchmark/Data/Scanl.hs | 173 +---- .../Benchmark/Data/Scanl/Combinators.hs | 675 ++++++++++++++++++ .../Benchmark/Data/Scanl/Container.hs | 255 +++++++ .../Streamly/Benchmark/Data/Scanl/Type.hs | 530 ++++++++++++++ benchmark/streamly-benchmarks.cabal | 5 +- 5 files changed, 1476 insertions(+), 162 deletions(-) create mode 100644 benchmark/Streamly/Benchmark/Data/Scanl/Combinators.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Scanl/Container.hs create mode 100644 benchmark/Streamly/Benchmark/Data/Scanl/Type.hs diff --git a/benchmark/Streamly/Benchmark/Data/Scanl.hs b/benchmark/Streamly/Benchmark/Data/Scanl.hs index 0bbef4190d..60a7e8fbe9 100644 --- a/benchmark/Streamly/Benchmark/Data/Scanl.hs +++ b/benchmark/Streamly/Benchmark/Data/Scanl.hs @@ -5,190 +5,41 @@ -- License : MIT -- Maintainer : streamly@composewell.com -#undef FUSION_CHECK -#ifdef FUSION_CHECK -{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} -#endif - -#ifdef __HADDOCK_VERSION__ -#undef INSPECTION -#endif - -#ifdef INSPECTION -{-# LANGUAGE TemplateHaskell #-} -{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} -#endif - {-# LANGUAGE CPP #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE ScopedTypeVariables #-} -{-# OPTIONS_GHC -Wno-orphans #-} module Main (main) where -import Data.IORef (IORef, newIORef, readIORef, modifyIORef) -import Control.DeepSeq (NFData(..)) -import Data.Functor.Identity (Identity(..)) -import System.Random (randomRIO) -import System.IO.Unsafe (unsafePerformIO) - -import Streamly.Internal.Data.Stream (Stream) -import Streamly.Internal.Data.Scanl (Scanl(..)) -import Streamly.Internal.Data.MutArray (MutArray) - -import qualified Data.Set as Set -import qualified Streamly.Internal.Data.Fold as FL -import qualified Streamly.Internal.Data.Scanl as Scanl -import qualified Streamly.Internal.Data.Stream as Stream - -import Test.Tasty.Bench hiding (env) +import Test.Tasty.Bench (bgroup) import Streamly.Benchmark.Common -import Prelude hiding (last, length, all, any, take, unzip, sequence_) +import qualified Scanl.Type as Type +import qualified Scanl.Combinators as Combinators +import qualified Scanl.Container as Container import qualified Scanl.Window as Window -#ifdef INSPECTION -import GHC.Types (SPEC(..)) -import Streamly.Internal.Data.Stream (Step(..)) - -import Test.Inspection -#endif - -------------------------------------------------------------------------------- --- Helpers ------------------------------------------------------------------------------- - -{-# INLINE source #-} -source :: (Monad m, Num a, Stream.Enumerable a) => - Int -> a -> Stream m a -source len from = - Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len) - -{-# INLINE benchIO #-} -benchIO :: NFData b => String -> IO b -> Benchmark -benchIO name = bench name . nfIO - -{-# INLINE withStream #-} -withStream :: Int -> (Stream IO Int -> IO b) -> IO b -withStream len f = randomRIO (1, 1 :: Int) >>= f . source len - -{-# INLINE limitedSum #-} -limitedSum :: Int -> Scanl IO Int Int -limitedSum n = Scanl.take n Scanl.sum - -{-# INLINE getKey #-} -getKey :: Int -> Int -> Int -getKey buckets = (`mod` buckets) - -{-# INLINE afterDone #-} -afterDone :: IO () -> Scanl IO a b -> Scanl IO a b -afterDone action (Scanl step i e f) = Scanl step1 i e f - where - step1 x a = do - res <- step x a - case res of - Scanl.Partial s1 -> pure $ Scanl.Partial s1 - Scanl.Done b -> action >> pure (Scanl.Done b) - -{-# NOINLINE ref #-} -ref :: IORef (Set.Set Int) -ref = unsafePerformIO $ newIORef Set.empty - -{-# INLINE getScanl #-} -getScanl :: Int -> IO (Maybe (Scanl IO Int Int)) -getScanl k = do - set <- readIORef ref - if Set.member k set - then pure Nothing - else pure - $ Just - $ afterDone (modifyIORef ref (Set.insert k)) (limitedSum 100) - -------------------------------------------------------------------------------- --- Benchmarks +-- Driver ------------------------------------------------------------------------------- moduleName :: String moduleName = "Data.Scanl" -instance NFData (MutArray a) where - {-# INLINE rnf #-} - rnf _ = () - -instance NFData a => NFData (Stream Identity a) where - {-# INLINE rnf #-} - rnf xs = runIdentity $ Stream.fold (FL.foldl' (\_ x -> rnf x) ()) xs - -{-# INLINE demuxIOOneShot #-} -demuxIOOneShot :: Int -> IO () -demuxIOOneShot len = - withStream len $ - Stream.fold FL.drain - . Stream.postscanl (Scanl.demuxIO (getKey 64) getScanl) - -{-# INLINE demuxSum #-} -demuxSum :: Int -> IO () -demuxSum len = - withStream len $ - Stream.fold FL.drain - . Stream.postscanl (Scanl.demuxIO (getKey 64) (const (pure (Just Scanl.sum)))) - -#ifdef INSPECTION --- inspect $ 'demuxSum `hasNoType` ''Step --- inspect $ 'demuxSum `hasNoType` ''FL.Step -inspect $ 'demuxSum `hasNoType` ''SPEC -#endif - -{-# INLINE classifyLimitedSum #-} -classifyLimitedSum :: Int -> IO () -classifyLimitedSum len = - withStream len $ - Stream.fold FL.drain - . Stream.postscanl (Scanl.classifyIO (getKey 64) (limitedSum 100)) - -#ifdef INSPECTION --- inspect $ 'classifyLimitedSum `hasNoType` ''Step -inspect $ 'classifyLimitedSum `hasNoType` ''FL.Step -inspect $ 'classifyLimitedSum `hasNoType` ''SPEC -#endif - -{-# INLINE classifySum #-} -classifySum :: Int -> IO () -classifySum len = - withStream len $ - Stream.fold FL.drain - . Stream.postscanl (Scanl.classifyIO (getKey 64) Scanl.sum) - -#ifdef INSPECTION --- inspect $ 'classifySum `hasNoType` ''Step -inspect $ 'classifySum `hasNoType` ''FL.Step -inspect $ 'classifySum `hasNoType` ''SPEC -#endif - -o_1_space_serial :: Int -> [(SpaceComplexity, Benchmark)] -o_1_space_serial value = - [ (SpaceO_1, benchIO "demuxIO (1-shot) (64 buckets) [sum 100]" $ demuxIOOneShot value) - , (SpaceO_1, benchIO "demuxIO (64 buckets) [sum]" $ demuxSum value) - , (SpaceO_1, benchIO "classifyIO (64 buckets) [sum 100]" $ classifyLimitedSum value) - , (SpaceO_1, benchIO "classifyIO (64 buckets) [sum]" $ classifySum value) - ] - -------------------------------------------------------------------------------- --- Driver -------------------------------------------------------------------------------- - main :: IO () main = runWithCLIOpts defaultStreamSize allBenchmarks where allBenchmarks value = - let allBenches = o_1_space_serial value + let allBenches = Type.benchmarks value + ++ Combinators.benchmarks value + ++ Container.benchmarks value ++ Window.benchmarks value get x = map snd $ filter ((==) x . fst) allBenches o_1_space = get SpaceO_1 + o_n_space = get SpaceO_n + o_n_heap = get HeapO_n in [ bgroup (o_1_space_prefix moduleName) o_1_space + , bgroup (o_n_space_prefix moduleName) o_n_space + , bgroup (o_n_heap_prefix moduleName) o_n_heap ] diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Combinators.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Combinators.hs new file mode 100644 index 0000000000..dd19feb419 --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Combinators.hs @@ -0,0 +1,675 @@ +-- | +-- Module : Scanl.Combinators +-- Copyright : (c) 2024 Composewell +-- +-- License : MIT +-- Maintainer : streamly@composewell.com + +#undef FUSION_CHECK +#ifdef FUSION_CHECK +{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} +#endif + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- Benchmarks for operations exported from Streamly.Internal.Data.Scanl.Combinators. +module Scanl.Combinators (benchmarks) where + +import Data.Monoid (Sum(..)) +import Streamly.Internal.Data.Scanl (Scanl) +import Streamly.Internal.Data.Stream (Stream) +import System.Random (randomRIO) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Pipe as Pipe +import qualified Streamly.Internal.Data.Scanl as Scanl +import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Unfold as Unfold + +import Streamly.Benchmark.Common +import Test.Tasty.Bench +import Prelude hiding (sum, product, mconcat, foldMap, unzip) + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Streamly.Internal.Data.Stream (Step(..)) +import Test.Inspection +#endif + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +{-# INLINE sourceUnfoldrM #-} +sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int +sourceUnfoldrM value n = Stream.unfoldrM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream n f = randomRIO (1, 1) >>= f . sourceUnfoldrM n + +{-# INLINE withPostscanl #-} +withPostscanl :: Int -> Scanl IO Int b -> IO () +withPostscanl n s = withStream n $ Stream.fold FL.drain . Stream.postscanl s + +{-# INLINE withPostscanlMap #-} +withPostscanlMap :: Int -> (Int -> a) -> Scanl IO a b -> IO () +withPostscanlMap n f s = + withStream n $ Stream.fold FL.drain . Stream.postscanl s . fmap f + +{-# INLINE benchIO #-} +benchIO :: String -> (Int -> IO ()) -> Int -> Benchmark +benchIO name f value = bench name $ nfIO $ f value + +{-# INLINE oddEven #-} +oddEven :: Int -> Either Int Int +oddEven x = if odd x then Left x else Right x + +------------------------------------------------------------------------------- +-- Semigroups and monoids +------------------------------------------------------------------------------- + +{-# INLINE sconcat #-} +sconcat :: Int -> IO () +sconcat n = withPostscanlMap n Sum (Scanl.sconcat (Sum 0)) + +#ifdef INSPECTION +inspect $ 'sconcat `hasNoType` ''Step +inspect $ 'sconcat `hasNoType` ''FL.Step +inspect $ 'sconcat `hasNoType` ''SPEC +#endif + +{-# INLINE mconcat #-} +mconcat :: Int -> IO () +mconcat n = withPostscanlMap n Sum Scanl.mconcat + +#ifdef INSPECTION +inspect $ 'mconcat `hasNoType` ''Step +inspect $ 'mconcat `hasNoType` ''FL.Step +inspect $ 'mconcat `hasNoType` ''SPEC +#endif + +{-# INLINE foldMap #-} +foldMap :: Int -> IO () +foldMap n = withPostscanl n (Scanl.foldMap Sum) + +#ifdef INSPECTION +inspect $ 'foldMap `hasNoType` ''Step +inspect $ 'foldMap `hasNoType` ''FL.Step +inspect $ 'foldMap `hasNoType` ''SPEC +#endif + +{-# INLINE foldMapM #-} +foldMapM :: Int -> IO () +foldMapM n = withPostscanl n (Scanl.foldMapM (return . Sum)) + +#ifdef INSPECTION +inspect $ 'foldMapM `hasNoType` ''Step +inspect $ 'foldMapM `hasNoType` ''FL.Step +inspect $ 'foldMapM `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Reducers +------------------------------------------------------------------------------- + +{-# INLINE drainMapM #-} +drainMapM :: Int -> IO () +drainMapM n = withPostscanl n (Scanl.drainMapM return) + +#ifdef INSPECTION +inspect $ 'drainMapM `hasNoType` ''Step +inspect $ 'drainMapM `hasNoType` ''FL.Step +inspect $ 'drainMapM `hasNoType` ''SPEC +#endif + +{-# INLINE the #-} +the :: Int -> IO () +the n = withPostscanlMap n (const (1 :: Int)) Scanl.the + +#ifdef INSPECTION +inspect $ 'the `hasNoType` ''Step +inspect $ 'the `hasNoType` ''FL.Step +inspect $ 'the `hasNoType` ''SPEC +#endif + +{-# INLINE mean #-} +mean :: Int -> IO () +mean n = withPostscanlMap n (fromIntegral :: Int -> Double) Scanl.mean + +#ifdef INSPECTION +inspect $ 'mean `hasNoType` ''Step +inspect $ 'mean `hasNoType` ''FL.Step +inspect $ 'mean `hasNoType` ''SPEC +#endif + +{-# INLINE rollingHash #-} +rollingHash :: Int -> IO () +rollingHash n = withPostscanl n Scanl.rollingHash + +#ifdef INSPECTION +inspect $ 'rollingHash `hasNoType` ''Step +inspect $ 'rollingHash `hasNoType` ''FL.Step +inspect $ 'rollingHash `hasNoType` ''SPEC +#endif + +{-# INLINE rollingHashWithSalt #-} +rollingHashWithSalt :: Int -> IO () +rollingHashWithSalt n = withPostscanl n (Scanl.rollingHashWithSalt Scanl.defaultSalt) + +#ifdef INSPECTION +inspect $ 'rollingHashWithSalt `hasNoType` ''Step +inspect $ 'rollingHashWithSalt `hasNoType` ''FL.Step +inspect $ 'rollingHashWithSalt `hasNoType` ''SPEC +#endif + +{-# INLINE rollingHashFirstN #-} +rollingHashFirstN :: Int -> IO () +rollingHashFirstN n = withPostscanl n (Scanl.rollingHashFirstN n) + +#ifdef INSPECTION +inspect $ 'rollingHashFirstN `hasNoType` ''Step +inspect $ 'rollingHashFirstN `hasNoType` ''SPEC +#endif + +{-# INLINE sum #-} +sum :: Int -> IO () +sum n = withPostscanl n Scanl.sum + +#ifdef INSPECTION +inspect $ 'sum `hasNoType` ''Step +inspect $ 'sum `hasNoType` ''FL.Step +inspect $ 'sum `hasNoType` ''SPEC +#endif + +{-# INLINE product #-} +product :: Int -> IO () +product n = withPostscanl n Scanl.product + +#ifdef INSPECTION +inspect $ 'product `hasNoType` ''Step +inspect $ 'product `hasNoType` ''FL.Step +inspect $ 'product `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Scanners +------------------------------------------------------------------------------- + +{-# INLINE indexingWith #-} +indexingWith :: Int -> IO () +indexingWith n = withPostscanl n (Scanl.indexingWith 0 (+ 1)) + +#ifdef INSPECTION +inspect $ 'indexingWith `hasNoType` ''Step +inspect $ 'indexingWith `hasNoType` ''FL.Step +inspect $ 'indexingWith `hasNoType` ''SPEC +#endif + +{-# INLINE indexing #-} +indexing :: Int -> IO () +indexing n = withPostscanl n Scanl.indexing + +#ifdef INSPECTION +inspect $ 'indexing `hasNoType` ''Step +inspect $ 'indexing `hasNoType` ''FL.Step +inspect $ 'indexing `hasNoType` ''SPEC +#endif + +{-# INLINE indexingRev #-} +indexingRev :: Int -> IO () +indexingRev n = withPostscanl n (Scanl.indexingRev n) + +#ifdef INSPECTION +inspect $ 'indexingRev `hasNoType` ''Step +inspect $ 'indexingRev `hasNoType` ''FL.Step +inspect $ 'indexingRev `hasNoType` ''SPEC +#endif + +{-# INLINE rollingMap #-} +rollingMap :: Int -> IO () +rollingMap n = withPostscanl n (Scanl.rollingMap (\_ x -> x)) + +#ifdef INSPECTION +inspect $ 'rollingMap `hasNoType` ''Step +inspect $ 'rollingMap `hasNoType` ''FL.Step +inspect $ 'rollingMap `hasNoType` ''SPEC +#endif + +{-# INLINE rollingMapM #-} +rollingMapM :: Int -> IO () +rollingMapM n = withPostscanl n (Scanl.rollingMapM (\_ x -> return x)) + +#ifdef INSPECTION +inspect $ 'rollingMapM `hasNoType` ''Step +inspect $ 'rollingMapM `hasNoType` ''FL.Step +inspect $ 'rollingMapM `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Filters +------------------------------------------------------------------------------- + +{-# INLINE deleteBy #-} +deleteBy :: Int -> IO () +deleteBy n = withPostscanl n (Scanl.deleteBy (==) 0) + +#ifdef INSPECTION +inspect $ 'deleteBy `hasNoType` ''Step +inspect $ 'deleteBy `hasNoType` ''FL.Step +inspect $ 'deleteBy `hasNoType` ''SPEC +#endif + +{-# INLINE uniqBy #-} +uniqBy :: Int -> IO () +uniqBy n = withPostscanl n (Scanl.uniqBy (==)) + +#ifdef INSPECTION +inspect $ 'uniqBy `hasNoType` ''Step +inspect $ 'uniqBy `hasNoType` ''FL.Step +inspect $ 'uniqBy `hasNoType` ''SPEC +#endif + +{-# INLINE uniq #-} +uniq :: Int -> IO () +uniq n = withPostscanl n Scanl.uniq + +#ifdef INSPECTION +inspect $ 'uniq `hasNoType` ''Step +inspect $ 'uniq `hasNoType` ''FL.Step +inspect $ 'uniq `hasNoType` ''SPEC +#endif + +{-# INLINE findIndices #-} +findIndices :: Int -> IO () +findIndices n = withPostscanl n (Scanl.findIndices (== n)) + +#ifdef INSPECTION +inspect $ 'findIndices `hasNoType` ''Step +inspect $ 'findIndices `hasNoType` ''FL.Step +inspect $ 'findIndices `hasNoType` ''SPEC +#endif + +{-# INLINE elemIndices #-} +elemIndices :: Int -> IO () +elemIndices n = withPostscanl n (Scanl.elemIndices n) + +#ifdef INSPECTION +inspect $ 'elemIndices `hasNoType` ''Step +inspect $ 'elemIndices `hasNoType` ''FL.Step +inspect $ 'elemIndices `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Multi-element scans +------------------------------------------------------------------------------- + +{-# INLINE drainN #-} +drainN :: Int -> IO () +drainN n = withPostscanl n (Scanl.drainN n) + +#ifdef INSPECTION +inspect $ 'drainN `hasNoType` ''Step +inspect $ 'drainN `hasNoType` ''FL.Step +inspect $ 'drainN `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Trimmers +------------------------------------------------------------------------------- + +{-# INLINE takingEndByM #-} +takingEndByM :: Int -> IO () +takingEndByM n = withPostscanl n (Scanl.takingEndByM (return . (>= n))) + +#ifdef INSPECTION +inspect $ 'takingEndByM `hasNoType` ''Step +inspect $ 'takingEndByM `hasNoType` ''FL.Step +inspect $ 'takingEndByM `hasNoType` ''SPEC +#endif + +{-# INLINE takingEndBy #-} +takingEndBy :: Int -> IO () +takingEndBy n = withPostscanl n (Scanl.takingEndBy (>= n)) + +#ifdef INSPECTION +inspect $ 'takingEndBy `hasNoType` ''Step +inspect $ 'takingEndBy `hasNoType` ''FL.Step +inspect $ 'takingEndBy `hasNoType` ''SPEC +#endif + +{-# INLINE takingEndByM_ #-} +takingEndByM_ :: Int -> IO () +takingEndByM_ n = withPostscanl n (Scanl.takingEndByM_ (return . (>= n))) + +#ifdef INSPECTION +inspect $ 'takingEndByM_ `hasNoType` ''Step +inspect $ 'takingEndByM_ `hasNoType` ''FL.Step +inspect $ 'takingEndByM_ `hasNoType` ''SPEC +#endif + +{-# INLINE takingEndBy_ #-} +takingEndBy_ :: Int -> IO () +takingEndBy_ n = withPostscanl n (Scanl.takingEndBy_ (>= n)) + +#ifdef INSPECTION +inspect $ 'takingEndBy_ `hasNoType` ''Step +inspect $ 'takingEndBy_ `hasNoType` ''FL.Step +inspect $ 'takingEndBy_ `hasNoType` ''SPEC +#endif + +{-# INLINE droppingWhileM #-} +droppingWhileM :: Int -> IO () +droppingWhileM n = withPostscanl n (Scanl.droppingWhileM (return . (<= n))) + +#ifdef INSPECTION +inspect $ 'droppingWhileM `hasNoType` ''Step +inspect $ 'droppingWhileM `hasNoType` ''FL.Step +inspect $ 'droppingWhileM `hasNoType` ''SPEC +#endif + +{-# INLINE droppingWhile #-} +droppingWhile :: Int -> IO () +droppingWhile n = withPostscanl n (Scanl.droppingWhile (<= n)) + +#ifdef INSPECTION +inspect $ 'droppingWhile `hasNoType` ''Step +inspect $ 'droppingWhile `hasNoType` ''FL.Step +inspect $ 'droppingWhile `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Scanning input +------------------------------------------------------------------------------- + +{-# INLINE compose #-} +compose :: Int -> IO () +compose n = withPostscanl n (Scanl.compose Scanl.sum Scanl.drain) + +#ifdef INSPECTION +inspect $ 'compose `hasNoType` ''Step +inspect $ 'compose `hasNoType` ''SPEC +#endif + +{-# INLINE composeMany #-} +composeMany :: Int -> IO () +composeMany n = withPostscanl n (Scanl.composeMany (Scanl.take 2 Scanl.sum) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'composeMany `hasNoType` ''Step +inspect $ 'composeMany `hasNoType` ''SPEC +#endif + +{-# INLINE pipe #-} +pipe :: Int -> IO () +pipe n = withPostscanl n (Scanl.pipe (Pipe.mapM (\x -> return (x + 1))) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'pipe `hasNoType` ''Step +inspect $ 'pipe `hasNoType` ''FL.Step +inspect $ 'pipe `hasNoType` ''SPEC +#endif + +{-# INLINE indexed #-} +indexed :: Int -> IO () +indexed n = withPostscanl n (Scanl.indexed Scanl.length) + +#ifdef INSPECTION +inspect $ 'indexed `hasNoType` ''Step +inspect $ 'indexed `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Filtering input +------------------------------------------------------------------------------- + +{-# INLINE mapMaybeM #-} +mapMaybeM :: Int -> IO () +mapMaybeM n = + withPostscanl n + (Scanl.mapMaybeM + (\x -> return (if even x then Just x else Nothing)) + Scanl.drain) + +#ifdef INSPECTION +inspect $ 'mapMaybeM `hasNoType` ''Step +inspect $ 'mapMaybeM `hasNoType` ''FL.Step +inspect $ 'mapMaybeM `hasNoType` ''SPEC +#endif + +{-# INLINE mapMaybe #-} +mapMaybe :: Int -> IO () +mapMaybe n = + withPostscanl n + (Scanl.mapMaybe (\x -> if even x then Just x else Nothing) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'mapMaybe `hasNoType` ''Step +inspect $ 'mapMaybe `hasNoType` ''FL.Step +inspect $ 'mapMaybe `hasNoType` ''SPEC +#endif + +{-# INLINE sampleFromthen #-} +sampleFromthen :: Int -> IO () +sampleFromthen n = withPostscanl n (Scanl.sampleFromthen 0 2 Scanl.drain) + +#ifdef INSPECTION +inspect $ 'sampleFromthen `hasNoType` ''Step +inspect $ 'sampleFromthen `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Parallel distribution +------------------------------------------------------------------------------- + +{-# INLINE tee #-} +tee :: Int -> IO () +tee n = withPostscanl n (Scanl.tee Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'tee `hasNoType` ''Step +inspect $ 'tee `hasNoType` ''FL.Step +inspect $ 'tee `hasNoType` ''SPEC +#endif + +{-# INLINE distribute #-} +distribute :: Int -> IO () +distribute n = withPostscanl n (Scanl.distribute [Scanl.sum, Scanl.length]) + +------------------------------------------------------------------------------- +-- Unzipping +------------------------------------------------------------------------------- + +{-# INLINE unzip #-} +unzip :: Int -> IO () +unzip n = withPostscanlMap n (\a -> (a, a)) (Scanl.unzip Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'unzip `hasNoType` ''Step +inspect $ 'unzip `hasNoType` ''FL.Step +inspect $ 'unzip `hasNoType` ''SPEC +#endif + +{-# INLINE unzipWith #-} +unzipWith :: Int -> IO () +unzipWith n = withPostscanl n (Scanl.unzipWith (\a -> (a, a)) Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'unzipWith `hasNoType` ''Step +inspect $ 'unzipWith `hasNoType` ''FL.Step +inspect $ 'unzipWith `hasNoType` ''SPEC +#endif + +{-# INLINE unzipWithM #-} +unzipWithM :: Int -> IO () +unzipWithM n = + withPostscanl n (Scanl.unzipWithM (\a -> return (a, a)) Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'unzipWithM `hasNoType` ''Step +inspect $ 'unzipWithM `hasNoType` ''FL.Step +inspect $ 'unzipWithM `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Partitioning +------------------------------------------------------------------------------- + +{-# INLINE partitionByM #-} +partitionByM :: Int -> IO () +partitionByM n = + withPostscanl n (Scanl.partitionByM (return . oddEven) Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'partitionByM `hasNoType` ''Step +inspect $ 'partitionByM `hasNoType` ''FL.Step +inspect $ 'partitionByM `hasNoType` ''SPEC +#endif + +{-# INLINE partitionBy #-} +partitionBy :: Int -> IO () +partitionBy n = withPostscanl n (Scanl.partitionBy oddEven Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'partitionBy `hasNoType` ''Step +inspect $ 'partitionBy `hasNoType` ''FL.Step +inspect $ 'partitionBy `hasNoType` ''SPEC +#endif + +{-# INLINE partition #-} +partition :: Int -> IO () +partition n = withPostscanlMap n oddEven (Scanl.partition Scanl.sum Scanl.length) + +#ifdef INSPECTION +inspect $ 'partition `hasNoType` ''Step +inspect $ 'partition `hasNoType` ''FL.Step +inspect $ 'partition `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Nesting +------------------------------------------------------------------------------- + +{-# INLINE unfoldEach #-} +unfoldEach :: Int -> IO () +unfoldEach n = + Stream.fold FL.drain + $ Stream.postscanl (Scanl.unfoldEach Unfold.replicateM Scanl.drain) + $ Stream.fromPure (n, randomRIO (1, 1 :: Int)) + +------------------------------------------------------------------------------- +-- O(n) heap: building structures +------------------------------------------------------------------------------- + +{-# INLINE toListRev #-} +toListRev :: Int -> IO () +toListRev n = withPostscanl n Scanl.toListRev + +{-# INLINE toStream #-} +toStream :: Int -> IO () +toStream n = + withStream n + $ Stream.fold FL.drain + . Stream.postscanl (Scanl.toStream :: Scanl IO Int (Stream IO Int)) + +{-# INLINE toStreamRev #-} +toStreamRev :: Int -> IO () +toStreamRev n = + withStream n + $ Stream.fold FL.drain + . Stream.postscanl (Scanl.toStreamRev :: Scanl IO Int (Stream IO Int)) + +{-# INLINE topBy #-} +topBy :: Int -> IO () +topBy n = withPostscanl n (Scanl.topBy compare 10) + +{-# INLINE top #-} +top :: Int -> IO () +top n = withPostscanl n (Scanl.top 10) + +{-# INLINE bottomBy #-} +bottomBy :: Int -> IO () +bottomBy n = withPostscanl n (Scanl.bottomBy compare 10) + +{-# INLINE bottom #-} +bottom :: Int -> IO () +bottom n = withPostscanl n (Scanl.bottom 10) + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks value = + fmap (SpaceO_1,) + [ benchIO "sconcat" sconcat value + , benchIO "mconcat" mconcat value + , benchIO "foldMap" foldMap value + , benchIO "foldMapM" foldMapM value + , benchIO "drainMapM" drainMapM value + , benchIO "the" the value + , benchIO "mean" mean value + , benchIO "rollingHash" rollingHash value + , benchIO "rollingHashWithSalt" rollingHashWithSalt value + , benchIO "rollingHashFirstN" rollingHashFirstN value + , benchIO "sum" sum value + , benchIO "product" product value + , benchIO "indexingWith" indexingWith value + , benchIO "indexing" indexing value + , benchIO "indexingRev" indexingRev value + , benchIO "rollingMap" rollingMap value + , benchIO "rollingMapM" rollingMapM value + , benchIO "deleteBy" deleteBy value + , benchIO "uniqBy" uniqBy value + , benchIO "uniq" uniq value + , benchIO "findIndices" findIndices value + , benchIO "elemIndices" elemIndices value + , benchIO "drainN" drainN value + , benchIO "takingEndByM" takingEndByM value + , benchIO "takingEndBy" takingEndBy value + , benchIO "takingEndByM_" takingEndByM_ value + , benchIO "takingEndBy_" takingEndBy_ value + , benchIO "droppingWhileM" droppingWhileM value + , benchIO "droppingWhile" droppingWhile value + , benchIO "compose (sum)" compose value + , benchIO "composeMany (take 2 sum)" composeMany value + , benchIO "pipe-mapM" pipe value + , benchIO "indexed" indexed value + , benchIO "mapMaybeM" mapMaybeM value + , benchIO "mapMaybe" mapMaybe value + , benchIO "sampleFromthen" sampleFromthen value + , benchIO "tee (sum, length)" tee value + , benchIO "distribute [sum, length]" distribute value + , benchIO "unzip (sum, length)" unzip value + , benchIO "unzipWith (sum, length)" unzipWith value + , benchIO "unzipWithM (sum, length)" unzipWithM value + , benchIO "partitionByM (sum, length)" partitionByM value + , benchIO "partitionBy (sum, length)" partitionBy value + , benchIO "partition (sum, length)" partition value + , benchIO "unfoldEach" unfoldEach value + ] + ++ fmap (HeapO_n,) + [ benchIO "toListRev" toListRev value + , benchIO "toStream" toStream value + , benchIO "toStreamRev" toStreamRev value + , benchIO "topBy 10" topBy value + , benchIO "top 10" top value + , benchIO "bottomBy 10" bottomBy value + , benchIO "bottom 10" bottom value + ] diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Container.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Container.hs new file mode 100644 index 0000000000..ab3600674e --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Container.hs @@ -0,0 +1,255 @@ +-- | +-- Module : Scanl.Container +-- Copyright : (c) 2024 Composewell +-- +-- License : MIT +-- Maintainer : streamly@composewell.com + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_GHC -Wno-orphans #-} + +-- Benchmarks for operations exported from Streamly.Internal.Data.Scanl.Container. +module Scanl.Container (benchmarks) where + +import Data.IORef (IORef, newIORef, readIORef, modifyIORef) +import Data.Map.Strict (Map) +import Streamly.Internal.Data.Scanl (Scanl(..)) +import Streamly.Internal.Data.Stream (Stream) +import System.IO.Unsafe (unsafePerformIO) +import System.Random (randomRIO) + +import qualified Data.Set as Set +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Scanl as Scanl +import qualified Streamly.Internal.Data.Stream as Stream + +import Streamly.Benchmark.Common +import Test.Tasty.Bench + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Streamly.Internal.Data.Stream (Step(..)) +import Test.Inspection +#endif + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +{-# INLINE source #-} +source :: (Monad m, Num a, Stream.Enumerable a) => + Int -> a -> Stream m a +source len from = + Stream.enumerateFromThenTo from (from + 1) (from + fromIntegral len) + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream len f = randomRIO (1, 1 :: Int) >>= f . source len + +{-# INLINE withPostscanl #-} +withPostscanl :: Int -> Scanl IO Int b -> IO () +withPostscanl n s = withStream n $ Stream.fold FL.drain . Stream.postscanl s + +{-# INLINE benchIO #-} +benchIO :: String -> (Int -> IO ()) -> Int -> Benchmark +benchIO name f value = bench name $ nfIO $ f value + +{-# INLINE getKey #-} +getKey :: Int -> Int -> Int +getKey buckets = (`mod` buckets) + +{-# INLINE limitedSum #-} +limitedSum :: Int -> Scanl IO Int Int +limitedSum n = Scanl.take n Scanl.sum + +{-# INLINE afterDone #-} +afterDone :: IO () -> Scanl IO a b -> Scanl IO a b +afterDone action (Scanl step i e f) = Scanl step1 i e f + where + step1 x a = do + res <- step x a + case res of + Scanl.Partial s1 -> pure $ Scanl.Partial s1 + Scanl.Done b -> action >> pure (Scanl.Done b) + +{-# NOINLINE ref #-} +ref :: IORef (Set.Set Int) +ref = unsafePerformIO $ newIORef Set.empty + +{-# INLINE getScanl #-} +getScanl :: Int -> IO (Maybe (Scanl IO Int Int)) +getScanl k = do + set <- readIORef ref + if Set.member k set + then pure Nothing + else pure + $ Just + $ afterDone (modifyIORef ref (Set.insert k)) (limitedSum 100) + +------------------------------------------------------------------------------- +-- Set operations +------------------------------------------------------------------------------- + +{-# INLINE toSet #-} +toSet :: Int -> IO () +toSet n = withPostscanl n Scanl.toSet + +{-# INLINE toIntSet #-} +toIntSet :: Int -> IO () +toIntSet n = withPostscanl n Scanl.toIntSet + +{-# INLINE countDistinct #-} +countDistinct :: Int -> IO () +countDistinct n = withPostscanl n Scanl.countDistinct + +{-# INLINE countDistinctInt #-} +countDistinctInt :: Int -> IO () +countDistinctInt n = withPostscanl n Scanl.countDistinctInt + +{-# INLINE nub #-} +nub :: Int -> IO () +nub n = withPostscanl n Scanl.nub + +{-# INLINE nubInt #-} +nubInt :: Int -> IO () +nubInt n = withPostscanl n Scanl.nubInt + +------------------------------------------------------------------------------- +-- Demultiplexing +------------------------------------------------------------------------------- + +{-# INLINE demuxIOOneShot #-} +demuxIOOneShot :: Int -> IO () +demuxIOOneShot len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl (Scanl.demuxIO (getKey 64) getScanl) + +{-# INLINE demuxIOSum #-} +demuxIOSum :: Int -> IO () +demuxIOSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.demuxIO (getKey 64) (const (pure (Just Scanl.sum)))) + +#ifdef INSPECTION +inspect $ 'demuxIOSum `hasNoType` ''SPEC +#endif + +{-# INLINE demuxSum #-} +demuxSum :: Int -> IO () +demuxSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.demux (getKey 64) (const (pure (Just Scanl.sum)))) + +{-# INLINE demuxGenericSum #-} +demuxGenericSum :: Int -> IO () +demuxGenericSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.demuxGeneric (getKey 64) (const (pure (Just Scanl.sum))) + :: Scanl IO Int (IO (Map Int Int), Maybe (Int, Int))) + +{-# INLINE demuxGenericIOSum #-} +demuxGenericIOSum :: Int -> IO () +demuxGenericIOSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.demuxGenericIO (getKey 64) (const (pure (Just Scanl.sum))) + :: Scanl IO Int (IO (Map Int Int), Maybe (Int, Int))) + +------------------------------------------------------------------------------- +-- Classifying +------------------------------------------------------------------------------- + +{-# INLINE classifyLimitedSum #-} +classifyLimitedSum :: Int -> IO () +classifyLimitedSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl (Scanl.classifyIO (getKey 64) (limitedSum 100)) + +#ifdef INSPECTION +inspect $ 'classifyLimitedSum `hasNoType` ''FL.Step +inspect $ 'classifyLimitedSum `hasNoType` ''SPEC +#endif + +{-# INLINE classifyIOSum #-} +classifyIOSum :: Int -> IO () +classifyIOSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl (Scanl.classifyIO (getKey 64) Scanl.sum) + +#ifdef INSPECTION +inspect $ 'classifyIOSum `hasNoType` ''FL.Step +inspect $ 'classifyIOSum `hasNoType` ''SPEC +#endif + +{-# INLINE classifySum #-} +classifySum :: Int -> IO () +classifySum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl (Scanl.classify (getKey 64) Scanl.sum) + +{-# INLINE classifyGenericSum #-} +classifyGenericSum :: Int -> IO () +classifyGenericSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.classifyGeneric (getKey 64) Scanl.sum + :: Scanl IO Int (IO (Map Int Int), Maybe (Int, Int))) + +{-# INLINE classifyGenericIOSum #-} +classifyGenericIOSum :: Int -> IO () +classifyGenericIOSum len = + withStream len $ + Stream.fold FL.drain + . Stream.postscanl + (Scanl.classifyGenericIO (getKey 64) Scanl.sum + :: Scanl IO Int (IO (Map Int Int), Maybe (Int, Int))) + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks value = + fmap (SpaceO_1,) + [ benchIO "demuxIO (1-shot) (64 buckets) [sum 100]" demuxIOOneShot value + , benchIO "demuxIO (64 buckets) [sum]" demuxIOSum value + , benchIO "classifyIO (64 buckets) [sum 100]" classifyLimitedSum value + , benchIO "classifyIO (64 buckets) [sum]" classifyIOSum value + ] + ++ fmap (HeapO_n,) + [ benchIO "toSet" toSet value + , benchIO "toIntSet" toIntSet value + , benchIO "countDistinct" countDistinct value + , benchIO "countDistinctInt" countDistinctInt value + , benchIO "nub" nub value + , benchIO "nubInt" nubInt value + , benchIO "demux (64 buckets) [sum]" demuxSum value + , benchIO "demuxGeneric (64 buckets) [sum]" demuxGenericSum value + , benchIO "demuxGenericIO (64 buckets) [sum]" demuxGenericIOSum value + , benchIO "classify (64 buckets) [sum]" classifySum value + , benchIO "classifyGeneric (64 buckets) [sum]" classifyGenericSum value + , benchIO "classifyGenericIO (64 buckets) [sum]" classifyGenericIOSum value + ] diff --git a/benchmark/Streamly/Benchmark/Data/Scanl/Type.hs b/benchmark/Streamly/Benchmark/Data/Scanl/Type.hs new file mode 100644 index 0000000000..6e6216c3ff --- /dev/null +++ b/benchmark/Streamly/Benchmark/Data/Scanl/Type.hs @@ -0,0 +1,530 @@ +-- | +-- Module : Scanl.Type +-- Copyright : (c) 2024 Composewell +-- +-- License : MIT +-- Maintainer : streamly@composewell.com + +#undef FUSION_CHECK +#ifdef FUSION_CHECK +{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-} +#endif + +#ifdef __HADDOCK_VERSION__ +#undef INSPECTION +#endif + +#ifdef INSPECTION +{-# LANGUAGE TemplateHaskell #-} +{-# OPTIONS_GHC -fplugin Test.Inspection.Plugin #-} +#endif + +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE ScopedTypeVariables #-} + +-- Benchmarks for operations exported from Streamly.Internal.Data.Scanl.Type. +module Scanl.Type (benchmarks) where + +import Streamly.Internal.Data.Scanl (Scanl) +import Streamly.Internal.Data.Stream (Stream) +import System.Random (randomRIO) + +import qualified Streamly.Internal.Data.Fold as FL +import qualified Streamly.Internal.Data.Scanl as Scanl +import qualified Streamly.Internal.Data.Stream as Stream + +import Streamly.Benchmark.Common +import Test.Tasty.Bench +import Prelude hiding (length, maximum, minimum, take, filter) + +#ifdef INSPECTION +import GHC.Types (SPEC(..)) +import Streamly.Internal.Data.Stream (Step(..)) +import Test.Inspection +#endif + +------------------------------------------------------------------------------- +-- Helpers +------------------------------------------------------------------------------- + +{-# INLINE sourceUnfoldrM #-} +sourceUnfoldrM :: Monad m => Int -> Int -> Stream m Int +sourceUnfoldrM value n = Stream.unfoldrM step n + where + step cnt = + if cnt > n + value + then return Nothing + else return (Just (cnt, cnt + 1)) + +{-# INLINE withStream #-} +withStream :: Int -> (Stream IO Int -> IO b) -> IO b +withStream n f = randomRIO (1, 1) >>= f . sourceUnfoldrM n + +-- | Run a scan over the stream as a postscan and drain the result. +{-# INLINE withPostscanl #-} +withPostscanl :: Int -> Scanl IO Int b -> IO () +withPostscanl n s = withStream n $ Stream.fold FL.drain . Stream.postscanl s + +-- | Run a scan over a transformed input stream. +{-# INLINE withPostscanlMap #-} +withPostscanlMap :: Int -> (Int -> a) -> Scanl IO a b -> IO () +withPostscanlMap n f s = withStream n $ Stream.fold FL.drain . Stream.postscanl s . fmap f + +{-# INLINE benchIO #-} +benchIO :: String -> (Int -> IO ()) -> Int -> Benchmark +benchIO name f value = bench name $ nfIO $ f value + +{-# INLINE oddEven #-} +oddEven :: Int -> Either Int Int +oddEven x = if odd x then Left x else Right x + +------------------------------------------------------------------------------- +-- Constructors +------------------------------------------------------------------------------- + +{-# INLINE scanl' #-} +scanl' :: Int -> IO () +scanl' n = withPostscanl n (Scanl.scanl' (+) 0) + +#ifdef INSPECTION +inspect $ 'scanl' `hasNoType` ''Step +inspect $ 'scanl' `hasNoType` ''FL.Step +inspect $ 'scanl' `hasNoType` ''SPEC +#endif + +{-# INLINE scanlM' #-} +scanlM' :: Int -> IO () +scanlM' n = withPostscanl n (Scanl.scanlM' (\b a -> return (b + a)) (return 0)) + +#ifdef INSPECTION +inspect $ 'scanlM' `hasNoType` ''Step +inspect $ 'scanlM' `hasNoType` ''FL.Step +inspect $ 'scanlM' `hasNoType` ''SPEC +#endif + +{-# INLINE scanl1' #-} +scanl1' :: Int -> IO () +scanl1' n = withPostscanl n (Scanl.scanl1' (+)) + +#ifdef INSPECTION +inspect $ 'scanl1' `hasNoType` ''Step +inspect $ 'scanl1' `hasNoType` ''FL.Step +inspect $ 'scanl1' `hasNoType` ''SPEC +#endif + +{-# INLINE scanl1M' #-} +scanl1M' :: Int -> IO () +scanl1M' n = withPostscanl n (Scanl.scanl1M' (\a b -> return (a + b))) + +#ifdef INSPECTION +inspect $ 'scanl1M' `hasNoType` ''Step +inspect $ 'scanl1M' `hasNoType` ''FL.Step +inspect $ 'scanl1M' `hasNoType` ''SPEC +#endif + +{-# INLINE scant' #-} +scant' :: Int -> IO () +scant' n = withPostscanl n (Scanl.scant' (\s a -> Scanl.Partial (s + a)) (Scanl.Partial 0) id) + +#ifdef INSPECTION +inspect $ 'scant' `hasNoType` ''Step +inspect $ 'scant' `hasNoType` ''SPEC +#endif + +{-# INLINE scantM' #-} +scantM' :: Int -> IO () +scantM' n = + withPostscanl n + (Scanl.scantM' + (\s a -> return (Scanl.Partial (s + a))) + (return (Scanl.Partial 0)) + return) + +#ifdef INSPECTION +inspect $ 'scantM' `hasNoType` ''Step +inspect $ 'scantM' `hasNoType` ''SPEC +#endif + +{- +{-# INLINE mkScanr #-} +mkScanr :: Int -> IO () +mkScanr n = withPostscanl n (Scanl.mkScanr (+) 0) + +{-# INLINE mkScanrM #-} +mkScanrM :: Int -> IO () +mkScanrM n = withPostscanl n (Scanl.mkScanrM (\a b -> return (a + b)) (return 0)) +-} + +------------------------------------------------------------------------------- +-- Reducers +------------------------------------------------------------------------------- + +{-# INLINE drain #-} +drain :: Int -> IO () +drain n = withPostscanl n Scanl.drain + +#ifdef INSPECTION +inspect $ 'drain `hasNoType` ''Step +inspect $ 'drain `hasNoType` ''FL.Step +inspect $ 'drain `hasNoType` ''SPEC +#endif + +{-# INLINE latest #-} +latest :: Int -> IO () +latest n = withPostscanl n Scanl.latest + +#ifdef INSPECTION +inspect $ 'latest `hasNoType` ''Step +inspect $ 'latest `hasNoType` ''FL.Step +inspect $ 'latest `hasNoType` ''SPEC +#endif + +{-# INLINE functionM #-} +functionM :: Int -> IO () +functionM n = withPostscanl n (Scanl.functionM (return . Just)) + +#ifdef INSPECTION +inspect $ 'functionM `hasNoType` ''Step +inspect $ 'functionM `hasNoType` ''FL.Step +inspect $ 'functionM `hasNoType` ''SPEC +#endif + +{-# INLINE genericLength #-} +genericLength :: Int -> IO () +genericLength n = withPostscanl n (Scanl.genericLength :: Scanl IO Int Int) + +#ifdef INSPECTION +inspect $ 'genericLength `hasNoType` ''Step +inspect $ 'genericLength `hasNoType` ''FL.Step +inspect $ 'genericLength `hasNoType` ''SPEC +#endif + +{-# INLINE length #-} +length :: Int -> IO () +length n = withPostscanl n Scanl.length + +#ifdef INSPECTION +inspect $ 'length `hasNoType` ''Step +inspect $ 'length `hasNoType` ''FL.Step +inspect $ 'length `hasNoType` ''SPEC +#endif + +{-# INLINE maximumBy #-} +maximumBy :: Int -> IO () +maximumBy n = withPostscanl n (Scanl.maximumBy compare) + +#ifdef INSPECTION +inspect $ 'maximumBy `hasNoType` ''Step +inspect $ 'maximumBy `hasNoType` ''FL.Step +inspect $ 'maximumBy `hasNoType` ''SPEC +#endif + +{-# INLINE maximum #-} +maximum :: Int -> IO () +maximum n = withPostscanl n Scanl.maximum + +#ifdef INSPECTION +inspect $ 'maximum `hasNoType` ''Step +inspect $ 'maximum `hasNoType` ''FL.Step +inspect $ 'maximum `hasNoType` ''SPEC +#endif + +{-# INLINE minimumBy #-} +minimumBy :: Int -> IO () +minimumBy n = withPostscanl n (Scanl.minimumBy compare) + +#ifdef INSPECTION +inspect $ 'minimumBy `hasNoType` ''Step +inspect $ 'minimumBy `hasNoType` ''FL.Step +inspect $ 'minimumBy `hasNoType` ''SPEC +#endif + +{-# INLINE minimum #-} +minimum :: Int -> IO () +minimum n = withPostscanl n Scanl.minimum + +#ifdef INSPECTION +inspect $ 'minimum `hasNoType` ''Step +inspect $ 'minimum `hasNoType` ''FL.Step +inspect $ 'minimum `hasNoType` ''SPEC +#endif + +{-# INLINE rangeBy #-} +rangeBy :: Int -> IO () +rangeBy n = withPostscanl n (Scanl.rangeBy compare) + +#ifdef INSPECTION +inspect $ 'rangeBy `hasNoType` ''Step +inspect $ 'rangeBy `hasNoType` ''FL.Step +inspect $ 'rangeBy `hasNoType` ''SPEC +#endif + +{-# INLINE range #-} +range :: Int -> IO () +range n = withPostscanl n Scanl.range + +#ifdef INSPECTION +inspect $ 'range `hasNoType` ''Step +inspect $ 'range `hasNoType` ''FL.Step +inspect $ 'range `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Mapping +------------------------------------------------------------------------------- + +{-# INLINE rmapM #-} +rmapM :: Int -> IO () +rmapM n = withPostscanl n (Scanl.rmapM return Scanl.drain) + +#ifdef INSPECTION +inspect $ 'rmapM `hasNoType` ''Step +inspect $ 'rmapM `hasNoType` ''FL.Step +inspect $ 'rmapM `hasNoType` ''SPEC +#endif + +{-# INLINE lmap #-} +lmap :: Int -> IO () +lmap n = withPostscanl n (Scanl.lmap (+ 1) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'lmap `hasNoType` ''Step +inspect $ 'lmap `hasNoType` ''FL.Step +inspect $ 'lmap `hasNoType` ''SPEC +#endif + +{-# INLINE lmapM #-} +lmapM :: Int -> IO () +lmapM n = withPostscanl n (Scanl.lmapM return Scanl.drain) + +#ifdef INSPECTION +inspect $ 'lmapM `hasNoType` ''Step +inspect $ 'lmapM `hasNoType` ''FL.Step +inspect $ 'lmapM `hasNoType` ''SPEC +#endif + +{-# INLINE postscanl #-} +postscanl :: Int -> IO () +postscanl n = withPostscanl n (Scanl.postscanl Scanl.length Scanl.drain) + +#ifdef INSPECTION +inspect $ 'postscanl `hasNoType` ''Step +inspect $ 'postscanl `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Filtering +------------------------------------------------------------------------------- + +{-# INLINE catMaybes #-} +catMaybes :: Int -> IO () +catMaybes n = withPostscanlMap n Just (Scanl.catMaybes Scanl.length) + +#ifdef INSPECTION +inspect $ 'catMaybes `hasNoType` ''Step +inspect $ 'catMaybes `hasNoType` ''FL.Step +inspect $ 'catMaybes `hasNoType` ''SPEC +#endif + +{-# INLINE postscanlMaybe #-} +postscanlMaybe :: Int -> IO () +postscanlMaybe n = withPostscanl n (Scanl.postscanlMaybe (Scanl.filtering even) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'postscanlMaybe `hasNoType` ''Step +inspect $ 'postscanlMaybe `hasNoType` ''SPEC +#endif + +{-# INLINE filter #-} +filter :: Int -> IO () +filter n = withPostscanl n (Scanl.filter even Scanl.drain) + +#ifdef INSPECTION +inspect $ 'filter `hasNoType` ''Step +inspect $ 'filter `hasNoType` ''FL.Step +inspect $ 'filter `hasNoType` ''SPEC +#endif + +{-# INLINE filtering #-} +filtering :: Int -> IO () +filtering n = withPostscanl n (Scanl.filtering even) + +#ifdef INSPECTION +inspect $ 'filtering `hasNoType` ''Step +inspect $ 'filtering `hasNoType` ''FL.Step +inspect $ 'filtering `hasNoType` ''SPEC +#endif + +{-# INLINE filterM #-} +filterM :: Int -> IO () +filterM n = withPostscanl n (Scanl.filterM (return . even) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'filterM `hasNoType` ''Step +inspect $ 'filterM `hasNoType` ''FL.Step +inspect $ 'filterM `hasNoType` ''SPEC +#endif + +{-# INLINE catLefts #-} +catLefts :: Int -> IO () +catLefts n = withPostscanlMap n (Left :: Int -> Either Int Int) (Scanl.catLefts Scanl.length) + +#ifdef INSPECTION +inspect $ 'catLefts `hasNoType` ''Step +inspect $ 'catLefts `hasNoType` ''SPEC +#endif + +{-# INLINE catRights #-} +catRights :: Int -> IO () +catRights n = withPostscanlMap n (Right :: Int -> Either Int Int) (Scanl.catRights Scanl.length) + +#ifdef INSPECTION +inspect $ 'catRights `hasNoType` ''Step +inspect $ 'catRights `hasNoType` ''SPEC +#endif + +{-# INLINE catEithers #-} +catEithers :: Int -> IO () +catEithers n = withPostscanlMap n oddEven (Scanl.catEithers Scanl.length) + +#ifdef INSPECTION +inspect $ 'catEithers `hasNoType` ''Step +inspect $ 'catEithers `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Trimming +------------------------------------------------------------------------------- + +{-# INLINE take #-} +take :: Int -> IO () +take n = withPostscanl n (Scanl.take n Scanl.drain) + +#ifdef INSPECTION +inspect $ 'take `hasNoType` ''Step +inspect $ 'take `hasNoType` ''FL.Step +inspect $ 'take `hasNoType` ''SPEC +#endif + +{-# INLINE taking #-} +taking :: Int -> IO () +taking n = withPostscanl n (Scanl.taking n) + +#ifdef INSPECTION +inspect $ 'taking `hasNoType` ''Step +inspect $ 'taking `hasNoType` ''FL.Step +inspect $ 'taking `hasNoType` ''SPEC +#endif + +{-# INLINE takeEndBy_ #-} +takeEndBy_ :: Int -> IO () +takeEndBy_ n = withPostscanl n (Scanl.takeEndBy_ (>= n) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'takeEndBy_ `hasNoType` ''Step +inspect $ 'takeEndBy_ `hasNoType` ''FL.Step +inspect $ 'takeEndBy_ `hasNoType` ''SPEC +#endif + +{-# INLINE takeEndBy #-} +takeEndBy :: Int -> IO () +takeEndBy n = withPostscanl n (Scanl.takeEndBy (>= n) Scanl.drain) + +#ifdef INSPECTION +inspect $ 'takeEndBy `hasNoType` ''Step +inspect $ 'takeEndBy `hasNoType` ''FL.Step +inspect $ 'takeEndBy `hasNoType` ''SPEC +#endif + +{-# INLINE dropping #-} +dropping :: Int -> IO () +dropping n = withPostscanl n (Scanl.dropping n) + +#ifdef INSPECTION +inspect $ 'dropping `hasNoType` ''Step +inspect $ 'dropping `hasNoType` ''FL.Step +inspect $ 'dropping `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- Distributing +------------------------------------------------------------------------------- + +{-# INLINE teeWith #-} +teeWith :: Int -> IO () +teeWith n = withPostscanl n (Scanl.teeWith (,) Scanl.length Scanl.latest) + +#ifdef INSPECTION +inspect $ 'teeWith `hasNoType` ''Step +inspect $ 'teeWith `hasNoType` ''FL.Step +inspect $ 'teeWith `hasNoType` ''SPEC +#endif + +------------------------------------------------------------------------------- +-- O(n) heap: building structures +------------------------------------------------------------------------------- + +{-# INLINE toList #-} +toList :: Int -> IO () +toList n = withPostscanl n Scanl.toList + +{-# INLINE toStreamK #-} +toStreamK :: Int -> IO () +toStreamK n = withPostscanl n Scanl.toStreamK + +{-# INLINE toStreamKRev #-} +toStreamKRev :: Int -> IO () +toStreamKRev n = withPostscanl n Scanl.toStreamKRev + +------------------------------------------------------------------------------- +-- Benchmarks +------------------------------------------------------------------------------- + +benchmarks :: Int -> [(SpaceComplexity, Benchmark)] +benchmarks value = + fmap (SpaceO_1,) + [ benchIO "scanl'" scanl' value + , benchIO "scanlM'" scanlM' value + , benchIO "scanl1'" scanl1' value + , benchIO "scanl1M'" scanl1M' value + , benchIO "scant'" scant' value + , benchIO "scantM'" scantM' value + -- XXX these take too much stack and do not finish + -- , benchIO "mkScanr" mkScanr value + -- , benchIO "mkScanrM" mkScanrM value + , benchIO "drain" drain value + , benchIO "latest" latest value + , benchIO "functionM" functionM value + , benchIO "genericLength" genericLength value + , benchIO "length" length value + , benchIO "maximumBy" maximumBy value + , benchIO "maximum" maximum value + , benchIO "minimumBy" minimumBy value + , benchIO "minimum" minimum value + , benchIO "rangeBy" rangeBy value + , benchIO "range" range value + , benchIO "rmapM" rmapM value + , benchIO "lmap" lmap value + , benchIO "lmapM" lmapM value + , benchIO "postscanl" postscanl value + , benchIO "catMaybes" catMaybes value + , benchIO "postscanlMaybe (filtering even)" postscanlMaybe value + , benchIO "filter even" filter value + , benchIO "filtering even" filtering value + , benchIO "filterM even" filterM value + , benchIO "catLefts" catLefts value + , benchIO "catRights" catRights value + , benchIO "catEithers" catEithers value + , benchIO "take" take value + , benchIO "taking" taking value + , benchIO "takeEndBy_" takeEndBy_ value + , benchIO "takeEndBy" takeEndBy value + , benchIO "dropping" dropping value + , benchIO "teeWith (length, latest)" teeWith value + ] + ++ fmap (HeapO_n,) + [ benchIO "toList (1/1000)" toList (value `div` 1000) + , benchIO "toStreamK (1/1000)" toStreamK (value `div` 1000) + , benchIO "toStreamKRev" toStreamKRev value + ] diff --git a/benchmark/streamly-benchmarks.cabal b/benchmark/streamly-benchmarks.cabal index 4b41936437..6ace3f4767 100644 --- a/benchmark/streamly-benchmarks.cabal +++ b/benchmark/streamly-benchmarks.cabal @@ -416,7 +416,10 @@ benchmark Data.Scanl hs-source-dirs: Streamly/Benchmark/Data , Streamly/Benchmark/Data/Scanl main-is: Scanl.hs - other-modules: Scanl.Window + other-modules: Scanl.Type + , Scanl.Combinators + , Scanl.Container + , Scanl.Window benchmark Data.Scanl.Concurrent import: bench-options From ddaf65c1d8d95444f2c7d4ea64d04d01017d63e0 Mon Sep 17 00:00:00 2001 From: Harendra Kumar Date: Wed, 24 Jun 2026 13:19:30 +0530 Subject: [PATCH 3/3] Add missing Scanl tests --- test/Streamly/Test/Data/Scanl/Combinators.hs | 156 ++++++++++++++++++- test/Streamly/Test/Data/Scanl/Container.hs | 88 ++++++++++- test/Streamly/Test/Data/Scanl/Type.hs | 136 +++++++++++++++- test/Streamly/Test/Data/Scanl/Window.hs | 53 ++++++- 4 files changed, 429 insertions(+), 4 deletions(-) diff --git a/test/Streamly/Test/Data/Scanl/Combinators.hs b/test/Streamly/Test/Data/Scanl/Combinators.hs index d6213f1eb9..fe7954b588 100644 --- a/test/Streamly/Test/Data/Scanl/Combinators.hs +++ b/test/Streamly/Test/Data/Scanl/Combinators.hs @@ -12,8 +12,10 @@ 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.Pipe as Pipe import qualified Streamly.Internal.Data.Scanl as F import qualified Streamly.Internal.Data.Stream as Stream +import qualified Streamly.Internal.Data.Unfold as Unfold import qualified Prelude import Prelude hiding (maximum, minimum, product, sum, mconcat, foldMap, maybe) @@ -26,13 +28,165 @@ import Test.QuickCheck (Gen, Property, choose, forAll, listOf1) #include "Streamly/Test/Data/Scanl/CommonCombinators.hs" +------------------------------------------------------------------------------- +-- Scanl-only tests (these combinators are not exported by the Fold module, or +-- their scan output cannot be shared via the common 'check' harness). +------------------------------------------------------------------------------- + +-- 'compose' scans the input through the left scan and feeds each of its outputs +-- (including the initial extract) to the right scan. +composeS :: Expectation +composeS = + check (F.compose F.sum F.toList) ([1, 2, 3] :: [Int]) + [[0], [0, 1], [0, 1, 3], [0, 1, 3, 6]] + +-- 'composeMany' restarts the left scan with a fresh state each time it +-- terminates. Here the left scan (take 2 sum) emits a running sum of every two +-- inputs which the right scan (sum) accumulates. +composeManyS :: Expectation +composeManyS = + check (F.composeMany (F.take 2 F.sum) F.sum) ([1, 2, 3, 4, 5] :: [Int]) + [0, 1, 4, 7, 14, 19] + +-- 'with' adapts a stateful combinator (here 'indexed') so that the supplied +-- predicate also sees the state (the index). This keeps elements at even +-- indices. +withS :: Expectation +withS = + check (F.with F.indexed F.filter (even . fst) F.toList) "abcde" + ["", "a", "a", "ac", "ac", "ace"] + +pipeS :: Expectation +pipeS = + check (F.pipe (Pipe.map (* 2)) F.sum) ([1, 2, 3] :: [Int]) [0, 2, 6, 12] + +topByS :: Expectation +topByS = + check (F.rmapM MArray.toList (F.topBy compare 3)) ([5, 1, 4, 2, 3] :: [Int]) + [[], [5], [5, 1], [5, 4, 1], [5, 4, 2], [5, 4, 3]] + +bottomByS :: Expectation +bottomByS = + check (F.rmapM MArray.toList (F.bottomBy compare 3)) ([5, 1, 4, 2, 3] :: [Int]) + [[], [5], [1, 5], [1, 4, 5], [1, 2, 4], [1, 2, 3]] + +indexingWithS :: Expectation +indexingWithS = + check (F.indexingWith 0 (+ 2)) "abc" + [Nothing, Just (0, 'a'), Just (2, 'b'), Just (4, 'c')] + +indexingS :: Expectation +indexingS = + check F.indexing "abc" + [Nothing, Just (0, 'a'), Just (1, 'b'), Just (2, 'c')] + +indexingRevS :: Expectation +indexingRevS = + check (F.indexingRev 5) "abc" + [Nothing, Just (5, 'a'), Just (4, 'b'), Just (3, 'c')] + +takingEndByUS :: Expectation +takingEndByUS = + check (F.takingEndBy_ (== 3)) ([1, 2, 3, 4, 5] :: [Int]) + [Nothing, Just 1, Just 2, Nothing] + +mapMaybeMS :: Expectation +mapMaybeMS = + check + (F.mapMaybeM (\x -> return (if even x then Just x else Nothing)) F.toList) + ([1, 2, 3, 4] :: [Int]) + [[], [], [2], [2], [2, 4]] + +-- An Unfold that streams the elements of an input list. +unfoldList :: Monad m => Unfold.Unfold m [a] a +unfoldList = + Unfold.unfoldrM + (\xs -> return (case xs of { [] -> Nothing; (y:ys) -> Just (y, ys) })) + +unfoldEachS :: Expectation +unfoldEachS = + check (F.unfoldEach unfoldList F.toList) ([[1, 2], [3], [4, 5]] :: [[Int]]) + [[], [1, 2], [1, 2, 3], [1, 2, 3, 4, 5]] + +unfoldManyS :: Expectation +unfoldManyS = + check (F.unfoldMany unfoldList F.toList) ([[1, 2], [3], [4, 5]] :: [[Int]]) + [[], [1, 2], [1, 2, 3], [1, 2, 3, 4, 5]] + +-- 'defaultSalt' is the default salt used by 'rollingHash'. It is part of the +-- output contract, so the test duplicates the constant rather than importing it. +defaultSaltS :: Expectation +defaultSaltS = F.defaultSalt `shouldBe` (-2578643520546668380 :: Int64) + +teeS :: Expectation +teeS = + check (F.tee F.sum F.length) ([1, 2, 3] :: [Int]) + [(0, 0), (1, 1), (3, 2), (6, 3)] + +-- Unlike the Fold 'partition' which returns the tuple of both branch results, a +-- Scanl emits a single interleaved value per input: the just-updated branch. +partitionByS :: Expectation +partitionByS = + check + (F.partitionBy (\x -> if odd x then Left x else Right x) F.length F.length) + ([1, 2, 3, 4, 5] :: [Int]) + [0, 1, 1, 2, 2, 3] + +partitionByMS :: Expectation +partitionByMS = + check + (F.partitionByM + (\x -> return (if odd x then Left x else Right x)) F.length F.length) + ([1, 2, 3, 4, 5] :: [Int]) + [0, 1, 1, 2, 2, 3] + +partitionS :: Expectation +partitionS = + check (F.partition F.toList F.toList) + ([Left 1, Right 2, Left 3, Right 4] :: [Either Int Int]) + [[], [1], [2], [1, 3], [2, 4]] + +------------------------------------------------------------------------------- +-- Deprecated combinators (aliases for compose / composeMany) +------------------------------------------------------------------------------- + +scanlS :: Expectation +scanlS = + check (F.scanl F.sum F.toList) ([1, 2, 3] :: [Int]) + [[0], [0, 1], [0, 1, 3], [0, 1, 3, 6]] + +scanlManyS :: Expectation +scanlManyS = + check (F.scanlMany (F.take 2 F.sum) F.sum) ([1, 2, 3, 4, 5] :: [Int]) + [0, 1, 4, 7, 14, 19] + moduleName :: String moduleName = "Data.Scanl.Combinators" main :: IO () main = hspec $ - describe moduleName $ + describe moduleName $ do describe "common" commonCombinatorsSpec -- Before adding any tests here consider if it can be added to the -- common tests above. + it "compose" composeS + it "composeMany" composeManyS + it "with" withS + it "pipe" pipeS + it "topBy" topByS + it "bottomBy" bottomByS + it "indexingWith" indexingWithS + it "indexing" indexingS + it "indexingRev" indexingRevS + it "takingEndBy_" takingEndByUS + it "mapMaybeM" mapMaybeMS + it "unfoldEach" unfoldEachS + it "unfoldMany" unfoldManyS + it "defaultSalt" defaultSaltS + it "tee" teeS + it "partitionBy" partitionByS + it "partitionByM" partitionByMS + it "partition" partitionS + it "scanl" scanlS + it "scanlMany" scanlManyS diff --git a/test/Streamly/Test/Data/Scanl/Container.hs b/test/Streamly/Test/Data/Scanl/Container.hs index 0ba5b52551..d41c5c7b90 100644 --- a/test/Streamly/Test/Data/Scanl/Container.hs +++ b/test/Streamly/Test/Data/Scanl/Container.hs @@ -10,6 +10,7 @@ module Streamly.Test.Data.Scanl.Container (main) where import qualified Data.IntSet as IntSet +import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Streamly.Internal.Data.Scanl as F @@ -18,13 +19,98 @@ import Test.Hspec #include "Streamly/Test/Data/Scanl/CommonContainer.hs" +------------------------------------------------------------------------------- +-- Scanl-only tests: demultiplexing and classifying. +------------------------------------------------------------------------------- + +-- Each key's inner scan is @take 2 sum@; the demux/classify scan emits +-- @Just (key, result)@ on the step at which a key's inner scan terminates and +-- @Nothing@ otherwise. + +demuxInput :: [(String, Int)] +demuxInput = [("A", 1), ("A", 2), ("B", 3)] + +demuxExpected :: [Maybe (String, Int)] +demuxExpected = [Just ("A", 1), Just ("A", 3), Just ("B", 3)] + +demuxGetScanl :: String -> IO (Maybe (F.Scanl IO (String, Int) Int)) +demuxGetScanl _ = return (Just (F.take 2 (F.lmap snd F.sum))) + +demuxS :: Expectation +demuxS = checkPostscanl (F.demux fst demuxGetScanl) demuxInput demuxExpected + +demuxIOS :: Expectation +demuxIOS = checkPostscanl (F.demuxIO fst demuxGetScanl) demuxInput demuxExpected + +demuxGenericS :: Expectation +demuxGenericS = + checkPostscanl + (fmap snd + (F.demuxGeneric fst demuxGetScanl + :: F.Scanl IO (String, Int) + (IO (Map.Map String Int), Maybe (String, Int)))) + demuxInput demuxExpected + +demuxGenericIOS :: Expectation +demuxGenericIOS = + checkPostscanl + (fmap snd + (F.demuxGenericIO fst demuxGetScanl + :: F.Scanl IO (String, Int) + (IO (Map.Map String Int), Maybe (String, Int)))) + demuxInput demuxExpected + +classifyInput :: [(String, Int)] +classifyInput = [("ONE", 1), ("TWO", 2), ("ONE", 3), ("TWO", 4), ("ONE", 5)] + +classifyExpected :: [Maybe (String, Int)] +classifyExpected = + [Just ("ONE", 1), Just ("TWO", 2), Just ("ONE", 4), Just ("TWO", 6), Nothing] + +classifyInner :: F.Scanl IO (String, Int) Int +classifyInner = F.lmap snd (F.take 2 F.sum) + +classifyS :: Expectation +classifyS = + checkPostscanl (F.classify fst classifyInner) classifyInput classifyExpected + +classifyIOS :: Expectation +classifyIOS = + checkPostscanl (F.classifyIO fst classifyInner) classifyInput classifyExpected + +classifyGenericS :: Expectation +classifyGenericS = + checkPostscanl + (fmap snd + (F.classifyGeneric fst classifyInner + :: F.Scanl IO (String, Int) + (IO (Map.Map String Int), Maybe (String, Int)))) + classifyInput classifyExpected + +classifyGenericIOS :: Expectation +classifyGenericIOS = + checkPostscanl + (fmap snd + (F.classifyGenericIO fst classifyInner + :: F.Scanl IO (String, Int) + (IO (Map.Map String Int), Maybe (String, Int)))) + classifyInput classifyExpected + moduleName :: String moduleName = "Data.Scanl.Container" main :: IO () main = hspec $ - describe moduleName $ + describe moduleName $ do describe "common" commonContainerSpec -- Before adding any tests here consider if it can be added to the -- common tests above. + it "demux" demuxS + it "demuxIO" demuxIOS + it "demuxGeneric" demuxGenericS + it "demuxGenericIO" demuxGenericIOS + it "classify" classifyS + it "classifyIO" classifyIOS + it "classifyGeneric" classifyGenericS + it "classifyGenericIO" classifyGenericIOS diff --git a/test/Streamly/Test/Data/Scanl/Type.hs b/test/Streamly/Test/Data/Scanl/Type.hs index bcc31620e7..1a55ca7e4f 100644 --- a/test/Streamly/Test/Data/Scanl/Type.hs +++ b/test/Streamly/Test/Data/Scanl/Type.hs @@ -11,10 +11,11 @@ module Streamly.Test.Data.Scanl.Type (main, check, checkApprox, checkPostscanl) where import Data.Functor.Identity (Identity, runIdentity) +import qualified Streamly.Internal.Data.Refold.Type as Refold 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 Prelude hiding (const, last, length, take, filter, scanl, foldl', concatMap) import qualified Prelude import Streamly.Test.Common (chooseInt) @@ -134,6 +135,117 @@ postscanlMaybeCompose = do (Stream.postscanl (F.postscanlMaybe (fmap Just (F.take 0 F.sum)) F.length) (Stream.fromList [1, 2, 3 :: Int])) `shouldReturn` ([] :: [Int]) +------------------------------------------------------------------------------- +-- Constructors +------------------------------------------------------------------------------- + +scanlS :: [Int] -> Expectation +scanlS ls = check (F.scanl' (+) 0) ls (Prelude.scanl (+) 0 ls) + +scanlMS :: [Int] -> Expectation +scanlMS ls = + check (F.scanlM' (\b a -> return (b + a)) (return 0)) ls + (Prelude.scanl (+) 0 ls) + +scanl1S :: Expectation +scanl1S = do + check (F.scanl1' (+)) ([1, 2, 3] :: [Int]) [Nothing, Just 1, Just 3, Just 6] + check (F.scanl1' (+)) ([] :: [Int]) [Nothing] + +scanl1MS :: Expectation +scanl1MS = + check (F.scanl1M' (\a b -> return (a + b))) ([1, 2, 3] :: [Int]) + [Nothing, Just 1, Just 3, Just 6] + +-- A terminating scan: accumulate the running sum but stop (terminate) at, and +-- including, the input value 3. +scantStep :: Int -> Int -> F.Step Int Int +scantStep s a = if a == 3 then F.Done s else F.Partial (s + a) + +scantS :: Expectation +scantS = + check (F.scant' scantStep (F.Partial 0) id) ([1, 2, 3, 4] :: [Int]) + [0, 1, 3, 3] + +scantMS :: Expectation +scantMS = + check (F.scantM' (\s a -> return (scantStep s a)) (return (F.Partial 0)) return) + ([1, 2, 3, 4] :: [Int]) [0, 1, 3, 3] + +mkScanrS :: Expectation +mkScanrS = + check (F.mkScanr (:) []) ([1, 2, 3] :: [Int]) [[], [1], [1, 2], [1, 2, 3]] + +mkScanrMS :: Expectation +mkScanrMS = + check (F.mkScanrM (\a xs -> return (a : xs)) (return [])) ([1, 2, 3] :: [Int]) + [[], [1], [1, 2], [1, 2, 3]] + +constS :: Expectation +constS = check (F.const (7 :: Int)) ([1, 2, 3] :: [Int]) [7, 7, 7, 7] + +constMS :: Expectation +constMS = check (F.constM (return (7 :: Int))) ([1, 2, 3] :: [Int]) [7, 7, 7, 7] + +functionMS :: Expectation +functionMS = + check + (F.functionM (\x -> return (if even x then Just x else Nothing))) + ([1, 2, 3, 4] :: [Int]) + [Nothing, Nothing, Just 2, Nothing, Just 4] + +-- A 'Refold' that sums starting from the injected seed. +sumRefold :: Monad m => Refold.Refold m Int Int Int +sumRefold = + Refold.Refold + (\s a -> return (F.Partial (s + a))) + (\c -> return (F.Partial c)) + return + +fromRefoldS :: Expectation +fromRefoldS = check (F.fromRefold sumRefold 0) ([1, 2, 3] :: [Int]) [0, 1, 3, 6] + +toStreamKS :: [Int] -> Expectation +toStreamKS ls = + check (F.rmapM (Stream.toList . Stream.fromStreamK) F.toStreamK) ls + (Prelude.scanl (\acc x -> acc ++ [x]) [] ls) + +toStreamKRevS :: [Int] -> Expectation +toStreamKRevS ls = + check (F.rmapM (Stream.toList . Stream.fromStreamK) F.toStreamKRev) ls + (Prelude.scanl (flip (:)) [] ls) + +------------------------------------------------------------------------------- +-- Deprecated constructors (aliases for the corresponding scanl*' functions) +------------------------------------------------------------------------------- + +mkScanlS :: [Int] -> Expectation +mkScanlS ls = check (F.mkScanl (+) 0) ls (Prelude.scanl (+) 0 ls) + +mkScanlMS :: [Int] -> Expectation +mkScanlMS ls = + check (F.mkScanlM (\b a -> return (b + a)) (return 0)) ls + (Prelude.scanl (+) 0 ls) + +mkScanl1S :: Expectation +mkScanl1S = + check (F.mkScanl1 (+)) ([1, 2, 3] :: [Int]) [Nothing, Just 1, Just 3, Just 6] + +mkScanl1MS :: Expectation +mkScanl1MS = + check (F.mkScanl1M (\a b -> return (a + b))) ([1, 2, 3] :: [Int]) + [Nothing, Just 1, Just 3, Just 6] + +mkScantS :: Expectation +mkScantS = + check (F.mkScant scantStep (F.Partial 0) id) ([1, 2, 3, 4] :: [Int]) + [0, 1, 3, 3] + +mkScantMS :: Expectation +mkScantMS = + check (F.mkScantM (\s a -> return (scantStep s a)) (return (F.Partial 0)) return) + ([1, 2, 3, 4] :: [Int]) [0, 1, 3, 3] + moduleName :: String moduleName = "Data.Scanl.Type" @@ -147,3 +259,25 @@ main = hspec $ it "scanl emits initial, postscanl omits it" scanlVsPostscanl it "postscanl (compose)" postscanlCompose it "postscanlMaybe (compose)" postscanlMaybeCompose + + prop "scanl'" scanlS + prop "scanlM'" scanlMS + it "scanl1'" scanl1S + it "scanl1M'" scanl1MS + it "scant'" scantS + it "scantM'" scantMS + it "mkScanr" mkScanrS + it "mkScanrM" mkScanrMS + it "const" constS + it "constM" constMS + it "functionM" functionMS + it "fromRefold" fromRefoldS + prop "toStreamK" toStreamKS + prop "toStreamKRev" toStreamKRevS + + prop "mkScanl" mkScanlS + prop "mkScanlM" mkScanlMS + it "mkScanl1" mkScanl1S + it "mkScanl1M" mkScanl1MS + it "mkScant" mkScantS + it "mkScantM" mkScantMS diff --git a/test/Streamly/Test/Data/Scanl/Window.hs b/test/Streamly/Test/Data/Scanl/Window.hs index fab487df45..5c2a190548 100644 --- a/test/Streamly/Test/Data/Scanl/Window.hs +++ b/test/Streamly/Test/Data/Scanl/Window.hs @@ -1,6 +1,6 @@ module Streamly.Test.Data.Scanl.Window (main) where -import Test.Hspec (hspec, describe, it, runIO) +import Test.Hspec (hspec, describe, it, runIO, shouldReturn) import Streamly.Internal.Data.Scanl (Incr(..)) import qualified Streamly.Internal.Data.Fold as Fold import qualified Streamly.Internal.Data.RingArray as RingArray @@ -87,3 +87,54 @@ main = hspec $ do let scanInf = [1, 1, 1, 1, 1, 2] :: [Double] scanWin = [1, 1, 1, 1, 1, 3] :: [Double] testFunc testCase2 Scanl.incrMean scanInf scanWin + + -- Direct tests for the incremental and windowed scans. 'incrScan' and the + -- cumulative versions ('incrSum', 'incrMean') are exercised above; here we + -- cover the remaining exported scans. + describe "Scanl operations" $ do + let scl s xs = S.toList (S.scanl s (S.fromList xs)) + -- A stream of incremental operations exercising both Insert and + -- Replace constructors. Window of {1,2} then replace 1 with 5. + incrs = [Insert 1, Insert 2, Replace 1 5] :: [Incr Int] + + it "cumulativeScan" $ + scl (Scanl.cumulativeScan Scanl.incrSum) ([1, 2, 3] :: [Double]) + `shouldReturn` [0, 1, 3, 6] + it "incrScanWith" $ + scl (Scanl.incrScanWith 3 (Scanl.lmap fst Scanl.incrSum)) + ([1, 2, 3, 4, 5] :: [Double]) + `shouldReturn` [0, 1, 3, 6, 9, 12] + it "incrRollingMap" $ + scl (Scanl.incrRollingMap (\p c -> Just (maybe 0 (c -) p))) + ([Insert 1, Replace 1 3, Replace 3 6] :: [Incr Int]) + `shouldReturn` [Nothing, Just 0, Just 2, Just 3] + it "incrRollingMapM" $ + scl (Scanl.incrRollingMapM (\p c -> return (Just (maybe 0 (c -) p)))) + ([Insert 1, Replace 1 3, Replace 3 6] :: [Incr Int]) + `shouldReturn` [Nothing, Just 0, Just 2, Just 3] + it "incrCount" $ + (scl Scanl.incrCount incrs :: IO [Int]) + `shouldReturn` [0, 1, 2, 2] + it "incrSumInt" $ + scl Scanl.incrSumInt incrs `shouldReturn` [0, 1, 3, 7] + it "incrPowerSum" $ + scl (Scanl.incrPowerSum 2) ([Insert 2, Insert 3] :: [Incr Int]) + `shouldReturn` [0, 4, 13] + it "incrPowerSumFrac" $ + scl (Scanl.incrPowerSumFrac 0.5) + ([Insert 4, Insert 9] :: [Incr Double]) + `shouldReturn` [0, 2, 5] + it "windowRange" $ + scl (Scanl.windowRange 3) ([1, 2, 3, 4, 5] :: [Int]) + `shouldReturn` + [ Nothing, Just (1, 1), Just (1, 2), Just (1, 3), Just (2, 4) + , Just (3, 5) + ] + it "windowMinimum" $ + scl (Scanl.windowMinimum 3) ([1, 2, 3, 4, 5] :: [Int]) + `shouldReturn` + [Nothing, Just 1, Just 1, Just 1, Just 2, Just 3] + it "windowMaximum" $ + scl (Scanl.windowMaximum 3) ([1, 2, 3, 4, 5] :: [Int]) + `shouldReturn` + [Nothing, Just 1, Just 2, Just 3, Just 4, Just 5]