2888bf5 · streamly · git.iko.soy

git.iko.soy/streamly

Review/update docs, combinators in Fold module

Data.Fold.Types: * Remove takeSepBy: This function does not do what the name. Also, `takeSepBy p` is the same as (sliceSepBy (not . p)). We can just remove this in favor of sliceSepBy. Data.Fold: * Reorganize exports * Add some skeleton/unimplemented combinators. * Add/update haddock documentation * Add sliceSepByMax fold - It was in parsers but it can be implemented as a fold. * Rename drainSepBy to drainWhile * Rename sliceSepWith to sliceEndWith * Remove distribute_ as it can be implemented using distribute and has not perf advantage. * Remove demuxWithDefault_ and implement demuxDefaultWith instead, which does not discard the results. Discarding results has no perf advantage. * Implement demuxWith in terms of demuxDefaultWith, it has no perf advantage over the latter. * Remove demuxWith_, use demuxWith instead. * Remove demuxDefault_, use demuxDefault instead. * Some code/comment cleanups Benchmarks: * Changes corresponding to the source changes * Some code cleanups * Reorder benchmarks

commit2888bf5ce37da6c50cb1cc4207bce89e2f77fae6 authorHarendra Kumar <harendra@composewell.com> dateThu 10 Dec 2020, 15:19 (6 years ago) parent56fce33

7 files changed+444−462

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Fold.hs+71−101 src/Streamly/Internal/Data/Fold.hs+320−342 src/Streamly/Internal/Data/Fold/Types.hs−15 src/Streamly/Internal/Data/Stream/StreamD.hs+1−1 streamly.cabal+1 test/Streamly/Test/Common.hs+10−2 test/Streamly/Test/Data/Fold.hs+41−1

benchmark/Streamly/Benchmark/Data/Fold.hs+71−101

@@ -10,31 +10,24 @@

1010module Main (main) where

1111

1212import Control.DeepSeq (NFData(..))

13+import Data.Map.Strict (Map)

1314import Data.Monoid (Last(..), Sum(..))

1415import System.Random (randomRIO)

15−import Prelude (IO, Int, Double, String, (>), (<$>), (+), ($), even,

16− (<=), Monad(..), (==), Maybe(..), (.), fromIntegral,

17− compare, (>=), concat, seq, mod, fst, snd, const, Bool, Ord(..),

18− div, Num(..), odd, Either(..))

19−

20−import Data.Map.Strict (Map)

2116

2217import Streamly.Prelude (SerialT)

2318import Streamly.Internal.Data.Fold (Fold(..))

2419

2520import qualified Data.Map.Strict as Map

26−

27−import qualified Streamly.Prelude as S

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

2922import qualified Streamly.Internal.Data.Fold.Types as FL

3023import qualified Streamly.Internal.Data.Pipe as Pipe

31−

3224import qualified Streamly.Internal.Data.Sink as Sink

33−

3425import qualified Streamly.Internal.Data.Stream.IsStream as IP

26+import qualified Streamly.Prelude as S

3527

3628import Gauge

3729import Streamly.Benchmark.Common

30+import Prelude hiding (all, any, take, unzip)

3831

3932-- We need a monadic bind here to make sure that the function f does not get

4033-- completely optimized out by the compiler in some cases.

@@ -75,48 +68,60 @@ all value = IP.fold (FL.all (<= value))

7568take :: Monad m => Int -> SerialT m a -> m ()

7669take value = IP.fold (FL.ltake value FL.drain)

7770

78−{-# INLINE takeSepBy #-}

79−takeSepBy :: Monad m => Int -> SerialT m Int -> m ()

80−takeSepBy value = IP.fold (FL.takeSepBy (<= value) FL.drain)

71+-------------------------------------------------------------------------------

72+-- Splitting by serial application

73+-------------------------------------------------------------------------------

74+

75+{-# INLINE sliceSepBy #-}

76+sliceSepBy :: Monad m => Int -> SerialT m Int -> m ()

77+sliceSepBy value = IP.fold (FL.sliceSepBy (>= value) FL.drain)

8178

8279{-# INLINE many #-}

83−many :: Monad m => SerialT m Int -> m Int

84−many = IP.fold (FL.many FL.length FL.sum)

80+many :: Monad m => SerialT m Int -> m ()

81+many = IP.fold (FL.many FL.drain (FL.ltake 1 FL.drain))

8582

8683{-# INLINE splitAllAny #-}

8784splitAllAny :: Monad m => Int -> SerialT m Int -> m (Bool, Bool)

8885splitAllAny value =

89− IP.fold (FL.splitWith (,) (FL.all (<= (value `div` 2))) (FL.any (> value)))

86+ IP.fold

87+ (FL.splitWith (,)

88+ (FL.all (<= (value `div` 2)))

89+ (FL.any (> value))

90+ )

91+

92+{-

93+{-# INLINE split_ #-}

94+split_ :: Monad m

95+ => Int -> SerialT m Int -> m ()

96+split_ value =

97+ IP.fold

98+ (FL.split_

99+ (FL.all (<= (value `div` 2)))

100+ (FL.any (> value))

101+ )

102+-}

90103

91−{-# INLINE teeAllAny #-}

92−teeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)

93−teeAllAny value =

94− IP.fold (FL.teeWith (,) (FL.all (<= value)) (FL.any (> value)))

104+-------------------------------------------------------------------------------

105+-- Distributing by parallel application

106+-------------------------------------------------------------------------------

95107

96108{-# INLINE teeSumLength #-}

97109teeSumLength :: Monad m => SerialT m Int -> m (Int, Int)

98110teeSumLength = IP.fold (FL.teeWith (,) FL.sum FL.length)

99111

100−{-

101−{-# INLINE applicativeAllAny #-}

102−applicativeAllAny :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)

103−applicativeAllAny value =

104− IP.fold ((,) <$> FL.all (<= value) <*> (FL.any (> value)))

105−

106−{-# INLINE applicativeSumLength #-}

107−applicativeSumLength :: Monad m => SerialT m Int -> m (Int, Int)

108−applicativeSumLength = IP.fold ((,) <$> FL.sum <*> FL.length)

109−-}

110−

111−{-# INLINE distribute_ #-}

112−distribute_ :: Monad m => SerialT m Int -> m ()

113−distribute_ =

114− IP.fold (FL.distribute_ [const () <$> FL.sum, const () <$> FL.length])

112+{-# INLINE teeApplicative #-}

113+teeApplicative :: (Monad m, Ord a) => a -> SerialT m a -> m (Bool, Bool)

114+teeApplicative value =

115+ IP.fold ((,) <$> FL.all (<= value) <*> FL.any (> value))

115116

116117{-# INLINE distribute #-}

117118distribute :: Monad m => SerialT m Int -> m [Int]

118119distribute = IP.fold (FL.distribute [FL.sum, FL.length])

119120

121+-------------------------------------------------------------------------------

122+-- Partitioning

123+-------------------------------------------------------------------------------

124+

120125{-# INLINE partition #-}

121126partition :: Monad m => SerialT m Int -> m (Int, Int)

122127partition =

@@ -126,10 +131,6 @@ partition =

126131 else Right a

127132 in IP.fold $ FL.lmap f (FL.partition FL.sum FL.length)

128133

129−{-# INLINE unzip #-}

130−unzip :: Monad m => SerialT m Int -> m (Int, Int)

131−unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)

132−

133134{-# INLINE demuxWith #-}

134135demuxWith ::

135136 (Monad m, Ord k)

@@ -139,29 +140,28 @@ demuxWith ::

139140 -> m (Map k b)

140141demuxWith f mp = S.fold (FL.demuxWith f mp)

141142

142−{-# INLINE demuxWith_ #-}

143−demuxWith_ ::

144− (Monad m, Ord k)

145− => (a -> (k, a'))

146− -> Map k (Fold m a' b)

147− -> SerialT m a

148− -> m ()

149−demuxWith_ f mp = S.fold (FL.demuxWith_ f mp)

150−

151−{-# INLINE demuxWithDefault_ #-}

152−demuxWithDefault_ ::

143+{-# INLINE demuxDefaultWith #-}

144+demuxDefaultWith ::

153145 (Monad m, Ord k, Num b)

154146 => (a -> (k, b))

155147 -> Map k (Fold m b b)

156148 -> SerialT m a

157− -> m ()

158−demuxWithDefault_ f mp = S.fold (FL.demuxWithDefault_ f mp (FL.lmap snd FL.sum))

149+ -> m (Map k b, b)

150+demuxDefaultWith f mp = S.fold (FL.demuxDefaultWith f mp (FL.lmap snd FL.sum))

159151

160152{-# INLINE classifyWith #-}

161153classifyWith ::

162154 (Monad m, Ord k, Num a) => (a -> k) -> SerialT m a -> m (Map k a)

163155classifyWith f = S.fold (FL.classifyWith f FL.sum)

164156

157+-------------------------------------------------------------------------------

158+-- unzip

159+-------------------------------------------------------------------------------

160+

161+{-# INLINE unzip #-}

162+unzip :: Monad m => SerialT m Int -> m (Int, Int)

163+unzip = IP.fold $ FL.lmap (\a -> (a, a)) (FL.unzip FL.sum FL.length)

164+

165165-------------------------------------------------------------------------------

166166-- Benchmarks

167167-------------------------------------------------------------------------------

@@ -175,14 +175,6 @@ o_1_space_serial_elimination value =

175175 [ benchIOSink value "drain" (S.fold FL.drain)

176176 , benchIOSink value "drainBy" (S.fold (FL.drainBy return))

177177 , benchIOSink value "drainN" (S.fold (FL.drainN value))

178− , benchIOSink

179− value

180− "drainSepByTrue"

181− (S.fold (FL.drainSepBy $ (<=) (value + 1)))

182− , benchIOSink

183− value

184− "drainSepByFalse"

185− (S.fold (FL.drainSepBy $ (>=) (value + 1)))

186178 , benchIOSink value "sink" (S.fold $ Sink.toFold Sink.drain)

187179 , benchIOSink value "last" (S.fold FL.last)

188180 , benchIOSink value "length" (S.fold FL.length)

@@ -196,28 +188,19 @@ o_1_space_serial_elimination value =

196188 , benchIOSink

197189 value

198190 "mean"

199− (\s ->

200− S.fold

201− FL.mean

202− (S.map (fromIntegral :: Int -> Double) s))

191+ (S.fold FL.mean . S.map (fromIntegral :: Int -> Double))

203192 , benchIOSink

204193 value

205194 "variance"

206− (\s ->

207− S.fold

208− FL.variance

209− (S.map (fromIntegral :: Int -> Double) s))

195+ (S.fold FL.variance . S.map (fromIntegral :: Int -> Double))

210196 , benchIOSink

211197 value

212198 "stdDev"

213− (\s ->

214− S.fold

215− FL.stdDev

216− (S.map (fromIntegral :: Int -> Double) s))

199+ (S.fold FL.stdDev . S.map (fromIntegral :: Int -> Double))

217200 , benchIOSink

218201 value

219202 "mconcat"

220− (S.fold FL.mconcat . (S.map (Last . Just)))

203+ (S.fold FL.mconcat . S.map (Last . Just))

221204 , benchIOSink

222205 value

223206 "foldMap"

@@ -247,15 +230,9 @@ o_1_space_serial_elimination value =

247230 , benchIOSink value "all" $ all value

248231 , benchIOSink value "any" $ any value

249232 , benchIOSink value "take" $ take value

250− , benchIOSink value "takeSepBy" $ takeSepBy value

251− , benchIOSink

252− value

253− "and"

254− (\s -> S.fold FL.and (S.map (<= (value + 1)) s))

255− , benchIOSink

256− value

257− "or"

258− (\s -> S.fold FL.or (S.map (> (value + 1)) s))

233+ , benchIOSink value "sliceSepBy" $ sliceSepBy value

234+ , benchIOSink value "and" (S.fold FL.and . S.map (<= (value + 1)))

235+ , benchIOSink value "or" (S.fold FL.or . S.map (> (value + 1)))

259236 ]

260237 ]

261238

@@ -285,30 +262,24 @@ o_1_space_serial_composition :: Int -> [Benchmark]

285262o_1_space_serial_composition value =

286263 [ bgroup

287264 "composition"

288− -- Applicative

289− [ benchIOSink value "tee (all, any)" $ teeAllAny value

290− , benchIOSink value "tee (sum, length)" $ teeSumLength

291− -- , benchIOSink value "applicative (all, any)"

292− -- $ applicativeAllAny value

293− -- , benchIOSink value "applicative (sum, length)"

294− -- $ applicativeSumLength

295− , benchIOSink value "distribute_ [sum, length]" $ distribute_

296− , benchIOSink value "distribute [sum, length]" $ distribute

297− , benchIOSink value "partition (sum, length)" $ partition

298− , benchIOSink value "unzip (sum, length)" $ unzip

265+ [ benchIOSink value "splitWith (all, any)" $ splitAllAny value

266+ , benchIOSink value "teeApplicative (all, any)"

267+ $ teeApplicative value

268+ , benchIOSink value "many drain (take 1)" many

269+ , benchIOSink value "tee (sum, length)" teeSumLength

270+ , benchIOSink value "distribute [sum, length]" distribute

271+ , benchIOSink value "partition (sum, length)" partition

272+ , benchIOSink value "unzip (sum, length)" unzip

273+ , benchIOSink value "demuxDefaultWith [sum, length] sum"

274+ $ demuxDefaultWith fn mp

299275 , benchIOSink value "demuxWith [sum, length]" $ demuxWith fn mp

300− , benchIOSink value "demuxWith_ [sum, length]"

301− $ demuxWith_ fn mp

302− , benchIOSink value "demuxWithDefault_ [sum, length] sum"

303− $ demuxWithDefault_ fn mp

304276 , benchIOSink value "classifyWith sum" $ classifyWith (fst . fn)

305− , benchIOSink value "many length sum" many

306− , benchIOSink value "split (all, any)" $ splitAllAny value

307277 ]

308278 ]

309279

310280 where

311281

282+ -- We use three keys 0, 1, and 2. 0 and 1 are mapped and 3 is unmapped.

312283 fn x = (x `mod` 3, x)

313284

314285 mp = Map.fromList [(0, FL.sum), (1, FL.length)]

@@ -341,6 +312,5 @@ main = do

341312 , o_1_space_serial_transformation value

342313 , o_1_space_serial_composition value

343314 ]

344− , bgroup (o_n_heap_prefix moduleName) $ concat

345− [ o_n_heap_serial value ]

315+ , bgroup (o_n_heap_prefix moduleName) (o_n_heap_serial value)

346316 ]

src/Streamly/Internal/Data/Fold.hs+320−342

@@ -6,9 +6,8 @@

66-- Maintainer : streamly@composewell.com

77-- Stability : experimental

88-- Portability : GHC

9−

10−-- Also see the "Streamly.Internal.Data.Sink" module that provides specialized

11−-- left folds that discard the outputs.

9+--

10+-- See "Streamly.Data.Fold" for an overview.

1211--

1312-- IMPORTANT: keep the signatures consistent with the folds in Streamly.Prelude

1413

@@ -18,13 +17,7 @@ module Streamly.Internal.Data.Fold

1817 Step (..)

1918 , Fold (..)

2019

21− , hoist

22− , generally

23−

24− -- , tail

25− -- , init

26−

27− -- * Fold Creation Utilities

20+ -- * Creating

2821 , mkAccum

2922 , mkAccum_

3023 , mkAccumM

@@ -34,19 +27,23 @@ module Streamly.Internal.Data.Fold

3427 , mkFoldM

3528 , mkFoldM_

3629

37− -- ** Full Folds

30+ -- * Generators

31+ , yield

32+ , yieldM

33+

34+ -- * Accumulators

35+ -- ** Semigroups and Monoids

36+ , sconcat

37+ , mconcat

38+ , foldMap

39+ , foldMapM

40+

41+ -- ** Reducers

3842 , drain

3943 , drainBy

4044 , drainBy2

4145 , last

4246 , length

43− , sum

44− , product

45− , maximumBy

46− , maximum

47− , minimumBy

48− , minimum

49− -- , the

5047 , mean

5148 , variance

5249 , stdDev

@@ -55,22 +52,24 @@ module Streamly.Internal.Data.Fold

5552 , rollingHashFirstN

5653 -- , rollingHashLastN

5754

58− -- ** Fold Semigroups

59− , sconcat

60−

61− -- ** Full Folds (Monoidal)

62− , mconcat

63− , foldMap

64− , foldMapM

65−

66− -- ** Full Folds (To Containers)

55+ -- ** Saturating Reducers

56+ -- | 'product' terminates if it becomes 0. Other folds can theoretically

57+ -- saturate on bounded types, and therefore terminate, however, they will

58+ -- run forever on unbounded types like Integer/Double.

59+ , sum

60+ , product

61+ , maximumBy

62+ , maximum

63+ , minimumBy

64+ , minimum

6765

66+ -- ** Collectors

6867 , toList

6968 , toListRevF -- experimental

69+ , toParallelSVar

7070

71− -- ** Partial Folds

71+ -- * Terminating Folds

7272 , drainN

73− , drainSepBy

7473 -- , lastN

7574 -- , (!!)

7675 -- , genericIndex

@@ -84,18 +83,27 @@ module Streamly.Internal.Data.Fold

8483 , null

8584 , elem

8685 , notElem

87− -- XXX these are slower than right folds even when full input is used

8886 , all

8987 , any

9088 , and

9189 , or

90+ -- , the

91+ , toParallelSVarLimited

9292

93− -- * Transformations

93+ -- * Adapting

94+ , hoist

95+ , generally

96+

97+ -- * Running Incrementally

98+ , initialize

99+ , runStep

94100

95− -- ** Covariant Operations

101+ -- * Output Transformations

96102 , sequence

97103 , mapM

98104

105+ -- * Input Transformations

106+

99107 -- ** Mapping

100108 , transform

101109 , lmap

@@ -127,37 +135,35 @@ module Streamly.Internal.Data.Fold

127135 , lreverse

128136 -}

129137

130− -- * Parsing

131138 -- ** Trimming

132139 , ltake

133− -- , lrunFor -- time

134− , takeSepBy

140+ , takeByTime

141+ -- By elements

142+ , sliceSepBy

143+ -- , breakOn

144+ , sliceSepByMax

145+ , sliceEndWith

146+ -- , breakAfter

135147 {-

136− , ltakeWhileM

137148 , ldrop

138149 , ldropWhile

139150 , ldropWhileM

140151 -}

141152

142− , lsessionsOf

143− , lchunksOf

144−

145− -- ** Breaking

153+ -- * Splitting

146154

147155 -- Binary

156+ -- , tail

157+ -- , init

148158 , splitAt -- spanN

149159 -- , splitIn -- sessionN

150160

151− -- By elements

161+ -- XXX To be moved to parsers

152162 , span -- spanWhile

153163 , break -- breakBefore

154− -- , breakAfter

155− -- , breakOn

156164 -- , breakAround

157165 , spanBy

158166 , spanByRolling

159− , sliceSepBy

160− , sliceSepWith

161167

162168 -- By sequences

163169 -- , breakOnSeq

@@ -166,8 +172,12 @@ module Streamly.Internal.Data.Fold

166172 -- * Distributing

167173

168174 , tee

175+ , teeWith

176+ , teeWithFst

177+ , teeWithMin

169178 , distribute

170− , distribute_

179+ -- , distributeFst

180+ -- , distributeMin

171181

172182 -- * Partitioning

173183

@@ -179,17 +189,19 @@ module Streamly.Internal.Data.Fold

179189

180190 -- * Demultiplexing

181191

182− , demux

192+ , demux -- XXX rename this to demux_

183193 , demuxWith

184− , demux_

185− , demuxDefault_

186− , demuxWith_

187− , demuxWithDefault_

194+ , demuxDefault -- XXX rename this to demux

195+ , demuxDefaultWith

196+ -- , demuxWithSel

197+ -- , demuxWithMin

188198

189199 -- * Classifying

190200

191201 , classify

192202 , classifyWith

203+ -- , classifyWithSel

204+ -- , classifyWithMin

193205

194206 -- * Unzipping

195207 , unzip

@@ -198,18 +210,15 @@ module Streamly.Internal.Data.Fold

198210 , unzipWithFstM

199211 , unzipWithMinM

200212

201− -- * Nested Folds

202− -- , concatMap

213+ -- * Nesting

203214 , many

204− , duplicate

205−

206− -- * Running Folds

207− , initialize

208− , runStep

215+ , lsessionsOf

216+ , lchunksOf

217+ , chunksBetween

209218

210− -- * Folding to SVar

211− , toParallelSVar

212− , toParallelSVarLimited

219+ , concatSequence

220+ , concatMap

221+ , duplicate

213222 )

214223where

215224

@@ -222,15 +231,14 @@ import Data.Maybe (isJust, fromJust)

222231#if __GLASGOW_HASKELL__ < 804

223232import Data.Semigroup (Semigroup((<>)))

224233#endif

234+import Streamly.Internal.Data.Either.Strict (Either'(..))

235+import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)

225236import Streamly.Internal.Data.Pipe.Types (Pipe (..), PipeState(..))

226237import Streamly.Internal.Data.Tuple.Strict (Tuple'(..), Tuple3'(..))

227−import Streamly.Internal.Data.Maybe.Strict (Maybe'(..), toMaybe)

228−import Streamly.Internal.Data.Either.Strict (Either'(..))

229238

239+import qualified Data.Map.Strict as Map

230240import qualified Streamly.Internal.Data.Fold.Types as FL

231241import qualified Streamly.Internal.Data.Pipe.Types as Pipe

232−import qualified Data.Map.Strict as Map

233−import qualified Data.Set as Set

234242import qualified Prelude

235243

236244import Prelude hiding

@@ -542,7 +550,7 @@ sum = Fold (\x a -> return $ Partial $ x + a) (return 0) return

542550-- > product = fmap getProduct $ FL.foldMap Product

543551--

544552-- @since 0.7.0

545−-- /since 0.8.0 (Added 'Eq' constraint)/

553+-- /Since 0.8.0 (Added 'Eq' constraint)/

546554{-# INLINE product #-}

547555product :: (Monad m, Num a, Eq a) => Fold m a a

548556product = Fold step (return 1) return

@@ -758,7 +766,7 @@ mconcat = sconcat mempty

758766-- @since 0.7.0

759767{-# INLINABLE foldMap #-}

760768foldMap :: (Monad m, Monoid b

761−#if __GLASGOW_HASKELL__ < 804

769+#if !MIN_VERSION_base(4,11,0)

762770 , Semigroup b

763771#endif

764772 ) => (a -> b) -> Fold m a b

@@ -816,12 +824,6 @@ toList = Fold (\f x -> return $ Partial $ f . (x :))

816824drainN :: Monad m => Int -> Fold m a ()

817825drainN n = ltake n drain

818826

819−-- | A fold that drains elements of its input as long as the predicate succeeds,

820−-- running the effects and discarding the results.

821−{-# INLINABLE drainSepBy #-}

822−drainSepBy :: Monad m => (a -> Bool) -> Fold m a ()

823−drainSepBy p = takeSepBy p drain

824−

825827------------------------------------------------------------------------------

826828-- To Elements

827829------------------------------------------------------------------------------

@@ -932,12 +934,15 @@ elemIndex a = findIndex (a ==)

932934null :: Monad m => Fold m a Bool

933935null = Fold (\() _ -> return $ Done False) (return ()) (\() -> return True)

934936

935−-- |

937+--

936938-- > any p = lmap p or

937939-- > any p = fmap getAny . FL.foldMap (Any . p)

938940--

939941-- | Returns 'True' if any of the elements of a stream satisfies a predicate.

940942--

943+-- >>> Stream.fold (Fold.any (== 0)) $ Stream.fromList [1,0,1]

944+-- > True

945+--

941946-- @since 0.7.0

942947{-# INLINE any #-}

943948any :: Monad m => (a -> Bool) -> Fold m a Bool

@@ -962,12 +967,15 @@ any predicate = Fold step initial return

962967elem :: (Eq a, Monad m) => a -> Fold m a Bool

963968elem a = any (a ==)

964969

965−-- |

970+--

966971-- > all p = lmap p and

967972-- > all p = fmap getAll . FL.foldMap (All . p)

968973--

969974-- | Returns 'True' if all elements of a stream satisfy a predicate.

970975--

976+-- >>> Stream.fold (Fold.all (== 0)) $ Stream.fromList [1,0,1]

977+-- > False

978+--

971979-- @since 0.7.0

972980{-# INLINABLE all #-}

973981all :: Monad m => (a -> Bool) -> Fold m a Bool

@@ -1050,11 +1058,10 @@ or = any (== True)

10501058-- >>> splitAt_ 4 [1,2,3]

10511059-- > ([1,2,3],[])

10521060--

1061+-- > splitAt n f1 f2 = splitWith (,) (ltake n f1) f2

1062+--

10531063-- /Internal/

10541064

1055−-- This can be considered as a two-fold version of 'ltake' where we take both

1056−-- the segments instead of discarding the leftover.

1057−--

10581065{-# INLINE splitAt #-}

10591066splitAt

10601067 :: Monad m

@@ -1062,7 +1069,7 @@ splitAt

10621069 -> Fold m a b

10631070 -> Fold m a c

10641071 -> Fold m a (b, c)

1065−splitAt n fld1 = splitWith (,) (ltake n fld1)

1072+splitAt n fld = splitWith (,) (ltake n fld)

10661073

10671074------------------------------------------------------------------------------

10681075-- Element Aware APIs

@@ -1072,7 +1079,18 @@ splitAt n fld1 = splitWith (,) (ltake n fld1)

10721079-- Binary APIs

10731080------------------------------------------------------------------------------

10741081

1075−-- | Stops the fold at an infixed separator element, dropping the separator.

1082+-- Note: Keep this consistent with S.splitOn. In fact we should eliminate

1083+-- S.splitOn in favor of the fold.

1084+--

1085+-- | Consume the input until it encounters an infixed separator element (i.e.

1086+-- when the supplied predicate succeeds), dropping the separator.

1087+--

1088+-- Repeated applications of 'sliceSepBy' splits the stream on separator

1089+-- elements determined by the supplied predicate, separator is considered as

1090+-- infixed between two segments, if one side of the separator is missing then

1091+-- it is parsed as an empty stream. The supplied 'Fold' is applied on the

1092+-- split segments. With '-' representing non-separator elements and '.' as

1093+-- separator, repeated 'sliceSepBy' splits the stream as follows:

10761094--

10771095-- @

10781096-- "--.--" => "--" "--"

@@ -1080,12 +1098,41 @@ splitAt n fld1 = splitWith (,) (ltake n fld1)

10801098-- ".--" => "" "--"

10811099-- @

10821100--

1083−-- * Stops - when the predicate succeeds.

1101+-- Repeated applications of @Fold.sliceSepBy (== x)@ on the input stream gives us

1102+-- an inverse of @Stream.intercalate (Stream.yield x)@

1103+--

1104+-- > Stream.splitOn pred f = Stream.foldMany (Fold.sliceSepBy pred f)

1105+--

1106+-- Let's use the following definition for illustration:

1107+--

1108+-- > splitOn p = Stream.foldMany (Fold.sliceSepBy pred Fold.toList)

1109+-- > splitOn' p = Stream.toList . splitOn p . Stream.fromList

1110+--

1111+-- >>> splitOn' (== '.') ""

1112+-- [""]

1113+--

1114+-- >>> splitOn' (== '.') "."

1115+-- ["",""]

1116+--

1117+-- >>> splitOn' (== '.') ".a"

1118+-- > ["","a"]

1119+--

1120+-- >>> splitOn' (== '.') "a."

1121+-- > ["a",""]

1122+--

1123+-- >>> splitOn' (== '.') "a.b"

1124+-- > ["a","b"]

1125+--

1126+-- >>> splitOn' (== '.') "a..b"

1127+-- > ["a","","b"]

1128+--

1129+-- Stops - when the predicate succeeds.

10841130--

10851131-- /Internal/

10861132{-# INLINE sliceSepBy #-}

10871133sliceSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

1088−sliceSepBy predicate (Fold fstep finitial fextract) = Fold step initial fextract

1134+sliceSepBy predicate (Fold fstep finitial fextract) =

1135+ Fold step initial fextract

10891136

10901137 where

10911138

@@ -1096,20 +1143,56 @@ sliceSepBy predicate (Fold fstep finitial fextract) = Fold step initial fextract

10961143 then fstep s a

10971144 else Done <$> fextract s

10981145

1099−-- | Like 'sliceSepBy' but does not drop the seperator element.

1146+-- | Like 'sliceSepBy' but terminates a parse even before the separator

1147+-- is encountered if its size exceeds the specified maximum limit.

11001148--

1101−-- @

1102−-- "--.--" => "--." "--"

1103−-- "--." => "--." ""

1104−-- ".--" => "." "--"

1105−-- @

1149+-- > take n = PR.sliceSepByMax (const True) n

1150+-- > sliceSepBy p = PR.sliceSepByMax p maxBound

1151+--

1152+-- Let's use the following definitions for illustration:

1153+--

1154+-- > splitOn p n = PR.many FL.toList $ PR.sliceSepByMax p n (FL.toList)

1155+-- > splitOn' p n = S.parse (splitOn p n) . S.fromList

1156+--

1157+-- >>> splitOn' (== '.') 0 ""

1158+-- [""]

1159+--

1160+-- >>> splitOn' (== '.') 0 "a"

1161+-- infinite list of empty strings

1162+--

1163+-- >>> splitOn' (== '.') 3 "hello.world"

1164+-- ["hel","lo","wor","ld"]

1165+--

1166+-- If the separator is found and the limit is reached at the same time then it

1167+-- behaves just like 'sliceSepBy' i.e. the separator is dropped.

1168+--

1169+-- >>> splitOn' (== '.') 0 "."

1170+-- ["",""]

1171+--

1172+-- >>> splitOn' (== '.') 0 ".."

1173+-- ["","",""]

1174+--

1175+-- Stops - when the predicate succeeds or the limit is reached.

1176+--

1177+-- /Internal/

1178+{-# INLINABLE sliceSepByMax #-}

1179+sliceSepByMax :: Monad m

1180+ => (a -> Bool) -> Int -> Fold m a b -> Fold m a b

1181+sliceSepByMax p n = sliceSepBy p . ltake n

1182+

1183+-- | Collect stream elements until an element succeeds the predicate. Also take

1184+-- the element on which the predicate succeeded. The succeeding element is

1185+-- treated as a suffix separator which is kept in the output segement.

11061186--

11071187-- * Stops - when the predicate succeeds.

11081188--

1189+-- > Stream.splitWithSuffix pred f = Stream.foldMany (Fold.sliceEndWith pred f)

1190+--

11091191-- /Internal/

1110−{-# INLINE sliceSepWith #-}

1111−sliceSepWith :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

1112−sliceSepWith predicate (Fold fstep finitial fextract) =

1192+--

1193+{-# INLINE sliceEndWith #-}

1194+sliceEndWith :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

1195+sliceEndWith predicate (Fold fstep finitial fextract) =

11131196 Fold step initial fextract

11141197

11151198 where

@@ -1375,7 +1458,6 @@ foldNil = Fold step begin done where

13751458 step _ _ = return $ Partial []

13761459 done = return

13771460

1378−-- XXX How is the performance?

13791461{-# INLINE foldCons #-}

13801462foldCons :: Monad m => Fold m a b -> Fold m a [b] -> Fold m a [b]

13811463foldCons = teeWith (:)

@@ -1401,58 +1483,19 @@ foldCons = teeWith (:)

14011483--

14021484-- This is the consumer side dual of the producer side 'sequence' operation.

14031485--

1486+-- Stops when all the folds stop.

1487+--

14041488-- @since 0.7.0

14051489{-# INLINE distribute #-}

14061490distribute :: Monad m => [Fold m a b] -> Fold m a [b]

14071491distribute = foldr foldCons foldNil

14081492

1409−-- XXX This is 2x times faster wiithout the terminating condition.

1410−-- | Like 'distribute' but for folds that return (), this can be more efficient

1411−-- than 'distribute' as it does not need to maintain state. This fold terminates

1412−-- when all the folds terminate.

1413−--

1414−{-# INLINE distribute_ #-}

1415−distribute_ :: Monad m => [Fold m a ()] -> Fold m a ()

1416−distribute_ fs = Fold step initial extract

1417−

1418− where

1419−

1420− initial = Prelude.mapM initialize fs

1421−

1422− -- XXX This itself can be a recursive function but we might face inlining

1423− -- problems.

1424− step [] _ = return $ Done ()

1425− step ss a = do

1426− !ss1 <- go ss a

1427− return

1428− $ if Prelude.null ss1

1429− then Done ()

1430− else Partial ss1

1431−

1432− go [] _ = return []

1433− go ((Fold s i d):ss) a = do

1434− i1 <- i

1435− res <- s i1 a

1436− case res of

1437− Partial i2 -> do

1438− rst <- go ss a

1439− let fld = Fold s (return i2) d

1440− return $ fld : rst

1441− Done () -> go ss a

1442−

1443− extract ss = go1 ss

1444−

1445− go1 [] = return ()

1446− go1 ((Fold _ i d):ss) = (i >>= d) >> go1 ss

1447−

14481493------------------------------------------------------------------------------

14491494-- Partitioning

14501495------------------------------------------------------------------------------

14511496

14521497-- | Partition the input over two folds using an 'Either' partitioning

1453−-- predicate. This fold terminates when both the folds terminate.

1454−--

1455−-- See also: 'partitionByFstM' and 'partitionByMinM'.

1498+-- predicate.

14561499--

14571500-- @

14581501--

@@ -1490,6 +1533,13 @@ distribute_ fs = Fold step initial extract

14901533--

14911534-- This is the consumer side dual of the producer side 'mergeBy' operation.

14921535--

1536+-- When one fold is done, any input meant for it is ignored until the other

1537+-- fold is also done.

1538+--

1539+-- Stops when both the folds stop.

1540+--

1541+-- /See also: 'partitionByFstM' and 'partitionByMinM'./

1542+--

14931543-- @since 0.7.0

14941544{-# INLINE partitionByM #-}

14951545partitionByM :: Monad m

@@ -1499,10 +1549,7 @@ partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =

14991549

15001550 where

15011551

1502− begin = do

1503− sL <- beginL

1504− sR <- beginR

1505− return $ RunBoth sL sR

1552+ begin = RunBoth <$> beginL <*> beginR

15061553

15071554 step (RunBoth sL sR) a = do

15081555 r <- f a

@@ -1542,16 +1589,9 @@ partitionByM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =

15421589 Partial sres -> Partial $ RunRight bL sres

15431590 Done bres -> Done (bL, bres)

15441591

1545− done (RunBoth sL sR) = do

1546− bL <- doneL sL

1547− bR <- doneR sR

1548− return (bL, bR)

1549− done (RunLeft sL bR) = do

1550− bL <- doneL sL

1551− return (bL, bR)

1552− done (RunRight bL sR) = do

1553− bR <- doneR sR

1554− return (bL, bR)

1592+ done (RunBoth sL sR) = (,) <$> doneL sL <*> doneR sR

1593+ done (RunLeft sL bR) = (,bR) <$> doneL sL

1594+ done (RunRight bL sR) = (bL,) <$> doneR sR

15551595

15561596-- | Similar to 'partitionByM' but terminates when the first fold terminates.

15571597--

@@ -1639,44 +1679,16 @@ partition = partitionBy id

16391679-- ...

16401680-- @

16411681--

1642−-- @since 0.7.0

1682+-- Any input that does not map to a fold in the input Map is silently ignored.

1683+--

1684+-- > demuxWith f kv = fmap fst $ demuxDefaultWith f kv drain

1685+--

1686+-- /Internal/

1687+--

16431688{-# INLINE demuxWith #-}

16441689demuxWith :: (Monad m, Ord k)

16451690 => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a (Map k b)

1646−demuxWith f kv = Fold step initial extract

1647−

1648− where

1649−

1650− initial = Tuple' Map.empty <$> Prelude.mapM initialize kv

1651−

1652− step (Tuple' bmp mp) a =

1653− if Map.size mp > 0

1654− then do

1655− let (k, a') = f a

1656− case Map.lookup k mp of

1657− Nothing -> return $ Partial $ Tuple' bmp mp

1658− Just (Fold stp ini dn) -> do

1659− !st <- ini

1660− !res <- stp st a'

1661− return

1662− $ case res of

1663− Partial sres ->

1664− let fld = Fold stp (return sres) dn

1665− mp1 = Map.insert k fld mp

1666− in Partial $ Tuple' bmp mp1

1667− Done bres ->

1668− let mp1 = Map.delete k mp

1669− bmp1 = Map.insert k bres bmp

1670− in if Map.size mp1 == 0

1671− then Done bmp1

1672− else Partial $ Tuple' bmp1 mp1

1673− -- XXX This state is reached even for an empty Map. That will change

1674− -- once we have Step in the initial value

1675− else error "Illegal state"

1676−

1677− extract (Tuple' bmp mp) = do

1678− mpe <- Prelude.mapM (\(Fold _ i d) -> i >>= d) mp

1679− return $ bmp `Map.union` mpe

1691+demuxWith f kv = fmap fst $ demuxDefaultWith f kv drain

16801692

16811693-- | Fold a stream of key value pairs using a map of specific folds for each

16821694-- key into a map from keys to the results of fold outputs of the corresponding

@@ -1695,164 +1707,119 @@ demux :: (Monad m, Ord k)

16951707 => Map k (Fold m a b) -> Fold m (k, a) (Map k b)

16961708demux = demuxWith id

16971709

1698−-- data DemuxState m s = DemuxP !m !s | DemuxingOnlyMap !m

1699−data DemuxState s m1 m2 = DemuxingWithDefault !s !m1 !m2 | DemuxingOnlyMap !m2

1710+data DemuxState s b rMap kvMap =

1711+ DemuxMapWithDefault !s !rMap !kvMap

1712+ | DemuxMap b !rMap !kvMap

1713+ | DemuxDefault s !rMap

17001714

1701−{-# INLINE demuxWithDefault_ #-}

1702−demuxWithDefault_ :: (Monad m, Ord k)

1703− => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m (k, a') b -> Fold m a ()

1704−demuxWithDefault_ f kv (Fold dstep dinitial dextract) =

1715+-- | Like 'demuxWith' but uses a default catchall fold to handle inputs which

1716+-- do not have a specific fold in the map to handle them.

1717+--

1718+-- If any fold in the map stops, inputs meant for that fold are sent to the

1719+-- catchall fold. If the catchall fold stops then inputs that do not match any

1720+-- fold are ignored.

1721+--

1722+-- Stops when all the folds, including the catchall fold, stop.

1723+--

1724+-- /Internal/

1725+--

1726+{-# INLINE demuxDefaultWith #-}

1727+demuxDefaultWith :: (Monad m, Ord k)

1728+ => (a -> (k, a'))

1729+ -> Map k (Fold m a' b)

1730+ -> Fold m (k, a') c

1731+ -> Fold m a (Map k b, c)

1732+demuxDefaultWith f kv (Fold dstep dinitial dextract) =

17051733 Fold step initial extract

17061734

17071735 where

17081736

1709− initial = do

1710− ini <- dinitial

1711− mp <- Prelude.mapM initialize kv

1712− return $ DemuxingWithDefault ini Set.empty mp

1737+ initial =

1738+ DemuxMapWithDefault

1739+ <$> dinitial

1740+ <*> return Map.empty

1741+ <*> Prelude.mapM initialize kv

17131742

1714− -- XXX Some code can probably be abstracted

1715− step (DemuxingWithDefault dacc bst mp) a =

1716− if Map.size mp > 0

1743+ step (DemuxMapWithDefault dacc results kvMap) a =

1744+ if Map.size kvMap > 0

17171745 then do

17181746 let (k, a1) = f a

1719− case Map.lookup k mp of

1720− Nothing ->

1721− if k `Set.member` bst

1722− then return $ Partial $ DemuxingWithDefault dacc bst mp

1723− else do

1724− res <- dstep dacc (k, a1)

1725− return

1726− $ Partial

1727− $ case res of

1728− Partial sres ->

1729− DemuxingWithDefault sres bst mp

1730− Done _ -> DemuxingOnlyMap mp

1731− Just (Fold stp ini dn) -> do

1732− !st <- ini

1733− !res <- stp st a1

1747+ case Map.lookup k kvMap of

1748+ Nothing -> do

1749+ res <- dstep dacc (k, a1)

17341750 return

1751+ $ Partial

17351752 $ case res of

1736− Partial sres ->

1737− let fld = Fold stp (return sres) dn

1738− mp1 = Map.insert k fld mp

1739− in Partial $ DemuxingWithDefault dacc bst mp1

1740− Done _ ->

1741− -- XXX We can skip the check here

1742− if Map.size mp == 1

1743− then Done ()

1744− else Partial

1745− $ DemuxingWithDefault

1746− dacc

1747− (Set.insert k bst)

1748− (Map.delete k mp)

1749− -- XXX This state is reached even for an empty Map. That will change

1750− -- once we have Step in the initial value

1751− else error "Illegal state"

1752− -- XXX Reduce code duplication?

1753− step (DemuxingOnlyMap mp) a =

1754− if Map.size mp > 0

1755− then do

1756− let (k, a1) = f a

1757− case Map.lookup k mp of

1758− Nothing -> return $ Partial $ DemuxingOnlyMap mp

1759− Just (Fold stp ini dn) -> do

1760− !st <- ini

1761− !res <- stp st a1

1753+ Partial s -> DemuxMapWithDefault s results kvMap

1754+ Done b -> DemuxMap b results kvMap

1755+ Just (Fold step1 initial1 extract1) -> do

1756+ !st <- initial1

1757+ !res <- step1 st a1

17621758 return

17631759 $ case res of

1764− Partial sres ->

1765− Partial

1766− $ DemuxingOnlyMap

1767− $ Map.insert

1768− k

1769− (Fold stp (return sres) dn)

1770− mp

1771− Done _ ->

1772− if Map.size mp == 1

1773− then Done ()

1774− else Partial

1775− $ DemuxingOnlyMap $ Map.delete k mp

1776− -- XXX This state is reached even for an empty Map. That will change

1777− -- once we have Step in the initial value

1778− else error "Illegal state"

1779−

1780− extract (DemuxingWithDefault dacc _ mp) = do

1781− void $ dextract dacc

1782− Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp

1783− extract (DemuxingOnlyMap mp) = do

1784− Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp

1785−

1786−-- | Split the input stream based on a key field and fold each split using a

1787−-- specific fold without collecting the results. Useful for cases like protocol

1788−-- handlers to handle different type of packets.

1789−--

1790−-- @

1791−--

1792−-- |-------Fold m a ()

1793−-- -----stream m a-----Map-----|

1794−-- |-------Fold m a ()

1795−-- |

1796−-- ...

1797−-- @

1798−--

1799−--

1800−-- @since 0.7.0

1801−

1802−-- demuxWith_ can be slightly faster than demuxWith because we do not need to

1803−-- update the Map in this case. This may be significant only if the map is

1804−-- large.

1805−{-# INLINE demuxWith_ #-}

1806−demuxWith_ :: (Monad m, Ord k)

1807− => (a -> (k, a')) -> Map k (Fold m a' b) -> Fold m a ()

1808−demuxWith_ f kv = Fold step initial extract

1809−

1810− where

1811−

1812− initial = Tuple' (Map.size kv) <$> Prelude.mapM initialize kv

1813−

1814− step (Tuple' n mp) a

1815− | (k, a') <- f a =

1816− case Map.lookup k mp of

1817− Nothing -> return $ Partial $ Tuple' n mp

1818− Just (Fold stp ini dn) -> do

1819− !st <- ini

1820− !res <- stp st a'

1821− let n1 = n - 1

1760+ Partial s ->

1761+ let fld = Fold step1 (return s) extract1

1762+ kvMap1 = Map.insert k fld kvMap

1763+ in Partial

1764+ $ DemuxMapWithDefault

1765+ dacc results kvMap1

1766+ Done b ->

1767+ let kvMap1 = Map.delete k kvMap

1768+ results1 = Map.insert k b results

1769+ in Partial

1770+ $ if Map.size kvMap1 == 0

1771+ then DemuxDefault dacc results1

1772+ else DemuxMapWithDefault

1773+ dacc results1 kvMap1

1774+ -- XXX Remove this when we have Step in the initial value

1775+ else error "demuxDefaultWith: empty key-value Map"

1776+ step (DemuxMap dval results kvMap) a =

1777+ if Map.size kvMap > 0

1778+ then do

1779+ let (k, a1) = f a

1780+ case Map.lookup k kvMap of

1781+ Nothing -> return $ Partial $ DemuxMap dval results kvMap

1782+ Just (Fold step1 initial1 extract1) -> do

1783+ !st <- initial1

1784+ !res <- step1 st a1

18221785 return

18231786 $ case res of

1824− Partial sres ->

1825− let fld = Fold stp (return sres) dn

1826− in Partial $ Tuple' n $ Map.insert k fld mp

1827− Done _ ->

1828− if n1 == 0

1829− then Done ()

1830− else Partial $ Tuple' n1 $ Map.delete k mp

1831−

1832− extract (Tuple' _ mp) = do

1833− Prelude.mapM_ (\(Fold _ i d) -> i >>= d) mp

1834−

1835−-- | Given a stream of key value pairs and a map from keys to folds, fold the

1836−-- values for each key using the corresponding folds, discarding the outputs.

1837−--

1838−-- @

1839−-- > let prn = FL.drainBy print

1840−-- > let table = Data.Map.fromList [(\"ONE", prn), (\"TWO", prn)]

1841−-- input = S.fromList [(\"ONE",1),(\"TWO",2)]

1842−-- in S.fold (FL.demux_ table) input

1843−-- One 1

1844−-- Two 2

1845−-- @

1846−--

1847−-- @since 0.7.0

1848−{-# INLINE demux_ #-}

1849−demux_ :: (Monad m, Ord k) => Map k (Fold m a ()) -> Fold m (k, a) ()

1850−demux_ = demuxWith_ id

1851−

1852−{-# INLINE demuxDefault_ #-}

1853−demuxDefault_ :: (Monad m, Ord k)

1854− => Map k (Fold m a ()) -> Fold m (k, a) () -> Fold m (k, a) ()

1855−demuxDefault_ = demuxWithDefault_ id

1787+ Partial s ->

1788+ let fld = Fold step1 (return s) extract1

1789+ kvMap1 = Map.insert k fld kvMap

1790+ in Partial $ DemuxMap dval results kvMap1

1791+ Done b ->

1792+ let kvMap1 = Map.delete k kvMap

1793+ results1 = Map.insert k b results

1794+ in if Map.size kvMap1 == 0

1795+ then Done (results1, dval)

1796+ else Partial

1797+ $ DemuxMap dval results1 kvMap1

1798+ -- XXX Remove this when we have Step in the initial value

1799+ else error "demuxDefaultWith: empty key-value Map"

1800+ step (DemuxDefault dacc results) a = do

1801+ let (k, a1) = f a

1802+ res <- dstep dacc (k, a1)

1803+ return

1804+ $ case res of

1805+ Partial s -> Partial $ DemuxDefault s results

1806+ Done b -> Done (results, b)

1807+

1808+ extract (DemuxMapWithDefault dacc results kvMap) = do

1809+ b <- dextract dacc

1810+ kvMap1 <- Prelude.mapM (\(Fold _ i d) -> i >>= d) kvMap

1811+ return (results `Map.union` kvMap1, b)

1812+ extract (DemuxMap dval results kvMap) = do

1813+ kvMap1 <- Prelude.mapM (\(Fold _ i d) -> i >>= d) kvMap

1814+ return (results `Map.union` kvMap1, dval)

1815+ extract (DemuxDefault dacc results) = do

1816+ b <- dextract dacc

1817+ return (results, b)

1818+

1819+{-# INLINE demuxDefault #-}

1820+demuxDefault :: (Monad m, Ord k)

1821+ => Map k (Fold m a b) -> Fold m (k, a) b -> Fold m (k, a) (Map k b, b)

1822+demuxDefault = demuxDefaultWith id

18561823

18571824-- TODO If the data is large we may need a map/hashmap in pinned memory instead

18581825-- of a regular Map. That may require a serializable constraint though. We can

@@ -1868,7 +1835,13 @@ demuxDefault_ = demuxWithDefault_ id

18681835-- fromList [(\"ONE",[1.1,1.0]),(\"TWO",[2.2,2.0])]

18691836-- @

18701837--

1871−-- @since 0.7.0

1838+-- If the classifier fold stops for a particular key any further inputs in that

1839+-- bucket are ignored.

1840+--

1841+-- /Stops: never/

1842+--

1843+-- /Internal/

1844+--

18721845{-# INLINE classifyWith #-}

18731846classifyWith :: (Monad m, Ord k) => (a -> k) -> Fold m a b -> Fold m a (Map k b)

18741847classifyWith f (Fold step initial extract) = Fold step' initial' extract'

@@ -1936,7 +1909,7 @@ classify fld = classifyWith fst (lmap snd fld)

19361909

19371910-- | Like 'unzipWith' but with a monadic splitter function.

19381911--

1939−-- -- @unzipWithM f fld1 fld2 = lmapM f (unzip fld1 fld2)@

1912+-- -- @unzipWithM k f1 f2 = lmapM k (unzip f1 f2)@

19401913--

19411914-- @since 0.7.0

19421915{-# INLINE unzipWithM #-}

@@ -1981,8 +1954,8 @@ unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =

19811954 Done bresR -> Done (bL, bresR)

19821955

19831956 done (RunBoth sL sR) = (,) <$> doneL sL <*> doneR sR

1984− done (RunLeft sL bR) = (,) <$> doneL sL <*> return bR

1985− done (RunRight bL sR) = (,) bL <$> doneR sR

1957+ done (RunLeft sL bR) = (,bR) <$> doneL sL

1958+ done (RunRight bL sR) = (bL,) <$> doneR sR

19861959

19871960-- | Similar to 'unzipWithM' but terminates when the first fold terminates.

19881961--

@@ -2037,10 +2010,17 @@ unzip = unzipWith id

20372010-- Nesting

20382011------------------------------------------------------------------------------

20392012

2040−

2041−{-

2042−-- XXX this would be an application of "many" using a terminating fold.

2013+-- | @concatSequence f t@ applies folds from stream @t@ sequentially and

2014+-- collects the results using the fold @f@.

20432015--

2016+-- /Unimplemented/

2017+--

2018+{-# INLINE concatSequence #-}

2019+concatSequence ::

2020+ -- IsStream t =>

2021+ Fold m b c -> t (Fold m a b) -> Fold m a c

2022+concatSequence _f _p = undefined

2023+

20442024-- | Group the input stream into groups of elements between @low@ and @high@.

20452025-- Collection starts in chunks of @low@ and then keeps doubling until we reach

20462026-- @high@. Each chunk is folded using the provided fold function.

@@ -2049,16 +2029,14 @@ unzip = unzipWith id

20492029-- size to a stream of arrays and we want to minimize the number of

20502030-- allocations.

20512031--

2052−-- @

2032+-- NOTE: this would be an application of "many" using a terminating fold.

20532033--

2054−-- XXX we should be able to implement it with parsers/terminating folds.

2034+-- /Unimplemented/

20552035--

2056−{-# INLINE lchunksInRange #-}

2057−lchunksInRange :: Monad m

2058− => Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c

2059−lchunksInRange low high (Fold step1 initial1 extract1)

2060− (Fold step2 initial2 extract2) = undefined

2061−-}

2036+{-# INLINE chunksBetween #-}

2037+chunksBetween :: -- Monad m =>

2038+ Int -> Int -> Fold m a b -> Fold m b c -> Fold m a c

2039+chunksBetween _low _high _f1 _f2 = undefined

20622040

20632041------------------------------------------------------------------------------

20642042-- Fold to a Parallel SVar

src/Streamly/Internal/Data/Fold/Types.hs−15

@@ -139,7 +139,6 @@ module Streamly.Internal.Data.Fold.Types

139139 , lfilterM

140140 , lcatMaybes

141141 , ltake

142− , takeSepBy

143142 , takeByTime

144143

145144 -- * Distributing

@@ -691,20 +690,6 @@ ltake n (Fold fstep finitial fextract) = Fold step initial extract

691690

692691 extract (Tuple' _ r) = fextract r

693692

694−-- | Takes elements from the input as long as the predicate succeeds.

695−--

696−-- @since 0.7.0

697−{-# INLINE takeSepBy #-}

698−takeSepBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

699−takeSepBy predicate (Fold fstep finitial fextract) = Fold step finitial fextract

700−

701− where

702−

703− step s a =

704− if predicate a

705− then fstep s a

706− else Done <$> fextract s

707−

708693------------------------------------------------------------------------------

709694-- Nesting

710695------------------------------------------------------------------------------

src/Streamly/Internal/Data/Stream/StreamD.hs+1−1

@@ -1522,7 +1522,7 @@ reverse' m =

15221522{-# INLINE_NORMAL splitSuffixWith #-}

15231523splitSuffixWith :: Monad m

15241524 => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b

1525−splitSuffixWith predicate f = foldMany1 (FL.sliceSepWith predicate f)

1525+splitSuffixWith predicate f = foldMany1 (FL.sliceEndWith predicate f)

15261526

15271527{-# INLINE_NORMAL groupsBy #-}

15281528groupsBy :: Monad m

streamly.cabal+1

@@ -681,6 +681,7 @@ test-suite Data.Fold

681681 import: test-options

682682 type: exitcode-stdio-1.0

683683 main-is: Streamly/Test/Data/Fold.hs

684+ other-modules: Streamly.Test.Common

684685

685686test-suite Data.Unfold

686687 import: test-options

test/Streamly/Test/Common.hs+10−2

@@ -10,6 +10,8 @@

1010module Streamly.Test.Common

1111 ( equals

1212 , listEquals

13+ , checkListEqual

14+ , chooseInt

1315 ) where

1416

1517import Control.Monad (when)

@@ -18,8 +20,8 @@ import Data.List ((\\))

1820#if __GLASGOW_HASKELL__ < 808

1921import Data.Semigroup ((<>))

2022#endif

21−import Test.QuickCheck (counterexample)

22−import Test.QuickCheck.Monadic (PropertyM, assert, monitor)

23+import Test.QuickCheck (Property, Gen, choose, counterexample)

24+import Test.QuickCheck.Monadic (PropertyM, assert, monitor, monadicIO)

2325

2426equals

2527 :: (Show a, Monad m)

@@ -51,3 +53,9 @@ listEquals eq stream list = do

5153 <> "\nlist \\\\ stream " <> show (list \\ stream)

5254 )

5355 assert (stream `eq` list)

56+

57+checkListEqual :: (Show a, Eq a) => [a] -> [a] -> Property

58+checkListEqual ls_1 ls_2 = monadicIO (listEquals (==) ls_1 ls_2)

59+

60+chooseInt :: (Int, Int) -> Gen Int

61+chooseInt = choose

test/Streamly/Test/Data/Fold.hs+41−1

@@ -1,5 +1,6 @@

11module Main (main) where

3+import Streamly.Test.Common (checkListEqual)

34import Prelude hiding (maximum, minimum, elem, notElem, null, product, sum, head, last)

45import qualified Streamly.Internal.Data.Fold as F

56import qualified Streamly.Prelude as S

@@ -7,7 +8,8 @@ import qualified Streamly.Data.Fold as FL

89import Test.Hspec as H

910import Test.Hspec.QuickCheck

10−import Test.QuickCheck (Property, forAll, Gen, vectorOf, arbitrary, choose)

11+import Test.QuickCheck

12+ (Property, property, forAll, Gen, vectorOf, arbitrary, choose, listOf)

1113import Test.QuickCheck.Monadic (monadicIO, assert, run)

1214

1315maxStreamLen :: Int

@@ -19,6 +21,15 @@ intMin = minBound

1921intMax :: Int

2022intMax = maxBound

2123

24+min_value :: Int

25+min_value = 0

26+

27+max_value :: Int

28+max_value = 10000

29+

30+chooseInt :: (Int, Int) -> Gen Int

31+chooseInt = choose

32+

2233{-# INLINE maxStreamLen #-}

2334{-# INLINE intMin #-}

2435{-# INLINE intMax #-}

@@ -192,6 +203,32 @@ and ls = S.fold FL.and (S.fromList ls) `shouldReturn` Prelude.and ls

192203or :: [Bool] -> Expectation

193204or ls = S.fold FL.or (S.fromList ls) `shouldReturn` Prelude.or ls

194205

206+ltake :: [Int] -> Property

207+ltake ls =

208+ forAll (chooseInt (-1, Prelude.length ls + 2)) $ \n ->

209+ S.fold (F.ltake n FL.toList) (S.fromList ls)

210+ `shouldReturn` Prelude.take n ls

211+

212+sliceSepBy :: Property

213+sliceSepBy =

214+ forAll (listOf (chooseInt (0, 1))) $ \ls ->

215+ let p = (== 1)

216+ f = F.sliceSepBy p FL.toList

217+ ys = Prelude.takeWhile (not . p) ls

218+ in case S.fold f (S.fromList ls) of

219+ Right xs -> checkListEqual xs ys

220+ Left _ -> property False

221+

222+sliceSepByMax :: Property

223+sliceSepByMax =

224+ forAll (chooseInt (min_value, max_value)) $ \n ->

225+ forAll (listOf (chooseInt (0, 1))) $ \ls ->

226+ let p = (== 1)

227+ f = F.sliceSepByMax p n FL.toList

228+ ys = Prelude.take n (Prelude.takeWhile (not . p) ls)

229+ in case S.fold f (S.fromList ls) of

230+ Right xs -> checkListEqual xs ys

231+ Left _ -> property False

195232

196233main :: IO ()

197234main = hspec $

@@ -219,3 +256,6 @@ main = hspec $

219256 prop "And" Main.and

220257 prop "Or" Main.or

221258 prop "mapMaybe" mapMaybe

259+ prop "ltake" ltake

260+ prop "sliceSepBy" sliceSepBy

261+ prop "sliceSepByMax" sliceSepByMax