bdedb69 · streamly · git.iko.soy

git.iko.soy/streamly

Make the initial value of Fold a Step type

Review changes in this commit were done by Harendra Kumar (@harendra-kumar)

commitbdedb6949b10c221f1d3fbfc6742e40ad1168672 authoradithyaov <adithya@composewell.com> dateSun 6 Dec 2020, 11:38 (6 years ago) parent86745a7

26 files changed+1197−757

compare with master

unifiedsplit

src/Streamly/Internal/Data/Array.hs+2−2

@@ -111,7 +111,7 @@ writeN limit = Fold step initial extract

111111 where

112112 initial = do

113113 marr <- liftIO $ newArray limit bottomElement

114− return (Tuple' marr 0)

114+ return $ FL.Partial (Tuple' marr 0)

115115 step st@(Tuple' marr i) x

116116 | i == limit = fmap FL.Done $ extract st

117117 | otherwise = do

@@ -125,7 +125,7 @@ write = Fold step initial extract

125125 where

126126 initial = do

127127 marr <- liftIO $ newArray 0 bottomElement

128− return (Tuple3' marr 0 0)

128+ return $ FL.Partial (Tuple3' marr 0 0)

129129 step (Tuple3' marr i capacity) x

130130 | i == capacity =

131131 let newCapacity = max (capacity * 2) 1

src/Streamly/Internal/Data/Array/Prim/MutTypesInclude.hs+8−7

@@ -6,6 +6,7 @@

77import Control.Monad (when)

88import Control.Monad.IO.Class (MonadIO(..))

9+import Data.Bifunctor (first)

910import Data.Primitive.Types (Prim(..), sizeOf)

1011import Streamly.Internal.Data.Fold.Types (Fold(..))

1112import Streamly.Internal.Data.SVar (adaptState)

@@ -168,7 +169,7 @@ writeN limit = Fold step initial extract

168169

169170 initial = do

170171 marr <- newArray limit

171− return $ Tuple' marr 0

172+ return $ FL.Partial $ Tuple' marr 0

172173

173174 extract (Tuple' marr len) = shrinkArray marr len >> return marr

174175

@@ -367,8 +368,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

367368 ++ "packArraysChunksOf: the size of arrays ["

368369 ++ show n

369370 ++ "] must be a natural number"

370− r1 <- initial1

371− return (Tuple' Nothing r1)

371+ res <- initial1

372+ return $ first (Tuple' Nothing) res

372373

373374 extract (Tuple' Nothing r1) = extract1 r1

374375 extract (Tuple' (Just buf) r1) = do

@@ -386,8 +387,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

386387 FL.Done () -> return $ FL.Done ()

387388 FL.Partial s -> do

388389 extract1 s

389− r1' <- initial1

390− return $ FL.Partial $ Tuple' Nothing r1'

390+ res <- initial1

391+ return $ first (Tuple' Nothing) res

391392 else return $ FL.Partial $ Tuple' (Just arr) r1

392393 step (Tuple' (Just buf) r1) arr = do

393394 blen <- byteLength buf

@@ -401,6 +402,6 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

401402 FL.Done () -> return $ FL.Done ()

402403 FL.Partial s -> do

403404 extract1 s

404− r1' <- initial1

405− return $ FL.Partial $ Tuple' Nothing r1'

405+ res <- initial1

406+ return $ first (Tuple' Nothing) res

406407 else return $ FL.Partial $ Tuple' (Just buf') r1

src/Streamly/Internal/Data/Array/Prim/Pinned/Mut/Types.hs+1−1

@@ -143,7 +143,7 @@ writeNAligned align limit = Fold step initial extract

143143

144144 initial = do

145145 marr <- newAlignedArray limit align

146− return $ Tuple' marr 0

146+ return $ FL.Partial $ Tuple' marr 0

147147

148148 extract (Tuple' marr len) = shrinkArray marr len >> return marr

149149

src/Streamly/Internal/Data/Array/Prim/TypesInclude.hs+7−6

@@ -8,6 +8,7 @@ import Control.DeepSeq (NFData(..))

88import Control.Monad (when)

99import Control.Monad.IO.Class (MonadIO(..))

1010import Control.Monad.Primitive (PrimMonad(..), primitive_)

11+import Data.Bifunctor (first)

1112import Data.Primitive.Types (Prim(..), sizeOf)

1213#if __GLASGOW_HASKELL__ < 808

1314import Data.Semigroup (Semigroup(..))

@@ -603,8 +604,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

603604 -- XXX we can pass the module string from the higher level API

604605 error $ "Streamly.Internal.Data.Array.Storable.Foreign.Types.packArraysChunksOf: the size of "

605606 ++ "arrays [" ++ show n ++ "] must be a natural number"

606− r1 <- initial1

607− return (Tuple3' Nothing' 0 r1)

607+ res <- initial1

608+ return $ first (Tuple3' Nothing' 0) res

608609

609610 extract (Tuple3' Nothing' _ r1) = extract1 r1

610611 extract (Tuple3' (Just' buf) boff r1) = do

@@ -622,8 +623,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

622623 FL.Done _ -> return $ FL.Done ()

623624 FL.Partial s -> do

624625 extract1 s

625− r1' <- initial1

626− return $ FL.Partial $ Tuple3' Nothing' 0 r1'

626+ res <- initial1

627+ return $ first (Tuple3' Nothing' 0) res

627628 else do

628629 buf <- MA.newArray nElem

629630 noff <- spliceInto buf 0 arr

@@ -640,8 +641,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

640641 FL.Done _ -> return $ FL.Done ()

641642 FL.Partial s -> do

642643 extract1 s

643− r1' <- initial1

644− return $ FL.Partial $ Tuple3' Nothing' 0 r1'

644+ res <- initial1

645+ return $ first (Tuple3' Nothing' 0) res

645646 else return $ FL.Partial $ Tuple3' (Just' buf) noff r1

646647

647648data SplitState s arr

src/Streamly/Internal/Data/Array/Storable/Foreign.hs+3−1

@@ -319,7 +319,9 @@ lastN n

319319 step (Tuple3' rb rh i) a = do

320320 rh1 <- liftIO $ RB.unsafeInsert rb rh a

321321 return $ FL.Partial $ Tuple3' rb rh1 (i + 1)

322− initial = fmap (\(a, b) -> Tuple3' a b (0 :: Int)) $ liftIO $ RB.new n

322+ initial =

323+ let f (a, b) = FL.Partial $ Tuple3' a b (0 :: Int)

324+ in fmap f $ liftIO $ RB.new n

323325 done (Tuple3' rb rh i) = do

324326 arr <- liftIO $ MA.newArray n

325327 foldFunc i rh snoc' arr rb

src/Streamly/Internal/Data/Array/Storable/Foreign/Mut/Types.hs+10−8

@@ -93,6 +93,7 @@ import Control.Exception (assert)

9393import Control.DeepSeq (NFData(..))

9494import Control.Monad (when, void)

9595import Control.Monad.IO.Class (MonadIO(..))

96+import Data.Bifunctor (first)

9697import Data.Functor.Identity (runIdentity)

9798#if __GLASGOW_HASKELL__ < 808

9899import Data.Semigroup (Semigroup(..))

@@ -674,8 +675,9 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

674675 -- XXX we can pass the module string from the higher level API

675676 error $ "Streamly.Internal.Data.Array.Storable.Foreign.Mut.Types.packArraysChunksOf: the size of "

676677 ++ "arrays [" ++ show n ++ "] must be a natural number"

677− r1 <- initial1

678− return (Tuple' Nothing r1)

678+

679+ r <- initial1

680+ return $ first (Tuple' Nothing) r

679681

680682 extract (Tuple' Nothing r1) = extract1 r1

681683 extract (Tuple' (Just buf) r1) = do

@@ -693,8 +695,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

693695 FL.Done _ -> return $ FL.Done ()

694696 FL.Partial s -> do

695697 extract1 s

696− r1' <- initial1

697− return $ FL.Partial $ Tuple' Nothing r1'

698+ res <- initial1

699+ return $ first (Tuple' Nothing) res

698700 else return $ FL.Partial $ Tuple' (Just arr) r1

699701

700702 step (Tuple' (Just buf) r1) arr = do

@@ -712,8 +714,8 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

712714 FL.Done _ -> return $ FL.Done ()

713715 FL.Partial s -> do

714716 extract1 s

715− r1' <- initial1

716− return $ FL.Partial $ Tuple' Nothing r1'

717+ res <- initial1

718+ return $ first (Tuple' Nothing) res

717719 else return $ FL.Partial $ Tuple' (Just buf'') r1

718720

719721#if !defined(mingw32_HOST_OS)

@@ -1090,7 +1092,7 @@ writeNAllocWith alloc n = Fold step initial extract

10901092

10911093 where

10921094

1093− initial = liftIO $ alloc (max n 0)

1095+ initial = FL.Partial <$> liftIO (alloc (max n 0))

10941096 step arr@(Array _ end bound) _ | end == bound = return $ FL.Done arr

10951097 step (Array start end bound) x = do

10961098 liftIO $ poke end x

@@ -1150,7 +1152,7 @@ writeNUnsafe n = Fold step initial extract

11501152

11511153 initial = do

11521154 (Array start end _) <- liftIO $ newArray (max n 0)

1153− return $ ArrayUnsafe start end

1155+ return $ FL.Partial $ ArrayUnsafe start end

11541156

11551157 step (ArrayUnsafe start end) x = do

11561158 liftIO $ poke end x

src/Streamly/Internal/Data/Either/Strict.hs+29

@@ -19,8 +19,37 @@

1919--

2020module Streamly.Internal.Data.Either.Strict

2121 ( Either' (..)

22+ , isLeft'

23+ , isRight'

24+ , fromLeft'

25+ , fromRight'

2226 )

2327where

2428

2529-- | A strict 'Either'

2630data Either' a b = Left' !a | Right' !b deriving Show

31+

32+-- | Return 'True' if the given value is a Left', 'False' otherwise.

33+{-# INLINABLE isLeft' #-}

34+isLeft' :: Either' a b -> Bool

35+isLeft' (Left' _) = True

36+isLeft' (Right' _) = False

37+

38+-- | Return 'True' if the given value is a Right', 'False' otherwise.

39+{-# INLINABLE isRight' #-}

40+isRight' :: Either' a b -> Bool

41+isRight' (Left' _) = False

42+isRight' (Right' _) = True

43+

44+-- XXX This is partial. We can use a default value instead.

45+-- | Return the contents of a Left'-value or errors out.

46+{-# INLINABLE fromLeft' #-}

47+fromLeft' :: Either' a b -> a

48+fromLeft' (Left' a) = a

49+fromLeft' _ = error "fromLeft' expecting a Left'-value"

50+

51+-- | Return the contents of a Right'-value or errors out.

52+{-# INLINABLE fromRight' #-}

53+fromRight' :: Either' a b -> b

54+fromRight' (Right' b) = b

55+fromRight' _ = error "fromRight' expecting a Right'-value"

src/Streamly/Internal/Data/Fold.hs+367−259

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

6666 -- ** Collectors

6767 , toList

6868 , toListRevF -- experimental

69+ -- $toListRevF

6970 , toParallelSVar

7071

7172 -- * Terminating Folds

@@ -224,6 +225,7 @@ where

224225

225226import Control.Monad (void, join)

226227import Control.Monad.IO.Class (MonadIO(..))

228+import Data.Bifunctor (first)

227229import Data.Functor.Identity (Identity(..))

228230import Data.Int (Int64)

229231import Data.Map.Strict (Map)

@@ -235,6 +237,8 @@ import Streamly.Internal.Data.Either.Strict (Either'(..))

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

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

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

240+import Streamly.Internal.Data.Either.Strict

241+ (fromLeft', fromRight', isLeft', isRight')

238242

239243import qualified Data.Map.Strict as Map

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

@@ -265,7 +269,7 @@ mkAccum :: Monad m => (s -> a -> s) -> s -> (s -> b) -> Fold m a b

265269mkAccum step initial extract =

266270 Fold

267271 (\s a -> return $ Partial $ step s a)

268− (return initial)

272+ (return (Partial initial))

269273 (return . extract)

270274

271275-- | Similar to 'mkAccum' but the final state extracted is identical to the

@@ -284,7 +288,8 @@ mkAccum_ step initial = mkAccum step initial id

284288--

285289{-# INLINE mkAccumM #-}

286290mkAccumM :: Functor m => (s -> a -> m s) -> m s -> (s -> m b) -> Fold m a b

287−mkAccumM step = Fold (\s a -> Partial <$> step s a)

291+mkAccumM step initial =

292+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial)

288293

289294-- | Similar to 'mkAccumM' but the final state extracted is identical to the

290295-- intermediate state.

@@ -301,7 +306,7 @@ mkAccumM_ step initial = mkAccumM step initial return

301306-- /Internal/

302307--

303308{-# INLINE mkFold #-}

304−mkFold :: Monad m => (s -> a -> Step s b) -> s -> (s -> b) -> Fold m a b

309+mkFold :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b

305310mkFold step initial extract =

306311 Fold (\s a -> return $ step s a) (return initial) (return . extract)

307312

@@ -311,7 +316,7 @@ mkFold step initial extract =

311316-- /Internal/

312317--

313318{-# INLINE mkFold_ #-}

314−mkFold_ :: Monad m => (b -> a -> Step b b) -> b -> Fold m a b

319+mkFold_ :: Monad m => (b -> a -> Step b b) -> Step b b -> Fold m a b

315320mkFold_ step initial = mkFold step initial id

316321

317322-- | Make a terminating fold with an effectful step function and initial state,

@@ -324,7 +329,7 @@ mkFold_ step initial = mkFold step initial id

324329-- /Internal/

325330--

326331{-# INLINE mkFoldM #-}

327−mkFoldM :: (s -> a -> m (Step s b)) -> m s -> (s -> m b) -> Fold m a b

332+mkFoldM :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b

328333mkFoldM = Fold

329334

330335-- | Similar to 'mkFoldM' but the final state extracted is identical to the

@@ -333,8 +338,8 @@ mkFoldM = Fold

333338-- /Internal/

334339--

335340{-# INLINE mkFoldM_ #-}

336−mkFoldM_ :: Monad m => (b -> a -> m (Step b b)) -> m b -> Fold m a b

337−mkFoldM_ step initial = Fold step initial return

341+mkFoldM_ :: Monad m => (b -> a -> m (Step b b)) -> m (Step b b) -> Fold m a b

342+mkFoldM_ step initial = mkFoldM step initial return

338343

339344------------------------------------------------------------------------------

340345-- hoist

@@ -364,16 +369,19 @@ generally = hoist (return . runIdentity)

364369-- @since 0.7.0

365370{-# INLINE sequence #-}

366371sequence :: Monad m => Fold m a (m b) -> Fold m a b

367−sequence (Fold step initial extract) = Fold step' initial extract'

372+sequence (Fold step initial extract) = Fold step' initial1 extract'

368373

369374 where

370375

371− step' s a = do

372− res <- step s a

376+ eval res =

373377 case res of

374378 Partial x -> return $ Partial x

375379 Done b -> Done <$> b

376380

381+ initial1 = initial >>= eval

382+

383+ step' s a = step s a >>= eval

384+

377385 extract' = join . extract

378386

379387-- | Map a monadic function on the output of a fold.

@@ -413,7 +421,7 @@ transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =

413421

414422 where

415423

416− initial = Tuple' pinitial <$> finitial

424+ initial = first (Tuple' pinitial) <$> finitial

417425

418426 step (Tuple' ps fs) x = do

419427 r <- pstep1 ps x

@@ -452,12 +460,12 @@ transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =

452460-- from the 'Foldable', the result is 'None' for empty containers.

453461{-# INLINABLE _Fold1 #-}

454462_Fold1 :: Monad m => (a -> a -> a) -> Fold m a (Maybe a)

455−_Fold1 step = Fold step_ (return Nothing') (return . toMaybe)

463+_Fold1 step = mkAccum step_ Nothing' toMaybe

456464

457465 where

458466

459− step_ Nothing' a = return $ Partial $ Just' a

460− step_ (Just' x) a = return $ Partial $ Just' $ step x a

467+ step_ Nothing' a = Just' a

468+ step_ (Just' x) a = Just' $ step x a

461469

462470------------------------------------------------------------------------------

463471-- Left folds

@@ -475,15 +483,7 @@ _Fold1 step = Fold step_ (return Nothing') (return . toMaybe)

475483-- @since 0.7.0

476484{-# INLINABLE drain #-}

477485drain :: Monad m => Fold m a ()

478−drain = Fold step begin done

479−

480− where

481−

482− begin = return ()

483−

484− step _ _ = return $ FL.Partial ()

485−

486− done = return

486+drain = mkAccum_ (\_ _ -> ()) ()

487487

488488-- |

489489-- > drainBy f = lmapM f drain

@@ -495,7 +495,7 @@ drain = Fold step begin done

495495-- @since 0.7.0

496496{-# INLINABLE drainBy #-}

497497drainBy :: Monad m => (a -> m b) -> Fold m a ()

498−drainBy f = Fold (const (fmap FL.Partial . void . f)) (return ()) return

498+drainBy f = lmapM f drain

499499

500500{-# INLINABLE drainBy2 #-}

501501drainBy2 :: Monad m => (a -> m b) -> Fold2 m c a ()

@@ -521,7 +521,7 @@ last = _Fold1 (\_ x -> x)

521521-- @since 0.7.0

522522{-# INLINE genericLength #-}

523523genericLength :: (Monad m, Num b) => Fold m a b

524−genericLength = Fold (\n _ -> return $ Partial $ n + 1) (return 0) return

524+genericLength = mkAccum_ (\n _ -> n + 1) 0

525525

526526-- | Determine the length of the input stream.

527527--

@@ -541,7 +541,7 @@ length = genericLength

541541-- @since 0.7.0

542542{-# INLINE sum #-}

543543sum :: (Monad m, Num a) => Fold m a a

544−sum = Fold (\x a -> return $ Partial $ x + a) (return 0) return

544+sum = mkAccum_ (+) 0

545545

546546-- | Determine the product of all elements of a stream of numbers. Returns

547547-- multiplicative identity (@1@) when the stream is empty. The fold terminates

@@ -553,15 +553,14 @@ sum = Fold (\x a -> return $ Partial $ x + a) (return 0) return

553553-- /Since 0.8.0 (Added 'Eq' constraint)/

554554{-# INLINE product #-}

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

556−product = Fold step (return 1) return

556+product = mkFold_ step (Partial 1)

557557

558558 where

559559

560560 step x a =

561− return

562− $ if a == 0

563− then Done 0

564− else Partial $ x * a

561+ if a == 0

562+ then Done 0

563+ else Partial $ x * a

565564

566565------------------------------------------------------------------------------

567566-- To Summary (Maybe)

@@ -634,16 +633,15 @@ minimum = _Fold1 min

634633-- @since 0.7.0

635634{-# INLINABLE mean #-}

636635mean :: (Monad m, Fractional a) => Fold m a a

637−mean = Fold step (return begin) (return . done)

636+mean = mkAccum step begin done

638637

639638 where

640639

641640 begin = Tuple' 0 0

642641

643642 step (Tuple' x n) y =

644− return

645− $ let n' = n + 1

646− in Partial $ Tuple' (x + (y - x) / n') n'

643+ let n1 = n + 1

644+ in Tuple' (x + (y - x) / n1) n1

647645

648646 done (Tuple' x _) = x

649647

@@ -653,13 +651,13 @@ mean = Fold step (return begin) (return . done)

653651-- @since 0.7.0

654652{-# INLINABLE variance #-}

655653variance :: (Monad m, Fractional a) => Fold m a a

656−variance = Fold step (return begin) (return . done)

654+variance = mkAccum step begin done

657655

658656 where

659657

660658 begin = Tuple3' 0 0 0

661659

662− step (Tuple3' n mean_ m2) x = return $ Partial $ Tuple3' n' mean' m2'

660+ step (Tuple3' n mean_ m2) x = Tuple3' n' mean' m2'

663661

664662 where

665663

@@ -692,17 +690,13 @@ stdDev = sqrt variance

692690-- @since 0.7.0

693691{-# INLINABLE rollingHashWithSalt #-}

694692rollingHashWithSalt :: (Monad m, Enum a) => Int64 -> Fold m a Int64

695−rollingHashWithSalt salt = Fold step initial extract

693+rollingHashWithSalt = mkAccum_ step

696694

697695 where

698696

699697 k = 2891336453 :: Int64

700698

701− initial = return salt

702−

703− step cksum a = return $ Partial $ cksum * k + fromIntegral (fromEnum a)

704−

705− extract = return

699+ step cksum a = cksum * k + fromIntegral (fromEnum a)

706700

707701-- | A default salt used in the implementation of 'rollingHash'.

708702{-# INLINE defaultSalt #-}

@@ -738,7 +732,7 @@ rollingHashFirstN n = ltake n rollingHash

738732--

739733{-# INLINE sconcat #-}

740734sconcat :: (Monad m, Semigroup a) => a -> Fold m a a

741−sconcat i = Fold (\x a -> return $ Partial $ x <> a) (return i) return

735+sconcat = mkAccum_ (<>)

742736

743737-- | Fold an input stream consisting of monoidal elements using 'mappend'

744738-- and 'mempty'.

@@ -783,17 +777,13 @@ foldMap f = lmap f mconcat

783777-- @since 0.7.0

784778{-# INLINABLE foldMapM #-}

785779foldMapM :: (Monad m, Monoid b) => (a -> m b) -> Fold m a b

786−foldMapM act = Fold step begin done

780+foldMapM act = mkAccumM_ step (pure mempty)

787781

788782 where

789783

790− done = return

791−

792− begin = return mempty

793−

794784 step m a = do

795785 m' <- act a

796− return $! Partial $! mappend m m'

786+ return $! mappend m m'

797787

798788------------------------------------------------------------------------------

799789-- To Containers

@@ -810,9 +800,23 @@ foldMapM act = Fold step begin done

810800-- id . (x1 :) . (x2 :) . (x3 :) . ... . (xn :) $ []

811801{-# INLINABLE toList #-}

812802toList :: Monad m => Fold m a [a]

813−toList = Fold (\f x -> return $ Partial $ f . (x :))

814− (return id)

815− (return . ($ []))

803+toList = mkAccum (\f x -> f . (x :)) id ($ [])

804+

805+-- $toListRevF

806+-- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is

807+-- exactly the same as reversing the list after 'toListRevF'.

808+

809+-- | Buffers the input stream to a list in the reverse order of the input.

810+--

811+-- /Warning!/ working on large lists accumulated as buffers in memory could be

812+-- very inefficient, consider using "Streamly.Array" instead.

813+--

814+-- @since 0.7.0

815+

816+-- xn : ... : x2 : x1 : []

817+{-# INLINABLE toListRevF #-}

818+toListRevF :: Monad m => Fold m a [a]

819+toListRevF = mkAccum_ (flip (:)) []

816820

817821------------------------------------------------------------------------------

818822-- Partial Folds

@@ -833,15 +837,14 @@ drainN n = ltake n drain

833837-- @since 0.7.0

834838{-# INLINABLE genericIndex #-}

835839genericIndex :: (Integral i, Monad m) => i -> Fold m a (Maybe a)

836−genericIndex i = Fold step (return 0) (const (return Nothing))

840+genericIndex i = mkFold step (Partial 0) (const Nothing)

837841

838842 where

839843

840844 step j a =

841− return

842− $ if i == j

843− then Done $ Just a

844− else Partial (j + 1)

845+ if i == j

846+ then Done $ Just a

847+ else Partial (j + 1)

845848

846849-- | Lookup the element at the given index.

847850--

@@ -869,15 +872,14 @@ head = _Fold1 const

869872-- @since 0.7.0

870873{-# INLINABLE find #-}

871874find :: Monad m => (a -> Bool) -> Fold m a (Maybe a)

872−find predicate = Fold step (return ()) (const (return Nothing))

875+find predicate = mkFold step (Partial ()) (const Nothing)

873876

874877 where

875878

876879 step () a =

877− return

878− $ if predicate a

879− then Done (Just a)

880− else Partial ()

880+ if predicate a

881+ then Done (Just a)

882+ else Partial ()

881883

882884-- | In a stream of (key-value) pairs @(a, b)@, return the value @b@ of the

883885-- first pair where the key equals the given value @a@.

@@ -887,30 +889,28 @@ find predicate = Fold step (return ()) (const (return Nothing))

887889-- @since 0.7.0

888890{-# INLINABLE lookup #-}

889891lookup :: (Eq a, Monad m) => a -> Fold m (a,b) (Maybe b)

890−lookup a0 = Fold step (return ()) (const (return Nothing))

892+lookup a0 = mkFold step (Partial ()) (const Nothing)

891893

892894 where

893895

894896 step () (a, b) =

895− return

896− $ if a == a0

897− then Done $ Just b

898− else Partial ()

897+ if a == a0

898+ then Done $ Just b

899+ else Partial ()

899900

900901-- | Returns the first index that satisfies the given predicate.

901902--

902903-- @since 0.7.0

903904{-# INLINABLE findIndex #-}

904905findIndex :: Monad m => (a -> Bool) -> Fold m a (Maybe Int)

905−findIndex predicate = Fold step (return 0) (const (return Nothing))

906+findIndex predicate = mkFold step (Partial 0) (const Nothing)

906907

907908 where

908909

909910 step i a =

910− return

911− $ if predicate a

912− then Done $ Just i

913− else Partial (i + 1)

911+ if predicate a

912+ then Done $ Just i

913+ else Partial (i + 1)

914914

915915-- | Returns the first index where a given value is found in the stream.

916916--

@@ -932,7 +932,7 @@ elemIndex a = findIndex (a ==)

932932-- @since 0.7.0

933933{-# INLINABLE null #-}

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

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

935+null = mkFold (\() _ -> Done False) (Partial ()) (const True)

936936

937937--

938938-- > any p = lmap p or

@@ -946,17 +946,16 @@ null = Fold (\() _ -> return $ Done False) (return ()) (\() -> return True)

946946-- @since 0.7.0

947947{-# INLINE any #-}

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

949−any predicate = Fold step initial return

949+any predicate = mkFold_ step initial

950950

951951 where

952952

953− initial = return False

953+ initial = Partial False

954954

955955 step _ a =

956− return

957− $ if predicate a

958− then Done True

959− else Partial False

956+ if predicate a

957+ then Done True

958+ else Partial False

960959

961960-- | Return 'True' if the given element is present in the stream.

962961--

@@ -979,17 +978,16 @@ elem a = any (a ==)

979978-- @since 0.7.0

980979{-# INLINABLE all #-}

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

982−all predicate = Fold step initial return

981+all predicate = mkFold_ step initial

983982

984983 where

985984

986− initial = return True

985+ initial = Partial True

987986

988987 step _ a =

989− return

990− $ if predicate a

991− then Partial True

992− else Done False

988+ if predicate a

989+ then Partial True

990+ else Done False

993991

994992-- | Returns 'True' if the given element is not present in the stream.

995993--

@@ -1199,18 +1197,18 @@ sliceEndWith predicate (Fold fstep finitial fextract) =

11991197

12001198 initial = finitial

12011199

1202− step s a =

1200+ step s a = do

1201+ res <- fstep s a

12031202 if not (predicate a)

1204− then fstep s a

1203+ then return res

12051204 else do

1206− res <- fstep s a

12071205 case res of

1208− Partial sres -> Done <$> fextract sres

1209− Done bres -> return $ Done bres

1206+ Partial s1 -> Done <$> fextract s1

1207+ Done b -> return $ Done b

12101208

12111209data SpanByState a bl fl fr

1212− = SpanByLeft0 !fl !fr

1213− | SpanByLeft !a !fl !fr

1210+ = SpanByLeft0 !fl

1211+ | SpanByLeft !a !fl

12141212 | SpanByRight !bl !fr

12151213

12161214-- | Break the input stream into two groups, the first group takes the input as

@@ -1231,31 +1229,50 @@ spanBy cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

12311229

12321230 where

12331231

1234− initial = SpanByLeft0 <$> initialL <*> initialR

1232+ initial = do

1233+ resL <- initialL

1234+ case resL of

1235+ Partial fl -> return $ Partial $ SpanByLeft0 fl

1236+ Done bl -> do

1237+ resR <- initialR

1238+ return

1239+ $ case resR of

1240+ Partial fr -> Partial $ SpanByRight bl fr

1241+ Done br -> Done (bl, br)

12351242

1236− step (SpanByLeft0 fl fr) input = do

1243+ step (SpanByLeft0 fl) input = do

12371244 sfl <- stepL fl input

1238− return

1239− $ Partial

1240− $ case sfl of

1241− Partial fl1 -> SpanByLeft input fl1 fr

1242− Done bl -> SpanByRight bl fr

1243− step (SpanByLeft frst fl fr) input =

1245+ case sfl of

1246+ Partial fl1 -> return $ Partial $ SpanByLeft input fl1

1247+ Done bl -> do

1248+ resR <- initialR

1249+ return

1250+ $ case resR of

1251+ Partial fr -> Partial $ SpanByRight bl fr

1252+ Done br -> Done (bl, br)

1253+ step (SpanByLeft frst fl) input =

12441254 if cmp frst input

12451255 then do

12461256 sfl <- stepL fl input

1247− return

1248− $ Partial

1249− $ case sfl of

1250− Partial fl1 -> SpanByLeft frst fl1 fr

1251− Done bl -> SpanByRight bl fr

1257+ case sfl of

1258+ Partial fl1 -> return $ Partial $ SpanByLeft frst fl1

1259+ Done bl -> do

1260+ resR <- initialR

1261+ return

1262+ $ case resR of

1263+ Partial fr -> Partial $ SpanByRight bl fr

1264+ Done br -> Done (bl, br)

12521265 else do

12531266 bl <- extractL fl

1254− sfr <- stepR fr input

1255− return

1256− $ case sfr of

1257− Partial fr1 -> Partial $ SpanByRight bl fr1

1258− Done br -> Done (bl, br)

1267+ resR <- initialR

1268+ case resR of

1269+ Partial fr -> do

1270+ sfr <- stepR fr input

1271+ return

1272+ $ case sfr of

1273+ Partial fr1 -> Partial $ SpanByRight bl fr1

1274+ Done br -> Done (bl, br)

1275+ Done br -> return $ Done (bl, br)

12591276 step (SpanByRight bl fr) input = do

12601277 sfr <- stepR fr input

12611278 return

@@ -1263,12 +1280,22 @@ spanBy cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

12631280 Partial fr1 -> Partial $ SpanByRight bl fr1

12641281 Done br -> Done (bl, br)

12651282

1266− extract (SpanByLeft0 fl fr) = (,) <$> extractL fl <*> extractR fr

1267− extract (SpanByLeft _ fl fr) = (,) <$> extractL fl <*> extractR fr

1283+ extract (SpanByLeft0 fl) = do

1284+ bl <- extractL fl

1285+ resR <- initialR

1286+ case resR of

1287+ Partial fr -> (bl, ) <$> extractR fr

1288+ Done br -> return (bl, br)

1289+ extract (SpanByLeft _ fl) = do

1290+ bl <- extractL fl

1291+ resR <- initialR

1292+ case resR of

1293+ Partial fr -> (bl, ) <$> extractR fr

1294+ Done br -> return (bl, br)

12681295 extract (SpanByRight bl fr) = (bl, ) <$> extractR fr

12691296

12701297data SpanState bl fl fr

1271− = SpanLeft !fl !fr

1298+ = SpanLeft !fl

12721299 | SpanRight !bl !fr

12731300

12741301-- | @span p f1 f2@ composes folds @f1@ and @f2@ such that @f1@ consumes the

@@ -1302,24 +1329,40 @@ span p (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

13021329

13031330 where

13041331

1305− initial = SpanLeft <$> initialL <*> initialR

1332+ initial = do

1333+ resL <- initialL

1334+ case resL of

1335+ Partial fl -> return $ Partial $ SpanLeft fl

1336+ Done bl -> do

1337+ resR <- initialR

1338+ return

1339+ $ case resR of

1340+ Partial fr -> Partial $ SpanRight bl fr

1341+ Done br -> Done (bl, br)

13061342

1307− step (SpanLeft fl fr) input =

1343+ step (SpanLeft fl) input =

13081344 if p input

13091345 then do

13101346 sfl <- stepL fl input

1311− return

1312− $ Partial

1313− $ case sfl of

1314− Partial fl1 -> SpanLeft fl1 fr

1315− Done bl -> SpanRight bl fr

1347+ case sfl of

1348+ Partial fl1 -> return $ Partial $ SpanLeft fl1

1349+ Done bl -> do

1350+ resR <- initialR

1351+ return

1352+ $ case resR of

1353+ Partial fr -> Partial $ SpanRight bl fr

1354+ Done br -> Done (bl, br)

13161355 else do

13171356 bl <- extractL fl

1318− sfr <- stepR fr input

1319− return

1320− $ case sfr of

1321− Partial fr1 -> Partial $ SpanRight bl fr1

1322− Done br -> Done (bl, br)

1357+ resR <- initialR

1358+ case resR of

1359+ Partial fr -> do

1360+ sfr <- stepR fr input

1361+ return

1362+ $ case sfr of

1363+ Partial fr1 -> Partial $ SpanRight bl fr1

1364+ Done br -> Done (bl, br)

1365+ Done br -> return $ Done (bl, br)

13231366 step (SpanRight bl fr) input = do

13241367 sfr <- stepR fr input

13251368 return

@@ -1327,7 +1370,12 @@ span p (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

13271370 Partial fr1 -> Partial $ SpanRight bl fr1

13281371 Done br -> Done (bl, br)

13291372

1330− extract (SpanLeft fl fr) = (,) <$> extractL fl <*> extractR fr

1373+ extract (SpanLeft fl) = do

1374+ bl <- extractL fl

1375+ resR <- initialR

1376+ case resR of

1377+ Partial fr -> (bl, ) <$> extractR fr

1378+ Done br -> return (bl, br)

13311379 extract (SpanRight bl fr) = (bl, ) <$> extractR fr

13321380

13331381-- |

@@ -1376,31 +1424,50 @@ spanByRolling cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR)

13761424

13771425 where

13781426

1379− initial = SpanByLeft0 <$> initialL <*> initialR

1427+ initial = do

1428+ resL <- initialL

1429+ case resL of

1430+ Partial fl -> return $ Partial $ SpanByLeft0 fl

1431+ Done bl -> do

1432+ resR <- initialR

1433+ return

1434+ $ case resR of

1435+ Partial fr -> Partial $ SpanByRight bl fr

1436+ Done br -> Done (bl, br)

13801437

1381− step (SpanByLeft0 fl fr) input = do

1438+ step (SpanByLeft0 fl) input = do

13821439 sfl <- stepL fl input

1383− return

1384− $ Partial

1385− $ case sfl of

1386− Partial fl1 -> SpanByLeft input fl1 fr

1387− Done bl -> SpanByRight bl fr

1388− step (SpanByLeft frst fl fr) input =

1389− if cmp frst input

1440+ case sfl of

1441+ Partial fl1 -> return $ Partial $ SpanByLeft input fl1

1442+ Done bl -> do

1443+ resR <- initialR

1444+ return

1445+ $ case resR of

1446+ Partial fr -> Partial $ SpanByRight bl fr

1447+ Done br -> Done (bl, br)

1448+ step (SpanByLeft input0 fl) input =

1449+ if cmp input0 input

13901450 then do

13911451 sfl <- stepL fl input

1392− return

1393− $ Partial

1394− $ case sfl of

1395− Partial fl1 -> SpanByLeft input fl1 fr

1396− Done bl -> SpanByRight bl fr

1452+ case sfl of

1453+ Partial fl1 -> return $ Partial $ SpanByLeft input fl1

1454+ Done bl -> do

1455+ resR <- initialR

1456+ return

1457+ $ case resR of

1458+ Partial fr -> Partial $ SpanByRight bl fr

1459+ Done br -> Done (bl, br)

13971460 else do

13981461 bl <- extractL fl

1399− sfr <- stepR fr input

1400− return

1401− $ case sfr of

1402− Partial fr1 -> Partial $ SpanByRight bl fr1

1403− Done br -> Done (bl, br)

1462+ resR <- initialR

1463+ case resR of

1464+ Partial fr -> do

1465+ sfr <- stepR fr input

1466+ return

1467+ $ case sfr of

1468+ Partial fr1 -> Partial $ SpanByRight bl fr1

1469+ Done br -> Done (bl, br)

1470+ Done br -> return $ Done (bl, br)

14041471 step (SpanByRight bl fr) input = do

14051472 sfr <- stepR fr input

14061473 return

@@ -1408,8 +1475,18 @@ spanByRolling cmp (Fold stepL initialL extractL) (Fold stepR initialR extractR)

14081475 Partial fr1 -> Partial $ SpanByRight bl fr1

14091476 Done br -> Done (bl, br)

14101477

1411− extract (SpanByLeft0 fl fr) = (,) <$> extractL fl <*> extractR fr

1412− extract (SpanByLeft _ fl fr) = (,) <$> extractL fl <*> extractR fr

1478+ extract (SpanByLeft0 fl) = do

1479+ bl <- extractL fl

1480+ resR <- initialR

1481+ case resR of

1482+ Partial fr -> (bl, ) <$> extractR fr

1483+ Done br -> return (bl, br)

1484+ extract (SpanByLeft _ fl) = do

1485+ bl <- extractL fl

1486+ resR <- initialR

1487+ case resR of

1488+ Partial fr -> (bl, ) <$> extractR fr

1489+ Done br -> return (bl, br)

14131490 extract (SpanByRight bl fr) = (bl, ) <$> extractR fr

14141491

14151492------------------------------------------------------------------------------

@@ -1451,17 +1528,6 @@ breakOn pat f m = undefined

14511528tee :: Monad m => Fold m a b -> Fold m a c -> Fold m a (b,c)

14521529tee = teeWith (,)

14531530

1454−{-# INLINE foldNil #-}

1455−foldNil :: Monad m => Fold m a [b]

1456−foldNil = Fold step begin done where

1457− begin = return []

1458− step _ _ = return $ Partial []

1459− done = return

1460−

1461−{-# INLINE foldCons #-}

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

1463−foldCons = teeWith (:)

1464−

14651531-- XXX use "List" instead of "[]"?, use Array for output to scale it to a large

14661532-- number of consumers? For polymorphic case a vector could be helpful. For

14671533-- Storables we can use arrays. Will need separate APIs for those.

@@ -1488,7 +1554,7 @@ foldCons = teeWith (:)

14881554-- @since 0.7.0

14891555{-# INLINE distribute #-}

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

1491−distribute = foldr foldCons foldNil

1557+distribute = foldr (teeWith (:)) (yield [])

14921558

14931559------------------------------------------------------------------------------

14941560-- Partitioning

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

15491615

15501616 where

15511617

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

1618+ begin = do

1619+ resL <- beginL

1620+ resR <- beginR

1621+ return

1622+ $ case resL of

1623+ Partial sL ->

1624+ Partial

1625+ $ case resR of

1626+ Partial sR -> RunBoth sL sR

1627+ Done bR -> RunLeft sL bR

1628+ Done bL ->

1629+ case resR of

1630+ Partial sR -> Partial $ RunRight bL sR

1631+ Done bR -> Done (bL, bR)

15531632

15541633 step (RunBoth sL sR) a = do

15551634 r <- f a

@@ -1707,10 +1786,10 @@ demux :: (Monad m, Ord k)

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

17081787demux = demuxWith id

17091788

1710−data DemuxState s b rMap kvMap =

1711− DemuxMapWithDefault !s !rMap !kvMap

1712− | DemuxMap b !rMap !kvMap

1713− | DemuxDefault s !rMap

1789+data DemuxState s b doneMap runMap =

1790+ DemuxMapAndDefault !s !doneMap !runMap

1791+ | DemuxOnlyMap b !doneMap !runMap

1792+ | DemuxOnlyDefault s !doneMap

17141793

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

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

@@ -1734,87 +1813,102 @@ demuxDefaultWith f kv (Fold dstep dinitial dextract) =

17341813

17351814 where

17361815

1737− initial =

1738− DemuxMapWithDefault

1739− <$> dinitial

1740− <*> return Map.empty

1741− <*> Prelude.mapM initialize kv

1816+ initial = do

1817+ let runInit (Fold step1 initial1 done1) = do

1818+ r <- initial1

1819+ return

1820+ $ case r of

1821+ Partial _ -> Right' (Fold step1 (return r) done1)

1822+ Done b -> Left' b

17421823

1743− step (DemuxMapWithDefault dacc results kvMap) a =

1744− if Map.size kvMap > 0

1745− then do

1746− let (k, a1) = f a

1747− case Map.lookup k kvMap of

1748− Nothing -> do

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

1750− return

1751− $ Partial

1752− $ case res of

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

1758− return

1759− $ case res of

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

1785− return

1786− $ case res of

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

1824+ -- initialize folds in the kv map and separate the ones that are done

1825+ -- from running ones

1826+ kv1 <- Prelude.mapM runInit kv

1827+ let runMap = Map.map fromRight' $ Map.filter isRight' kv1

1828+ doneMap = Map.map fromLeft' $ Map.filter isLeft' kv1

1829+

1830+ -- Run the default fold, and decide the next state based on its result

1831+ dres <- dinitial

1832+ return

1833+ $ case dres of

1834+ Partial s ->

1835+ Partial

1836+ $ if Map.size runMap > 0

1837+ then DemuxMapAndDefault s doneMap runMap

1838+ else DemuxOnlyDefault s doneMap

1839+ Done b ->

1840+ if Map.size runMap > 0

1841+ then Partial $ DemuxOnlyMap b doneMap runMap

1842+ else Done (doneMap, b)

1843+

1844+ {-# INLINE runFold #-}

1845+ runFold fPartial fDone doneMap runMap (Fold step1 initial1 done1) k a1 = do

1846+ resi <- initial1

1847+ case resi of

1848+ Partial st -> do

1849+ res <- step1 st a1

1850+ return $ case res of

1851+ Partial s ->

1852+ let fld = Fold step1 (return $ Partial s) done1

1853+ runMap1 = Map.insert k fld runMap

1854+ in Partial $ fPartial doneMap runMap1

1855+ Done b -> do

1856+ let runMap1 = Map.delete k runMap

1857+ doneMap1 = Map.insert k b doneMap

1858+ if Map.size runMap1 == 0

1859+ then fDone doneMap1

1860+ else Partial $ fPartial doneMap1 runMap1

1861+ Done _ -> error "Bug: demuxDefaultWith: Done fold"

1862+

1863+ step (DemuxMapAndDefault dacc doneMap runMap) a = do

1864+ let (k, a1) = f a

1865+ case Map.lookup k runMap of

1866+ Nothing -> do

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

1868+ return

1869+ $ Partial

1870+ $ case res of

1871+ Partial s -> DemuxMapAndDefault s doneMap runMap

1872+ Done b -> DemuxOnlyMap b doneMap runMap

1873+ Just fld ->

1874+ runFold

1875+ (DemuxMapAndDefault dacc)

1876+ (Partial . DemuxOnlyDefault dacc)

1877+ doneMap runMap fld k a1

1878+

1879+ step (DemuxOnlyMap dval doneMap runMap) a = do

1880+ let (k, a1) = f a

1881+ case Map.lookup k runMap of

1882+ Nothing -> return $ Partial $ DemuxOnlyMap dval doneMap runMap

1883+ Just fld ->

1884+ runFold

1885+ (DemuxOnlyMap dval)

1886+ (Done . (, dval))

1887+ doneMap runMap fld k a1

1888+ step (DemuxOnlyDefault dacc doneMap) a = do

18011889 let (k, a1) = f a

18021890 res <- dstep dacc (k, a1)

18031891 return

18041892 $ case res of

1805− Partial s -> Partial $ DemuxDefault s results

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

1893+ Partial s -> Partial $ DemuxOnlyDefault s doneMap

1894+ Done b -> Done (doneMap, b)

18071895

1808− extract (DemuxMapWithDefault dacc results kvMap) = do

1896+ runExtract (Fold _ initial1 done1) = do

1897+ res <- initial1

1898+ case res of

1899+ Partial s -> done1 s

1900+ Done b -> return b

1901+

1902+ extract (DemuxMapAndDefault dacc doneMap runMap) = do

18091903 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

1904+ runMap1 <- Prelude.mapM runExtract runMap

1905+ return (doneMap `Map.union` runMap1, b)

1906+ extract (DemuxOnlyMap dval doneMap runMap) = do

1907+ runMap1 <- Prelude.mapM runExtract runMap

1908+ return (doneMap `Map.union` runMap1, dval)

1909+ extract (DemuxOnlyDefault dacc doneMap) = do

18161910 b <- dextract dacc

1817− return (results, b)

1911+ return (doneMap, b)

18181912

18191913{-# INLINE demuxDefault #-}

18201914demuxDefault :: (Monad m, Ord k)

@@ -1844,43 +1938,44 @@ demuxDefault = demuxDefaultWith id

18441938--

18451939{-# INLINE classifyWith #-}

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

1847−classifyWith f (Fold step initial extract) = Fold step' initial' extract'

1941+classifyWith f (Fold step1 initial1 extract1) = mkAccumM step initial extract

18481942

18491943 where

18501944

1851− initial' = return Map.empty

1945+ initial = return Map.empty

18521946

1853− step' kv a =

1947+ step kv a =

18541948 case Map.lookup k kv of

18551949 Nothing -> do

1856− x <- initial

1857− r <- step x a

1858− return

1859− $ Partial

1860− $ flip (Map.insert k) kv

1861− $ case r of

1862− Partial sr -> Left' sr

1863− Done br -> Right' br

1950+ x <- initial1

1951+ case x of

1952+ Partial s -> do

1953+ r <- step1 s a

1954+ return

1955+ $ flip (Map.insert k) kv

1956+ $ case r of

1957+ Partial s1 -> Left' s1

1958+ Done b -> Right' b

1959+ Done b -> return $ Map.insert k (Right' b) kv

18641960 Just x -> do

18651961 case x of

18661962 Left' s -> do

1867− r <- step s a

1963+ r <- step1 s a

18681964 return

1869− $ Partial

18701965 $ flip (Map.insert k) kv

18711966 $ case r of

1872− Partial sr -> Left' sr

1873− Done br -> Right' br

1874− Right' _ -> return $ Partial kv

1967+ Partial s1 -> Left' s1

1968+ Done b -> Right' b

1969+ Right' _ -> return kv

18751970

18761971 where

18771972

18781973 k = f a

18791974

1880− extract' =

1975+ extract =

18811976 Prelude.mapM

18821977 (\case

1883− Left' s -> extract s

1978+ Left' s -> extract1 s

18841979 Right' b -> return b)

18851980

18861981-- | Given an input stream of key value pairs and a fold for values, fold all

@@ -1920,7 +2015,20 @@ unzipWithM f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =

19202015

19212016 where

19222017

1923− begin = RunBoth <$> beginL <*> beginR

2018+ begin = do

2019+ resL <- beginL

2020+ resR <- beginR

2021+ return

2022+ $ case resL of

2023+ Partial sL ->

2024+ Partial

2025+ $ case resR of

2026+ Partial sR -> RunBoth sL sR

2027+ Done bR -> RunLeft sL bR

2028+ Done bL ->

2029+ case resR of

2030+ Partial sR -> Partial $ RunRight bL sR

2031+ Done bR -> Done (bL, bR)

19242032

19252033 step (RunBoth sL sR) a = do

19262034 (b, c) <- f a

@@ -2048,7 +2156,7 @@ toParallelSVar svar winfo = Fold step initial extract

20482156

20492157 where

20502158

2051− initial = return ()

2159+ initial = return $ Partial ()

20522160

20532161 -- XXX we can have a separate fold for unlimited buffer case to avoid a

20542162 -- branch in the step here.

@@ -2067,7 +2175,7 @@ toParallelSVarLimited svar winfo = Fold step initial extract

20672175

20682176 where

20692177

2070− initial = return True

2178+ initial = return $ Partial True

20712179

20722180 step True x =

20732181 liftIO $ do

src/Streamly/Internal/Data/Fold/Types.hs+141−110

@@ -173,8 +173,6 @@ module Streamly.Internal.Data.Fold.Types

173173

174174 , Fold2 (..)

175175 , simplify

176− , toListRevF -- experimental

177− -- $toListRevF

178176

179177 -- * Generators

180178 , yield

@@ -295,7 +293,7 @@ instance Functor (Step s) where

295293

296294data Fold m a b =

297295 -- | @Fold @ @ step @ @ initial @ @ extract@

298− forall s. Fold (s -> a -> m (Step s b)) (m s) (s -> m b)

296+ forall s. Fold (s -> a -> m (Step s b)) (m (Step s b)) (s -> m b)

299297

300298-- | Experimental type to provide a side input to the fold for generating the

301299-- initial state. For example, if we have to fold chunks of a stream and write

@@ -309,15 +307,16 @@ data Fold2 m c a b =

309307-- | Convert more general type 'Fold2' into a simpler type 'Fold'

310308simplify :: Functor m => Fold2 m c a b -> c -> Fold m a b

311309simplify (Fold2 step inject extract) c =

312− Fold (\x a -> Partial <$> step x a) (inject c) extract

310+ Fold (\x a -> Partial <$> step x a) (Partial <$> inject c) extract

313311

314312-- | Maps a function on the output of the fold (the type @b@).

315313instance Functor m => Functor (Fold m a) where

316314 {-# INLINE fmap #-}

317− fmap f (Fold step1 initial extract) = Fold step initial (fmap2 f extract)

315+ fmap f (Fold step1 initial1 extract) = Fold step initial (fmap2 f extract)

318316

319317 where

320318

319+ initial = fmap2 f initial1

321320 step s b = fmap2 f (step1 s b)

322321 fmap2 g = fmap (fmap g)

323322

@@ -328,9 +327,8 @@ instance Functor m => Functor (Fold m a) where

328327-- /Unimplemented/

329328--

330329{-# INLINE yield #-}

331−yield :: -- Monad m =>

332− b -> Fold m a b

333−yield = undefined

330+yield :: Applicative m => b -> Fold m a b

331+yield b = Fold undefined (pure $ Done b) pure

334332

335333-- This is the dual of stream "yieldM".

336334--

@@ -340,12 +338,11 @@ yield = undefined

340338-- /Unimplemented/

341339--

342340{-# INLINE yieldM #-}

343−yieldM :: -- Monad m =>

344− m b -> Fold m a b

345−yieldM = undefined

341+yieldM :: Applicative m => m b -> Fold m a b

342+yieldM b = Fold undefined (Done <$> b) pure

346343

347344{-# ANN type Step Fuse #-}

348−data SeqFoldState sl f sr = SeqFoldL sl | SeqFoldR f sr

345+data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr

349346

350347-- | Sequential fold application. Apply two folds sequentially to an input

351348-- stream. The input is provided to the first fold, when it is done the

@@ -366,13 +363,21 @@ splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

366363

367364 where

368365

369− initial = SeqFoldL <$> initialL

366+ initial = do

367+ resL <- initialL

368+ case resL of

369+ Partial sl -> return $ Partial $ SeqFoldL sl

370+ Done bl -> do

371+ resR <- initialR

372+ return $ bimap (SeqFoldR (func bl)) (func bl) resR

370373

371374 step (SeqFoldL st) a = do

372375 r <- stepL st a

373376 case r of

374377 Partial s -> return $ Partial (SeqFoldL s)

375− Done b -> Partial <$> (SeqFoldR (func b) <$> initialR)

378+ Done b -> do

379+ res <- initialR

380+ return $ bimap (SeqFoldR (func b)) (func b) res

376381 step (SeqFoldR f st) a = do

377382 r <- stepR st a

378383 return

@@ -383,9 +388,12 @@ splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

383388 extract (SeqFoldR f sR) = fmap f (extractR sR)

384389 extract (SeqFoldL sL) = do

385390 rL <- extractL sL

386− sR <- initialR

387− rR <- extractR sR

388− return $ func rL rR

391+ res <- initialR

392+ case res of

393+ Partial sR -> do

394+ rR <- extractR sR

395+ return $ func rL rR

396+ Done rR -> return $ func rL rR

389397

390398-- | Same as applicative '*>'. Run two folds serially one after the other

391399-- discarding the result of the first.

@@ -407,7 +415,7 @@ data GenericRunner sL sR bL bR

407415-- folds and combines their output using the supplied function.

408416instance Monad m => Applicative (Fold m a) where

409417 {-# INLINE pure #-}

410− pure b = Fold (\() _ -> pure $ Done b) (pure ()) (\() -> pure b)

418+ pure = yield

411419

412420 {-# INLINE (<*>) #-}

413421 (<*>) = teeWith ($)

@@ -425,9 +433,16 @@ teeWith f (Fold stepL beginL doneL) (Fold stepR beginR doneR) =

425433 where

426434

427435 begin = do

428− sL <- beginL

429− sR <- beginR

430− return $ RunBoth sL sR

436+ resL <- beginL

437+ resR <- beginR

438+ return

439+ $ case resL of

440+ Partial sl ->

441+ Partial

442+ $ case resR of

443+ Partial sr -> RunBoth sl sr

444+ Done br -> RunLeft sl br

445+ Done bl -> bimap (RunRight bl) (f bl) resR

431446

432447 step (RunBoth sL sR) a = do

433448 resL <- stepL sL a

@@ -629,22 +644,6 @@ instance (Monad m, Floating b) => Floating (Fold m a b) where

629644-- Internal APIs

630645------------------------------------------------------------------------------

631646

632−-- $toListRevF

633−-- This is more efficient than 'Streamly.Internal.Data.Fold.toList'. toList is

634−-- exactly the same as reversing the list after 'toListRevF'.

635−

636−-- | Buffers the input stream to a list in the reverse order of the input.

637−--

638−-- /Warning!/ working on large lists accumulated as buffers in memory could be

639−-- very inefficient, consider using "Streamly.Array" instead.

640−--

641−-- @since 0.7.0

642−

643−-- xn : ... : x2 : x1 : []

644−{-# INLINABLE toListRevF #-}

645−toListRevF :: Monad m => Fold m a [a]

646−toListRevF = Fold (\xs x -> return $ Partial $ x:xs) (return []) return

647−

648647-- | @(lmap f fold)@ maps the function @f@ on the input of the fold.

649648--

650649-- >>> S.fold (FL.lmap (\x -> x * x) FL.sum) (S.enumerateFromTo 1 100)

@@ -720,30 +719,35 @@ ltake n (Fold fstep finitial fextract) = Fold step initial extract

720719

721720 where

722721

723− initial = Tuple' 0 <$> finitial

724−

725− step (Tuple' i r) a

726− | i < n = do

727− res <- fstep r a

728− case res of

729− Partial sres -> do

730− let i1 = i + 1

731− s1 = Tuple' i1 sres

732− if i1 < n

733− then return $ Partial s1

734− else Done <$> fextract sres

735− Done bres -> return $ Done bres

736− -- XXX take 0 case is broken currently

737− | otherwise = Done <$> fextract r

722+ initial = do

723+ res <- finitial

724+ case res of

725+ Partial s ->

726+ if n > 0

727+ then return $ Partial $ Tuple' 0 s

728+ else Done <$> fextract s

729+ Done b -> return $ Done b

730+

731+ step (Tuple' i r) a = do

732+ res <- fstep r a

733+ case res of

734+ Partial sres -> do

735+ let i1 = i + 1

736+ s1 = Tuple' i1 sres

737+ if i1 < n

738+ then return $ Partial s1

739+ else Done <$> fextract sres

740+ Done bres -> return $ Done bres

738741

739742 extract (Tuple' _ r) = fextract r

740743

741744------------------------------------------------------------------------------

742745-- Nesting

743746------------------------------------------------------------------------------

744−--

745−-- | Modify the fold such that when the fold is done, instead of returning the

746−-- accumulator, it returns a fold. The returned fold starts from where we left

747+

748+-- | Modify the fold such that it returns a new 'Fold' instead of the output.

749+-- If the fold was already done the returned fold would always yield the

750+-- result. If the fold was partial, the returned fold starts from where we left

747751-- i.e. it uses the last accumulator value as the initial value of the

748752-- accumulator. Thus we can resume the fold later and feed it more input.

749753--

@@ -755,11 +759,15 @@ ltake n (Fold fstep finitial fextract) = Fold step initial extract

755759--

756760-- @since 0.7.0

757761{-# INLINABLE duplicate #-}

758−duplicate ::

759− -- Monad m =>

760− Fold m a b -> Fold m a (Fold m a b)

761−-- XXX This should change once we have step type in the initial element

762−duplicate _ = undefined

762+duplicate :: Monad m => Fold m a b -> Fold m a (Fold m a b)

763+duplicate (Fold step1 initial1 extract1) =

764+ Fold step initial (\s -> pure $ Fold step1 (pure $ Partial s) extract1)

765+

766+ where

767+

768+ initial = second yield <$> initial1

769+

770+ step s a = second yield <$> step1 s a

763771

764772-- | Run the initialization effect of a fold. The returned fold would use the

765773-- value returned by this effect as its initial value.

@@ -773,11 +781,16 @@ initialize (Fold step initial extract) = do

773781-- | Run one step of a fold and store the accumulator as an initial value in

774782-- the returned fold.

775783{-# INLINABLE runStep #-}

776−runStep ::

777− -- Monad m =>

778− Fold m a b -> a -> m (Fold m a b)

779−-- XXX This should change once we have step type in the initial element

780−runStep _ _ = undefined

784+runStep :: Monad m => Fold m a b -> a -> m (Fold m a b)

785+runStep (Fold step initial extract) a = return $ Fold step initial1 extract

786+

787+ where

788+

789+ initial1 = do

790+ res <- initial

791+ case res of

792+ Partial fs -> step fs a

793+ b@(Done _) -> return b

781794

782795------------------------------------------------------------------------------

783796-- Parsing

@@ -799,32 +812,51 @@ runStep _ _ = undefined

799812--

800813{-# INLINE many #-}

801814many :: Monad m => Fold m b c -> Fold m a b -> Fold m a c

802−many (Fold fstep finitial fextract) (Fold step1 initial1 extract1) =

815+many (Fold cstep cinitial cextract) (Fold sstep sinitial sextract) =

803816 Fold step initial extract

804817

805818 where

806819

807− initial = Tuple' <$> initial1 <*> finitial

820+ -- cs = collect state

821+ -- ss = split state

822+ -- cres = collect state result

823+ -- sres = split state result

824+ -- cb = collect done

825+ -- sb = split done

826+

827+ -- Caution! There is mutual recursion here, inlining the right functions is

828+ -- important.

829+

830+ {-# INLINE handleSplitStep #-}

831+ handleSplitStep cs sres =

832+ case sres of

833+ Partial ss1 -> return $ Partial $ Tuple' ss1 cs

834+ Done sb -> runCollector cs sb

835+

836+ {-# INLINE handleCollectStep #-}

837+ handleCollectStep cres =

838+ case cres of

839+ Partial cs -> do

840+ sres <- sinitial

841+ handleSplitStep cs sres

842+ Done cb -> return $ Done cb

843+

844+ -- Do not inline this

845+ runCollector cs sb = cstep cs sb >>= handleCollectStep

846+

847+ initial = cinitial >>= handleCollectStep

808848

809849 {-# INLINE step #-}

810− step (Tuple' st fs) a = do

811− r <- step1 st a

812− case r of

813− Partial s -> return $ Partial (Tuple' s fs)

814− Done b -> do

815− s <- initial1

816− fs1 <- fstep fs b

817− return

818− $ case fs1 of

819− Partial s1 -> Partial (Tuple' s s1)

820− Done b1 -> Done b1

850+ step (Tuple' ss cs) a = do

851+ sres <- sstep ss a

852+ handleSplitStep cs sres

821853

822− extract (Tuple' s fs) = do

823− b <- extract1 s

824− acc <- fstep fs b

825− case acc of

826− Partial s1 -> fextract s1

827− Done x -> return x

854+ extract (Tuple' ss cs) = do

855+ sb <- sextract ss

856+ cres <- cstep cs sb

857+ case cres of

858+ Partial s -> cextract s

859+ Done b -> return b

828860

829861-- | @lchunksOf n split collect@ repeatedly applies the @split@ fold to chunks

830862-- of @n@ items in the input stream and supplies the result to the @collect@

@@ -847,7 +879,13 @@ lchunksOf2 n (Fold step1 initial1 extract1) (Fold2 step2 inject2 extract2) =

847879

848880 where

849881

850− inject' x = Tuple3' 0 <$> initial1 <*> inject2 x

882+ loopUntilPartial s = do

883+ res <- initial1

884+ case res of

885+ Partial fs -> return $ Tuple3' 0 fs s

886+ Done _ -> loopUntilPartial s

887+

888+ inject' x = inject2 x >>= loopUntilPartial

851889

852890 step' (Tuple3' i r1 r2) a =

853891 if i < n

@@ -855,20 +893,10 @@ lchunksOf2 n (Fold step1 initial1 extract1) (Fold2 step2 inject2 extract2) =

855893 res <- step1 r1 a

856894 case res of

857895 Partial s -> return $ Tuple3' (i + 1) s r2

858− Done b -> do

859− s <- initial1

860− r21 <- step2 r2 b

861− return $ Tuple3' 0 s r21

862− else do

863− res <- extract1 r1

864− acc2 <- step2 r2 res

865− i1 <- initial1

866− return $ Tuple3' 0 i1 acc2

896+ Done b -> step2 r2 b >>= loopUntilPartial

897+ else extract1 r1 >>= step2 r2 >>= loopUntilPartial

867898

868− extract' (Tuple3' _ r1 r2) = do

869− res <- extract1 r1

870− acc2 <- step2 r2 res

871− extract2 acc2

899+ extract' (Tuple3' _ r1 r2) = extract1 r1 >>= step2 r2 >>= extract2

872900

873901-- | @takeByTime n fold@ uses @fold@ to fold the input items arriving within a

874902-- window of first @n@ seconds.

@@ -884,18 +912,21 @@ takeByTime n (Fold step initial done) = Fold step' initial' done'

884912 where

885913

886914 initial' = do

887− s <- initial

888− mv <- liftIO $ newMVar False

889− t <-

890− control $ \run ->

891− mask $ \restore -> do

892− tid <-

893− forkIO

894− $ catch

895− (restore $ void $ run (timerThread mv))

896− (handleChildException mv)

897− run (return tid)

898− return $ Tuple3' s mv t

915+ res <- initial

916+ case res of

917+ Partial s -> do

918+ mv <- liftIO $ newMVar False

919+ t <-

920+ control $ \run ->

921+ mask $ \restore -> do

922+ tid <-

923+ forkIO

924+ $ catch

925+ (restore $ void $ run (timerThread mv))

926+ (handleChildException mv)

927+ run (return tid)

928+ return $ Partial $ Tuple3' s mv t

929+ Done b -> return $ Done b

899930

900931 step' (Tuple3' s mv t) a = do

901932 val <- liftIO $ readMVar mv

src/Streamly/Internal/Data/Maybe/Strict.hs+15

@@ -20,6 +20,8 @@

2020module Streamly.Internal.Data.Maybe.Strict

2121 ( Maybe' (..)

2222 , toMaybe

23+ , isJust'

24+ , fromJust'

2325 )

2426where

2527

@@ -31,3 +33,16 @@ data Maybe' a = Just' !a | Nothing' deriving Show

3133toMaybe :: Maybe' a -> Maybe a

3234toMaybe Nothing' = Nothing

3335toMaybe (Just' a) = Just a

36+

37+-- | Extract the element out of a Just' and throws an error if its argument is

38+-- Nothing'.

39+{-# INLINABLE fromJust' #-}

40+fromJust' :: Maybe' a -> a

41+fromJust' (Just' a) = a

42+fromJust' Nothing' = error "fromJust' cannot be run in Nothing'"

43+

44+-- | Returns True iff its argument is of the form "Just' _".

45+{-# INLINABLE isJust' #-}

46+isJust' :: Maybe' a -> Bool

47+isJust' (Just' _) = True

48+isJust' Nothing' = False

src/Streamly/Internal/Data/Parser/ParserD.hs+78−36

@@ -175,16 +175,20 @@ import Streamly.Internal.Data.Parser.ParserD.Types

175175--

176176{-# INLINE fromFold #-}

177177fromFold :: Monad m => Fold m a b -> Parser m a b

178−fromFold (Fold fstep finitial fextract) = Parser step finitial fextract

178+fromFold (Fold fstep finitial fextract) = Parser step finitial extract

179179

180180 where

181181

182− step s a = do

182+ step (FL.Partial s) a = do

183183 res <- fstep s a

184184 return

185185 $ case res of

186− FL.Partial s1 -> Partial 0 s1

186+ FL.Partial s1 -> Partial 0 (FL.Partial s1)

187187 FL.Done b -> Done 0 b

188+ step (FL.Done b) _ = return $ Done 1 b

189+

190+ extract (FL.Partial s) = fextract s

191+ extract (FL.Done b) = return b

188192

189193-------------------------------------------------------------------------------

190194-- Failing Parsers

@@ -293,7 +297,12 @@ takeBetween low high (Fold fstep finitial fextract) =

293297

294298 where

295299

296− initial = Tuple' 0 <$> finitial

300+ initial = do

301+ res <- finitial

302+ case res of

303+ FL.Partial s -> return $ Tuple' 0 s

304+ FL.Done _ ->

305+ error "takeBetween: Done/Error in initial not implemented yet."

297306

298307 step (Tuple' i s) a

299308 | low > high =

@@ -341,25 +350,30 @@ takeBetween low high (Fold fstep finitial fextract) =

341350--

342351{-# INLINE takeEQ #-}

343352takeEQ :: MonadThrow m => Int -> Fold m a b -> Parser m a b

344−takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract

353+takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

345354

346355 where

347356

348− n = max cnt 0

357+ cnt = max n 0

349358

350− initial = Tuple' 0 <$> finitial

359+ initial = do

360+ res <- finitial

361+ case res of

362+ FL.Partial s -> return $ Tuple' 0 s

363+ FL.Done _ ->

364+ error "takeEQ: Done/Error in initial not implemented yet."

351365

352366 step (Tuple' i r) a

353− | i1 < n = do

367+ | i1 < cnt = do

354368 res <- fstep r a

355369 return

356370 $ case res of

357371 FL.Partial s -> Continue 0 $ Tuple' i1 s

358372 FL.Done _ ->

359373 Error

360− $ "takeEQ: the collecting fold terminated after "

361− ++ "consuming" ++ show i1 ++ " elements"

362− | i1 == n = do

374+ $ "takeEQ: Expecting exactly " ++ show cnt

375+ ++ " elements, fold terminated on " ++ show i1

376+ | i1 == cnt = do

363377 res <- fstep r a

364378 Done 0

365379 <$> case res of

@@ -374,12 +388,12 @@ takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract

374388 i1 = i + 1

375389

376390 extract (Tuple' i r)

377− | i == 0 && n == 0 = fextract r

391+ | i == 0 && cnt == 0 = fextract r

378392 | otherwise =

379393 throwM

380394 $ ParseError

381− $ "takeEQ: Expecting exactly "

382− ++ show n ++ " elements, got " ++ show i

395+ $ "takeEQ: Expecting exactly " ++ show cnt

396+ ++ " elements, input terminated on " ++ show i

383397

384398-- | See 'Streamly.Internal.Data.Parser.takeGE'.

385399--

@@ -387,23 +401,28 @@ takeEQ cnt (Fold fstep finitial fextract) = Parser step initial extract

387401--

388402{-# INLINE takeGE #-}

389403takeGE :: MonadThrow m => Int -> Fold m a b -> Parser m a b

390−takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract

404+takeGE n (Fold fstep finitial fextract) = Parser step initial extract

391405

392406 where

393407

394− n = max cnt 0

395− initial = Tuple' 0 <$> finitial

408+ cnt = max n 0

409+ initial = do

410+ res <- finitial

411+ case res of

412+ FL.Partial s -> return $ Tuple' 0 s

413+ FL.Done _ ->

414+ error "takeGE: Done/Error in initial not implemented yet."

396415

397416 step (Tuple' i r) a

398− | i1 < n = do

417+ | i1 < cnt = do

399418 res <- fstep r a

400419 return

401420 $ case res of

402421 FL.Partial s -> Continue 0 $ Tuple' i1 s

403422 FL.Done _ ->

404423 Error

405− $ "takeGE: the collecting fold terminated after "

406− ++ "consuming " ++ show i1 ++ " elements"

424+ $ "takeGE: Expecting at least " ++ show cnt

425+ ++ " elements, fold terminated on " ++ show i1

407426 | otherwise = do

408427 res <- fstep r a

409428 return

@@ -416,12 +435,12 @@ takeGE cnt (Fold fstep finitial fextract) = Parser step initial extract

416435 i1 = i + 1

417436

418437 extract (Tuple' i r)

419− | i >= n = fextract r

438+ | i >= cnt = fextract r

420439 | otherwise =

421440 throwM

422441 $ ParseError

423− $ "takeGE: Expecting at least "

424− ++ show n ++ " elements, got " ++ show i

442+ $ "takeGE: Expecting at least " ++ show cnt

443+ ++ " elements, input terminated on " ++ show i

425444

426445-- | See 'Streamly.Internal.Data.Parser.takeWhile'.

427446--

@@ -434,7 +453,12 @@ takeWhile predicate (Fold fstep finitial fextract) =

434453

435454 where

436455

437− initial = finitial

456+ initial = do

457+ res <- finitial

458+ case res of

459+ FL.Partial s -> return s

460+ FL.Done _ ->

461+ error "takeWhile: Done/Error in initial not implemented yet."

438462

439463 step s a =

440464 if predicate a

@@ -460,15 +484,19 @@ takeWhile1 predicate (Fold fstep finitial fextract) =

460484 initial = return Nothing

461485

462486 step Nothing a =

463− if predicate a

464− then do

465− s <- finitial

466− sr <- fstep s a

467− return

468− $ case sr of

469− FL.Partial r -> Partial 0 (Just r)

470− FL.Done b -> Done 0 b

471− else return $ Error "takeWhile1: predicate failed on first element"

487+ let err = Error "takeWhile1: predicate failed on first element"

488+ in if predicate a

489+ then do

490+ res <- finitial

491+ case res of

492+ FL.Partial s -> do

493+ sr <- fstep s a

494+ return

495+ $ case sr of

496+ FL.Partial s1 -> Partial 0 (Just s1)

497+ FL.Done b -> Done 0 b

498+ FL.Done _ -> return err

499+ else return err

472500 step (Just s) a =

473501 if predicate a

474502 then do

@@ -533,7 +561,12 @@ wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

533561 FL.Partial s1 -> Partial 0 $ WBWord s1

534562 FL.Done b -> Done 0 b

535563

536− initial = WBLeft <$> finitial

564+ initial = do

565+ res <- finitial

566+ return

567+ $ case res of

568+ FL.Partial s -> WBLeft s

569+ FL.Done _ -> error "wordBy: Done in initial not implemented"

537570

538571 step (WBLeft s) a =

539572 if not (predicate a)

@@ -575,7 +608,12 @@ groupBy cmp (Fold fstep finitial fextract) = Parser step initial extract

575608 FL.Done b -> Done 0 b

576609 FL.Partial s1 -> Partial 0 (GroupByGrouping a0 s1)

577610

578− initial = GroupByInit <$> finitial

611+ initial = do

612+ res <- finitial

613+ return

614+ $ case res of

615+ FL.Partial s -> GroupByInit s

616+ FL.Done _ -> error "groupBy: Done in initial not implemented"

579617

580618 step (GroupByInit s) a = grouper s a a

581619 step (GroupByGrouping a0 s) a =

@@ -763,7 +801,11 @@ manyTill (Fold fstep finitial fextract)

763801

764802 where

765803

766− initial = ManyTillR 0 <$> finitial <*> initialR

804+ initial = do

805+ res <- finitial

806+ case res of

807+ FL.Partial fs -> ManyTillR 0 fs <$> initialR

808+ FL.Done _ -> error "manyTill: Done in initial not implemented"

767809

768810 step (ManyTillR cnt fs st) a = do

769811 r <- stepR st a

src/Streamly/Internal/Data/Parser/ParserD/Types.hs+12−4

@@ -443,8 +443,12 @@ splitMany (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

443443

444444 initial = do

445445 ps <- initial1 -- parse state

446− fs <- finitial -- fold state

447− pure (Tuple3' ps (0 :: Int) fs)

446+ res <- finitial -- fold state

447+ return

448+ $ case res of

449+ FL.Partial fs -> Tuple3' ps (0 :: Int) fs

450+ FL.Done _ ->

451+ error "splitMany: Done in initial not implemented"

448452

449453 {-# INLINE step #-}

450454 step (Tuple3' st cnt fs) a = do

@@ -493,8 +497,12 @@ splitSome (Fold fstep finitial fextract) (Parser step1 initial1 extract1) =

493497

494498 initial = do

495499 ps <- initial1 -- parse state

496− fs <- finitial -- fold state

497− pure (Tuple3' ps (0 :: Int) (Left fs))

500+ res <- finitial -- fold state

501+ return

502+ $ case res of

503+ FL.Partial fs -> Tuple3' ps (0 :: Int) (Left fs)

504+ FL.Done _ ->

505+ error "splitSome: Done/Error in initial not implemented"

498506

499507 {-# INLINE step #-}

500508 step (Tuple3' st cnt (Left fs)) a = do

src/Streamly/Internal/Data/Sink.hs+1−1

@@ -80,7 +80,7 @@ import qualified Data.Map.Strict as Map

8080toFold :: Monad m => Sink m a -> Fold m a ()

8181toFold (Sink f) = Fold step begin done

8282 where

83− begin = return ()

83+ begin = return $ Partial ()

8484 step _ a = Partial <$> f a

8585 done _ = return ()

8686

src/Streamly/Internal/Data/SmallArray.hs+1−1

@@ -112,7 +112,7 @@ writeN limit = Fold step initial extract

112112

113113 initial = do

114114 marr <- liftIO $ newSmallArray limit bottomElement

115− return (Tuple' marr 0)

115+ return $ FL.Partial (Tuple' marr 0)

116116

117117 step st@(Tuple' marr i) x

118118 | i == limit = FL.Done <$> extract st

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+2−4

@@ -759,9 +759,7 @@ toHandle h = go

759759-- /Internal/

760760{-# INLINE toStream #-}

761761toStream :: Monad m => Fold m a (SerialT Identity a)

762−toStream = Fold (\f x -> return $ FL.Partial $ f . (x `K.cons`))

763− (return id)

764− (return . ($ K.nil))

762+toStream = FL.mkAccum (\f x -> f . (x `K.cons`)) id ($ K.nil)

765763

766764-- This is more efficient than 'toStream'. toStream is exactly the same as

767765-- reversing the stream after toStreamRev.

@@ -777,7 +775,7 @@ toStream = Fold (\f x -> return $ FL.Partial $ f . (x `K.cons`))

777775-- xn : ... : x2 : x1 : []

778776{-# INLINABLE toStreamRev #-}

779777toStreamRev :: Monad m => Fold m a (SerialT Identity a)

780−toStreamRev = Fold (\xs x -> return $ FL.Partial $ x `K.cons` xs) (return K.nil) return

778+toStreamRev = FL.mkAccum_ (flip K.cons) K.nil

781779

782780-- | Convert a stream to a pure stream.

783781--

src/Streamly/Internal/Data/Stream/IsStream/Nesting.hs+13−9

@@ -1802,14 +1802,7 @@ classifySessionsBy tick tmout reset ejectPred

18021802 --

18031803 let curTime = max sessionEventTime timestamp

18041804 mOld = Map.lookup key sessionKeyValueMap

1805−

1806− fs <-

1807− case mOld of

1808− Nothing -> initial

1809− Just (Tuple' _ acc) -> return acc

1810− res <- step fs value

1811− case res of

1812− FL.Done fb -> do

1805+ let done fb = do

18131806 -- deleting a key from the heap is expensive, so we never

18141807 -- delete a key from heap, we just purge it from the Map and it

18151808 -- gets purged from the heap on timeout. We just need an extra

@@ -1827,7 +1820,7 @@ classifySessionsBy tick tmout reset ejectPred

18271820 , sessionKeyValueMap = mp

18281821 , sessionOutputStream = yield (key, fb)

18291822 }

1830− FL.Partial fs1 -> do

1823+ partial fs1 = do

18311824 let acc = Tuple' timestamp fs1

18321825 (hp1, mp1, out1, cnt1) <- do

18331826 let vars = (sessionTimerHeap, sessionKeyValueMap,

@@ -1858,6 +1851,17 @@ classifySessionsBy tick tmout reset ejectPred

18581851 , sessionKeyValueMap = mp2

18591852 , sessionOutputStream = out1

18601853 }

1854+ res0 <- do

1855+ case mOld of

1856+ Nothing -> initial

1857+ Just (Tuple' _ acc) -> return $ FL.Partial acc

1858+ case res0 of

1859+ FL.Done fb -> done fb

1860+ FL.Partial fs -> do

1861+ res <- step fs value

1862+ case res of

1863+ FL.Done fb -> done fb

1864+ FL.Partial fs1 -> partial fs1

18611865

18621866 -- Got a timer tick event

18631867 sstep sessionState@SessionState{..} Nothing =

src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+314−201

@@ -1218,27 +1218,43 @@ parseIterate func seed (Stream step state) =

12181218-- Grouping

12191219------------------------------------------------------------------------------

12201220

1221+data GroupByState st fs a b

1222+ = GroupingInit st

1223+ | GroupingDo st !fs

1224+ | GroupingInitWith st !a

1225+ | GroupingDoWith st !fs !a

1226+ | GroupingYield !b (GroupByState st fs a b)

1227+ | GroupingDone

1228+

12211229{-# INLINE_NORMAL groupsBy #-}

12221230groupsBy :: Monad m

12231231 => (a -> a -> Bool)

12241232 -> Fold m a b

12251233 -> Stream m a

12261234 -> Stream m b

1227−groupsBy cmp f (Stream step state) = Stream (stepOuter f) (Just state, Nothing)

1235+groupsBy cmp (Fold fstep initial done) (Stream step state) =

1236+ Stream stepOuter (GroupingInit state)

12281237

12291238 where

12301239

12311240 {-# INLINE_LATE stepOuter #-}

1232− stepOuter (Fold fstep initial done) gst (Just st, Nothing) = do

1241+ stepOuter _ (GroupingInit st) = do

1242+ -- XXX Note that if the stream stops without yielding a single element

1243+ -- in the group we discard the "initial" effect.

1244+ res <- initial

1245+ return

1246+ $ case res of

1247+ FL.Partial s -> Skip $ GroupingDo st s

1248+ FL.Done b -> Yield b $ GroupingInit st

1249+ stepOuter gst (GroupingDo st fs) = do

12331250 res <- step (adaptState gst) st

12341251 case res of

12351252 Yield x s -> do

1236− fs <- initial

12371253 r <- fstep fs x

12381254 case r of

12391255 FL.Partial fs1 -> go SPEC x s fs1

1240− FL.Done b -> return $ Yield b (Just s, Just x)

1241− Skip s -> return $ Skip (Just s, Nothing)

1256+ FL.Done b -> return $ Yield b (GroupingInit s)

1257+ Skip s -> return $ Skip $ GroupingDo s fs

12421258 Stop -> return Stop

12431259

12441260 where

@@ -1252,16 +1268,23 @@ groupsBy cmp f (Stream step state) = Stream (stepOuter f) (Just state, Nothing)

12521268 r <- fstep acc x

12531269 case r of

12541270 FL.Partial fs1 -> go SPEC prev s fs1

1255− FL.Done b -> return $ Yield b (Just s, Just x)

1256− else done acc >>= \r -> return $ Yield r (Just s, Just x)

1271+ FL.Done b -> return $ Yield b (GroupingInit s)

1272+ else do

1273+ r <- done acc

1274+ return $ Yield r (GroupingInitWith s x)

12571275 Skip s -> go SPEC prev s acc

1258− Stop -> done acc >>= \r -> return $ Yield r (Nothing, Nothing)

1259− stepOuter (Fold fstep initial done) gst (Just st, Just prev) = do

1260− fs <- initial

1261− r <- fstep fs prev

1262− case r of

1276+ Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1277+ stepOuter _ (GroupingInitWith st x) = do

1278+ res <- initial

1279+ return

1280+ $ case res of

1281+ FL.Partial s -> Skip $ GroupingDoWith st s x

1282+ FL.Done b -> Yield b $ GroupingInitWith st x

1283+ stepOuter gst (GroupingDoWith st fs prev) = do

1284+ res <- fstep fs prev

1285+ case res of

12631286 FL.Partial fs1 -> go SPEC st fs1

1264− FL.Done b -> return $ Yield b (Just st, Nothing)

1287+ FL.Done b -> return $ Yield b (GroupingInit st)

12651288

12661289 where

12671290

@@ -1275,11 +1298,14 @@ groupsBy cmp f (Stream step state) = Stream (stepOuter f) (Just state, Nothing)

12751298 r <- fstep acc x

12761299 case r of

12771300 FL.Partial fs1 -> go SPEC s fs1

1278− FL.Done b -> return $ Yield b (Just s, Just x)

1279− else done acc >>= \r -> return $ Yield r (Just s, Just x)

1301+ FL.Done b -> return $ Yield b (GroupingInit s)

1302+ else do

1303+ r <- done acc

1304+ return $ Yield r (GroupingInitWith s x)

12801305 Skip s -> go SPEC s acc

1281− Stop -> done acc >>= \r -> return $ Yield r (Nothing, Nothing)

1282− stepOuter _ _ (Nothing, _) = return Stop

1306+ Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1307+ stepOuter _ (GroupingYield _ _) = error "groupsBy: Unreachable"

1308+ stepOuter _ GroupingDone = return Stop

12831309

12841310{-# INLINE_NORMAL groupsRollingBy #-}

12851311groupsRollingBy :: Monad m

@@ -1287,22 +1313,29 @@ groupsRollingBy :: Monad m

12871313 -> Fold m a b

12881314 -> Stream m a

12891315 -> Stream m b

1290−groupsRollingBy cmp f (Stream step state) =

1291− Stream (stepOuter f) (Just state, Nothing)

1316+groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

1317+ Stream stepOuter (GroupingInit state)

12921318

12931319 where

12941320

12951321 {-# INLINE_LATE stepOuter #-}

1296− stepOuter (Fold fstep initial done) gst (Just st, Nothing) = do

1322+ stepOuter _ (GroupingInit st) = do

1323+ -- XXX Note that if the stream stops without yielding a single element

1324+ -- in the group we discard the "initial" effect.

1325+ res <- initial

1326+ return

1327+ $ case res of

1328+ FL.Partial fs -> Skip $ GroupingDo st fs

1329+ FL.Done fb -> Yield fb $ GroupingInit st

1330+ stepOuter gst (GroupingDo st fs) = do

12971331 res <- step (adaptState gst) st

12981332 case res of

12991333 Yield x s -> do

1300− fs <- initial

13011334 r <- fstep fs x

13021335 case r of

13031336 FL.Partial fs1 -> go SPEC x s fs1

1304− FL.Done b -> return $ Yield b (Just s, Just x)

1305− Skip s -> return $ Skip $ (Just s, Nothing)

1337+ FL.Done fb -> return $ Yield fb (GroupingInit s)

1338+ Skip s -> return $ Skip $ GroupingDo s fs

13061339 Stop -> return Stop

13071340

13081341 where

@@ -1316,62 +1349,104 @@ groupsRollingBy cmp f (Stream step state) =

13161349 r <- fstep acc x

13171350 case r of

13181351 FL.Partial fs1 -> go SPEC x s fs1

1319− FL.Done b -> return $ Yield b (Just s, Just x)

1320− else done acc >>= \r -> return $ Yield r (Just s, Just x)

1352+ FL.Done b -> return $ Yield b (GroupingInit s)

1353+ else do

1354+ r <- done acc

1355+ return $ Yield r (GroupingInitWith s x)

13211356 Skip s -> go SPEC prev s acc

1322− Stop -> done acc >>= \r -> return $ Yield r (Nothing, Nothing)

1323− stepOuter (Fold fstep initial done) gst (Just st, Just prev') = do

1324− fs <- initial

1325− r <- fstep fs prev'

1326− case r of

1327− FL.Partial fs1 -> go SPEC prev' st fs1

1328− FL.Done b -> return $ Yield b (Just st, Nothing)

1357+ Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1358+ stepOuter _ (GroupingInitWith st x) = do

1359+ res <- initial

1360+ return

1361+ $ case res of

1362+ FL.Partial s -> Skip $ GroupingDoWith st s x

1363+ FL.Done b -> Yield b $ GroupingInitWith st x

1364+ stepOuter gst (GroupingDoWith st fs previous) = do

1365+ res <- fstep fs previous

1366+ case res of

1367+ FL.Partial s -> go SPEC previous st s

1368+ FL.Done b -> return $ Yield b (GroupingInit st)

13291369

13301370 where

13311371

1332− go !_ prevv stt !acc = do

1372+ -- XXX GHC: groupsBy has one less parameter in this go loop and it

1373+ -- fuses. However, groupsRollingBy does not fuse, removing the prev

1374+ -- parameter makes it fuse. Something needs to be fixed in GHC. The

1375+ -- workaround for this is noted in the comments below.

1376+ go !_ prev !stt !acc = do

13331377 res <- step (adaptState gst) stt

13341378 case res of

13351379 Yield x s -> do

1336− if cmp prevv x

1380+ if cmp prev x

13371381 then do

13381382 r <- fstep acc x

13391383 case r of

13401384 FL.Partial fs1 -> go SPEC x s fs1

1341− FL.Done b -> return $ Yield b (Just s, Just x)

1342− else done acc >>= \r -> return $ Yield r (Just s, Just x)

1343− Skip s -> go SPEC prevv s acc

1344− Stop -> done acc >>= \r -> return $ Yield r (Nothing, Nothing)

1345− stepOuter _ _ (Nothing, _) = return Stop

1385+ FL.Done b -> return $ Yield b (GroupingInit st)

1386+ else do

1387+ {-

1388+ r <- done acc

1389+ return $ Yield r (GroupingInitWith s x)

1390+ -}

1391+ -- The code above does not let groupBy fuse. We use the

1392+ -- alternative code below instead. Instead of jumping

1393+ -- to GroupingInitWith state, we unroll the code of

1394+ -- GroupingInitWith state here to help GHC with stream

1395+ -- fusion.

1396+ result <- initial

1397+ r <- done acc

1398+ return

1399+ $ Yield r

1400+ $ case result of

1401+ FL.Partial fsi -> GroupingDoWith s fsi x

1402+ FL.Done b -> GroupingYield b (GroupingInit s)

1403+ Skip s -> go SPEC prev s acc

1404+ Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1405+ stepOuter _ (GroupingYield r next) = return $ Yield r next

1406+ stepOuter _ GroupingDone = return Stop

13461407

13471408------------------------------------------------------------------------------

13481409-- Splitting - by a predicate

13491410------------------------------------------------------------------------------

13501411

1351−data WordsByState s = WordsByJust s | WordsByNothing

1412+data WordsByState st fs b

1413+ = WordsByInit st

1414+ | WordsByDo st !fs

1415+ | WordsByDone

1416+ | WordsByYield !b (WordsByState st fs b)

13521417

13531418{-# INLINE_NORMAL wordsBy #-}

13541419wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b

1355−wordsBy predicate f (Stream step state) =

1356− Stream (stepOuter f) (WordsByJust state)

1420+wordsBy predicate (Fold fstep initial done) (Stream step state) =

1421+ Stream stepOuter (WordsByInit state)

13571422

13581423 where

13591424

13601425 {-# INLINE_LATE stepOuter #-}

1361− stepOuter (Fold fstep initial done) gst (WordsByJust st) = do

1426+ stepOuter _ (WordsByInit st) = do

1427+ res <- initial

1428+ return

1429+ $ case res of

1430+ FL.Partial s -> Skip $ WordsByDo st s

1431+ FL.Done b -> Yield b (WordsByInit st)

1432+

1433+ stepOuter gst (WordsByDo st fs) = do

13621434 res <- step (adaptState gst) st

13631435 case res of

13641436 Yield x s -> do

13651437 if predicate x

1366− then return $ Skip (WordsByJust s)

1438+ then do

1439+ resi <- initial

1440+ return

1441+ $ case resi of

1442+ FL.Partial fs1 -> Skip $ WordsByDo s fs1

1443+ FL.Done b -> Yield b (WordsByInit s)

13671444 else do

1368− fs <- initial

13691445 r <- fstep fs x

13701446 case r of

13711447 FL.Partial fs1 -> go SPEC s fs1

1372− FL.Done b -> return $ Yield b (WordsByJust s)

1373−

1374− Skip s -> return $ Skip $ WordsByJust s

1448+ FL.Done b -> return $ Yield b (WordsByInit s)

1449+ Skip s -> return $ Skip $ WordsByDo s fs

13751450 Stop -> return Stop

13761451

13771452 where

@@ -1381,16 +1456,34 @@ wordsBy predicate f (Stream step state) =

13811456 case res of

13821457 Yield x s -> do

13831458 if predicate x

1384− then done acc >>= \r -> return $ Yield r (WordsByJust s)

1459+ then do

1460+ {-

1461+ r <- done acc

1462+ return $ Yield r (WordsByInit s)

1463+ -}

1464+ -- The above code does not fuse well. Need to check why

1465+ -- GHC is not able to simplify it well. Using the code

1466+ -- below, instead of jumping through the WordsByInit

1467+ -- state always, we directly go to WordsByDo state in

1468+ -- the common case of Partial.

1469+ resi <- initial

1470+ r <- done acc

1471+ return

1472+ $ Yield r

1473+ $ case resi of

1474+ FL.Partial fs1 -> WordsByDo s fs1

1475+ FL.Done b -> WordsByYield b (WordsByInit s)

13851476 else do

13861477 r <- fstep acc x

13871478 case r of

13881479 FL.Partial fs1 -> go SPEC s fs1

1389− FL.Done b -> return $ Yield b (WordsByJust s)

1480+ FL.Done b -> return $ Yield b (WordsByInit s)

13901481 Skip s -> go SPEC s acc

1391− Stop -> done acc >>= \r -> return $ Yield r WordsByNothing

1482+ Stop -> done acc >>= \r -> return $ Yield r WordsByDone

1483+

1484+ stepOuter _ WordsByDone = return Stop

13921485

1393− stepOuter _ _ WordsByNothing = return Stop

1486+ stepOuter _ (WordsByYield b next) = return $ Yield b next

13941487

13951488------------------------------------------------------------------------------

13961489-- Splitting on a sequence

@@ -1413,25 +1506,30 @@ data SplitOptions = SplitOptions

14131506 }

14141507-}

14151508

1509+-- XXX using "fs" as the last arg in Constructors may simplify the code a bit,

1510+-- because we can use the constructor directly without having to create "jump"

1511+-- functions.

14161512{-# ANN type SplitOnSeqState Fuse #-}

14171513data SplitOnSeqState rb rh ck w fs s b x =

14181514 SplitOnSeqInit

14191515 | SplitOnSeqYield b (SplitOnSeqState rb rh ck w fs s b x)

14201516 | SplitOnSeqDone

14211517

1422− | SplitOnSeqEmpty s

1518+ | SplitOnSeqEmpty !fs s

14231519

14241520 | SplitOnSeqSingle !fs s x

14251521

1426− | SplitOnSeqWordInit s

1522+ | SplitOnSeqWordInit !fs s

14271523 | SplitOnSeqWordLoop !w s !fs

14281524 | SplitOnSeqWordDone Int !fs !w

14291525

1430− | SplitOnSeqKRInit Int s rb !rh

1526+ | SplitOnSeqKRInit Int !fs s rb !rh

14311527 | SplitOnSeqKRLoop fs s rb !rh !ck

14321528 | SplitOnSeqKRCheck fs s rb !rh

14331529 | SplitOnSeqKRDone Int !fs rb !rh

14341530

1531+ | SplitOnSeqReinit (fs -> SplitOnSeqState rb rh ck w fs s b x)

1532+

14351533{-# INLINE_NORMAL splitOnSeq #-}

14361534splitOnSeq

14371535 :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

@@ -1474,41 +1572,59 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

14741572

14751573 skip = return . Skip

14761574

1575+ nextAfterInit nextGen stepRes =

1576+ case stepRes of

1577+ FL.Partial s -> nextGen s

1578+ FL.Done b -> SplitOnSeqYield b (SplitOnSeqReinit nextGen)

1579+

1580+ {-# INLINE yieldProceed #-}

1581+ yieldProceed nextGen fs =

1582+ initial >>= skip . SplitOnSeqYield fs . nextAfterInit nextGen

1583+

14771584 {-# INLINE_LATE stepOuter #-}

1478− stepOuter _ SplitOnSeqInit =

1479− if patLen == 0

1480− then return $ Skip $ SplitOnSeqEmpty state

1481− else if patLen == 1

1482− then do

1483− acc <- initial

1484− pat <- liftIO $ A.unsafeIndexIO patArr 0

1485− return $ Skip $ SplitOnSeqSingle acc state pat

1486− else if sizeOf (undefined :: a) * patLen

1487− <= sizeOf (undefined :: Word)

1488− then return $ Skip $ SplitOnSeqWordInit state

1489− else do

1490− (rb, rhead) <- liftIO $ RB.new patLen

1491− skip $ SplitOnSeqKRInit 0 state rb rhead

1585+ stepOuter _ SplitOnSeqInit = do

1586+ res <- initial

1587+ case res of

1588+ FL.Partial acc ->

1589+ if patLen == 0

1590+ then return $ Skip $ SplitOnSeqEmpty acc state

1591+ else if patLen == 1

1592+ then do

1593+ pat <- liftIO $ A.unsafeIndexIO patArr 0

1594+ return $ Skip $ SplitOnSeqSingle acc state pat

1595+ else if sizeOf (undefined :: a) * patLen

1596+ <= sizeOf (undefined :: Word)

1597+ then return $ Skip $ SplitOnSeqWordInit acc state

1598+ else do

1599+ (rb, rhead) <- liftIO $ RB.new patLen

1600+ skip $ SplitOnSeqKRInit 0 acc state rb rhead

1601+ FL.Done b -> skip $ SplitOnSeqYield b SplitOnSeqInit

14921602

14931603 stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next

14941604

1605+ ---------------------------

1606+ -- Checkpoint

1607+ ---------------------------

1608+

1609+ stepOuter _ (SplitOnSeqReinit nextGen) =

1610+ initial >>= skip . nextAfterInit nextGen

1611+

14951612 ---------------------------

14961613 -- Empty pattern

14971614 ---------------------------

14981615

1499− stepOuter gst (SplitOnSeqEmpty st) = do

1616+ stepOuter gst (SplitOnSeqEmpty acc st) = do

15001617 res <- step (adaptState gst) st

15011618 case res of

15021619 Yield x s -> do

1503− fs <- initial

1504− r <- fstep fs x

1505− case r of

1506− FL.Partial fs1 -> do

1507− b <- done fs1

1508− skip $ SplitOnSeqYield b (SplitOnSeqEmpty s)

1509− FL.Done b -> skip $ SplitOnSeqYield b (SplitOnSeqEmpty s)

1510−

1511− Skip s -> return $ Skip (SplitOnSeqEmpty s)

1620+ r <- fstep acc x

1621+ b1 <-

1622+ case r of

1623+ FL.Partial acc1 -> done acc1

1624+ FL.Done b -> return b

1625+ let jump c = SplitOnSeqEmpty c s

1626+ in yieldProceed jump b1

1627+ Skip s -> skip (SplitOnSeqEmpty acc s)

15121628 Stop -> return Stop

15131629

15141630 -----------------

@@ -1525,18 +1641,14 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

15251641 res <- step (adaptState gst) st

15261642 case res of

15271643 Yield x s -> do

1644+ let jump c = SplitOnSeqSingle c s pat

15281645 if pat == x

1529− then do

1530− r <- done fs

1531− fs1 <- initial

1532− return $ Skip $ SplitOnSeqYield r (SplitOnSeqSingle fs1 s pat)

1646+ then done fs >>= yieldProceed jump

15331647 else do

15341648 r <- fstep fs x

15351649 case r of

1536− FL.Partial fs1 -> skip $ SplitOnSeqSingle fs1 s pat

1537− FL.Done b -> do

1538− fs1 <- initial

1539− skip $ SplitOnSeqYield b (SplitOnSeqSingle fs1 s pat)

1650+ FL.Partial fs1 -> skip $ jump fs1

1651+ FL.Done b -> yieldProceed jump b

15401652 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

15411653 Stop -> do

15421654 r <- done fs

@@ -1555,11 +1667,10 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

15551667 case r of

15561668 FL.Partial fs1 -> skip $ SplitOnSeqWordDone (n - 1) fs1 wrd

15571669 FL.Done b -> do

1558− fs1 <- initial

1559− let next = SplitOnSeqWordDone (n - 1) fs1 wrd

1560− skip $ SplitOnSeqYield b next

1670+ let jump c = SplitOnSeqWordDone (n - 1) c wrd

1671+ yieldProceed jump b

15611672

1562− stepOuter gst (SplitOnSeqWordInit st0) =

1673+ stepOuter gst (SplitOnSeqWordInit fs st0) =

15631674 go SPEC 0 0 st0

15641675

15651676 where

@@ -1572,17 +1683,14 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

15721683 let wrd1 = addToWord wrd x

15731684 if idx == maxIndex

15741685 then do

1575− fs <- initial

15761686 if wrd1 .&. wordMask == wordPat

15771687 then do

1578− r <- done fs

1579− let next = SplitOnSeqWordInit s

1580− skip $ SplitOnSeqYield r next

1688+ let jump c = SplitOnSeqWordInit c s

1689+ done fs >>= yieldProceed jump

15811690 else skip $ SplitOnSeqWordLoop wrd1 s fs

15821691 else go SPEC (idx + 1) wrd1 s

15831692 Skip s -> go SPEC idx wrd s

15841693 Stop -> do

1585− fs <- initial

15861694 if idx /= 0

15871695 then skip $ SplitOnSeqWordDone idx fs wrd

15881696 else do

@@ -1599,21 +1707,17 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

15991707 res <- step (adaptState gst) st

16001708 case res of

16011709 Yield x s -> do

1602− let wrd1 = addToWord wrd x

1710+ let jump c = SplitOnSeqWordInit c s

1711+ wrd1 = addToWord wrd x

16031712 old = (wordMask .&. wrd)

16041713 `shiftR` (elemBits * (patLen - 1))

16051714 r <- fstep fs (toEnum $ fromIntegral old)

16061715 case r of

16071716 FL.Partial fs1 -> do

16081717 if wrd1 .&. wordMask == wordPat

1609− then do

1610− b <- done fs1

1611− let next = SplitOnSeqWordInit s

1612− skip $ SplitOnSeqYield b next

1718+ then done fs1 >>= yieldProceed jump

16131719 else go SPEC wrd1 s fs1

1614− FL.Done b ->

1615− let next = SplitOnSeqWordInit s

1616− in skip $ SplitOnSeqYield b next

1720+ FL.Done b -> yieldProceed jump b

16171721 Skip s -> go SPEC wrd s fs

16181722 Stop -> skip $ SplitOnSeqWordDone patLen fs wrd

16191723

@@ -1621,7 +1725,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

16211725 -- General Pattern - Karp Rabin

16221726 -------------------------------

16231727

1624− stepOuter gst (SplitOnSeqKRInit idx st rb rh) = do

1728+ stepOuter gst (SplitOnSeqKRInit idx fs st rb rh) = do

16251729 res <- step (adaptState gst) st

16261730 case res of

16271731 Yield x s -> do

@@ -1630,14 +1734,12 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

16301734 then do

16311735 let fold = RB.unsafeFoldRing (RB.ringBound rb)

16321736 let !ringHash = fold addCksum 0 rb

1633− fs <- initial

16341737 if ringHash == patHash

16351738 then skip $ SplitOnSeqKRCheck fs s rb rh1

16361739 else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash

1637− else skip $ SplitOnSeqKRInit (idx + 1) s rb rh1

1638− Skip s -> skip $ SplitOnSeqKRInit idx s rb rh

1740+ else skip $ SplitOnSeqKRInit (idx + 1) fs s rb rh1

1741+ Skip s -> skip $ SplitOnSeqKRInit idx fs s rb rh

16391742 Stop -> do

1640− fs <- initial

16411743 skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)

16421744

16431745 -- XXX The recursive "go" is more efficient than the state based recursion

@@ -1662,9 +1764,10 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

16621764 if cksum1 == patHash

16631765 then skip $ SplitOnSeqKRCheck fs1 s rb rh1

16641766 else go SPEC fs1 s rh1 cksum1

1665− FL.Done b ->

1666− let next = SplitOnSeqKRInit 0 s rb (RB.startOf rb)

1667− in skip $ SplitOnSeqYield b next

1767+ FL.Done b -> do

1768+ let rst = RB.startOf rb

1769+ jump c = SplitOnSeqKRInit 0 c s rb rst

1770+ yieldProceed jump b

16681771 Skip s -> go SPEC fs s rh cksum

16691772 Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh

16701773

@@ -1698,9 +1801,11 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

16981801 if RB.unsafeEqArray rb rh patArr

16991802 then do

17001803 r <- done fs

1701− let next = SplitOnSeqKRInit 0 st rb (RB.startOf rb)

1702− skip $ SplitOnSeqYield r next

1804+ let rst = RB.startOf rb

1805+ jump c = SplitOnSeqKRInit 0 c st rb rst

1806+ yieldProceed jump r

17031807 else skip $ SplitOnSeqKRLoop fs st rb rh patHash

1808+

17041809 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

17051810 r <- done fs

17061811 skip $ SplitOnSeqYield r SplitOnSeqDone

@@ -1711,9 +1816,8 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

17111816 case r of

17121817 FL.Partial fs1 -> skip $ SplitOnSeqKRDone (n - 1) fs1 rb rh1

17131818 FL.Done b -> do

1714− fs1 <- initial

1715− let next = SplitOnSeqKRDone (n - 1) fs1 rb rh1

1716− skip $ SplitOnSeqYield b next

1819+ let jump c = SplitOnSeqKRDone (n - 1) c rb rh1

1820+ yieldProceed jump b

17171821

17181822{-# ANN type SplitOnSuffixSeqState Fuse #-}

17191823data SplitOnSuffixSeqState rb rh ck w fs s b x =

@@ -1721,21 +1825,24 @@ data SplitOnSuffixSeqState rb rh ck w fs s b x =

17211825 | SplitOnSuffixSeqYield b (SplitOnSuffixSeqState rb rh ck w fs s b x)

17221826 | SplitOnSuffixSeqDone

17231827

1724− | SplitOnSuffixSeqEmpty s

1828+ | SplitOnSuffixSeqEmpty !fs s

17251829

1726− | SplitOnSuffixSeqSingleInit s x

1830+ | SplitOnSuffixSeqSingleInit !fs s x

17271831 | SplitOnSuffixSeqSingle !fs s x

17281832

1729− | SplitOnSuffixSeqWordInit s

1833+ | SplitOnSuffixSeqWordInit !fs s

17301834 | SplitOnSuffixSeqWordLoop !w s !fs

17311835 | SplitOnSuffixSeqWordDone Int !fs !w

17321836

1733− | SplitOnSuffixSeqKRInit Int s rb !rh

1837+ | SplitOnSuffixSeqKRInit Int !fs s rb !rh

17341838 | SplitOnSuffixSeqKRInit1 !fs s rb !rh

17351839 | SplitOnSuffixSeqKRLoop fs s rb !rh !ck

17361840 | SplitOnSuffixSeqKRCheck fs s rb !rh

17371841 | SplitOnSuffixSeqKRDone Int !fs rb !rh

17381842

1843+ | SplitOnSuffixSeqReinit

1844+ (fs -> SplitOnSuffixSeqState rb rh ck w fs s b x)

1845+

17391846{-# INLINE_NORMAL splitOnSuffixSeq #-}

17401847splitOnSuffixSeq

17411848 :: forall m a b. (MonadIO m, Storable a, Enum a, Eq a)

@@ -1765,27 +1872,33 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

17651872

17661873 addToWord wd a = (wd `shiftL` elemBits) .|. fromIntegral (fromEnum a)

17671874

1875+ nextAfterInit nextGen stepRes =

1876+ case stepRes of

1877+ FL.Partial s -> nextGen s

1878+ FL.Done b ->

1879+ SplitOnSuffixSeqYield b (SplitOnSuffixSeqReinit nextGen)

1880+

1881+ {-# INLINE yieldProceed #-}

1882+ yieldProceed nextGen fs =

1883+ initial >>= skip . SplitOnSuffixSeqYield fs . nextAfterInit nextGen

1884+

17681885 -- For single element pattern case

17691886 {-# INLINE processYieldSingle #-}

1770− processYieldSingle pat x s fs =

1887+ processYieldSingle pat x s fs = do

1888+ let jump c = SplitOnSuffixSeqSingleInit c s pat

17711889 if pat == x

17721890 then do

17731891 r <- if withSep then fstep fs x else return $ FL.Partial fs

1774− case r of

1775− FL.Partial fs1 -> do

1776− b <- done fs1

1777− let next = SplitOnSuffixSeqSingleInit s pat

1778− skip $ SplitOnSuffixSeqYield b next

1779− FL.Done b ->

1780− let next = SplitOnSuffixSeqSingleInit s pat

1781− in skip $ SplitOnSuffixSeqYield b next

1892+ b1 <-

1893+ case r of

1894+ FL.Partial fs1 -> done fs1

1895+ FL.Done b -> return b

1896+ yieldProceed jump b1

17821897 else do

17831898 r <- fstep fs x

17841899 case r of

17851900 FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat

1786− FL.Done b ->

1787− let next = SplitOnSuffixSeqSingleInit s pat

1788− in skip $ SplitOnSuffixSeqYield b next

1901+ FL.Done b -> yieldProceed jump b

17891902

17901903 -- For Rabin-Karp search

17911904 k = 2891336453 :: Word32

@@ -1802,39 +1915,49 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

18021915 skip = return . Skip

18031916

18041917 {-# INLINE_LATE stepOuter #-}

1805− stepOuter _ SplitOnSuffixSeqInit =

1806− if patLen == 0

1807− then skip $ SplitOnSuffixSeqEmpty state

1808− else if patLen == 1

1809− then do

1810− pat <- liftIO $ A.unsafeIndexIO patArr 0

1811− skip $ SplitOnSuffixSeqSingleInit state pat

1812− else if sizeOf (undefined :: a) * patLen

1813− <= sizeOf (undefined :: Word)

1814− then skip $ SplitOnSuffixSeqWordInit state

1815− else do

1816− (rb, rhead) <- liftIO $ RB.new patLen

1817− skip $ SplitOnSuffixSeqKRInit 0 state rb rhead

1918+ stepOuter _ SplitOnSuffixSeqInit = do

1919+ res <- initial

1920+ case res of

1921+ FL.Partial fs ->

1922+ if patLen == 0

1923+ then skip $ SplitOnSuffixSeqEmpty fs state

1924+ else if patLen == 1

1925+ then do

1926+ pat <- liftIO $ A.unsafeIndexIO patArr 0

1927+ skip $ SplitOnSuffixSeqSingleInit fs state pat

1928+ else if sizeOf (undefined :: a) * patLen

1929+ <= sizeOf (undefined :: Word)

1930+ then skip $ SplitOnSuffixSeqWordInit fs state

1931+ else do

1932+ (rb, rhead) <- liftIO $ RB.new patLen

1933+ skip $ SplitOnSuffixSeqKRInit 0 fs state rb rhead

1934+ FL.Done fb -> skip $ SplitOnSuffixSeqYield fb SplitOnSuffixSeqInit

18181935

18191936 stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next

18201937

1938+ ---------------------------

1939+ -- Reinit

1940+ ---------------------------

1941+

1942+ stepOuter _ (SplitOnSuffixSeqReinit nextGen) =

1943+ initial >>= skip . nextAfterInit nextGen

1944+

18211945 ---------------------------

18221946 -- Empty pattern

18231947 ---------------------------

18241948

1825− stepOuter gst (SplitOnSuffixSeqEmpty st) = do

1949+ stepOuter gst (SplitOnSuffixSeqEmpty acc st) = do

18261950 res <- step (adaptState gst) st

18271951 case res of

18281952 Yield x s -> do

1829− acc <- initial

1953+ let jump c = SplitOnSuffixSeqEmpty c s

18301954 r <- fstep acc x

1831− case r of

1832− FL.Partial fs -> do

1833− b <- done fs

1834− skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

1835− FL.Done b ->

1836− skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

1837− Skip s -> skip (SplitOnSuffixSeqEmpty s)

1955+ b1 <-

1956+ case r of

1957+ FL.Partial fs -> done fs

1958+ FL.Done b -> return b

1959+ yieldProceed jump b1

1960+ Skip s -> skip (SplitOnSuffixSeqEmpty acc s)

18381961 Stop -> return Stop

18391962

18401963 -----------------

@@ -1847,11 +1970,11 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

18471970 -- Single Pattern

18481971 -----------------

18491972

1850− stepOuter gst (SplitOnSuffixSeqSingleInit st pat) = do

1973+ stepOuter gst (SplitOnSuffixSeqSingleInit fs st pat) = do

18511974 res <- step (adaptState gst) st

18521975 case res of

1853− Yield x s -> initial >>= processYieldSingle pat x s

1854− Skip s -> skip $ SplitOnSuffixSeqSingleInit s pat

1976+ Yield x s -> processYieldSingle pat x s fs

1977+ Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat

18551978 Stop -> return Stop

18561979

18571980 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

@@ -1876,23 +1999,21 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

18761999 case r of

18772000 FL.Partial fs1 -> skip $ SplitOnSuffixSeqWordDone (n - 1) fs1 wrd

18782001 FL.Done b -> do

1879− fs1 <- initial

1880− let next = SplitOnSuffixSeqWordDone (n - 1) fs1 wrd

1881− skip $ SplitOnSuffixSeqYield b next

2002+ let jump c = SplitOnSuffixSeqWordDone (n - 1) c wrd

2003+ yieldProceed jump b

18822004

1883− stepOuter gst (SplitOnSuffixSeqWordInit st0) = do

2005+ stepOuter gst (SplitOnSuffixSeqWordInit fs0 st0) = do

18842006 res <- step (adaptState gst) st0

18852007 case res of

18862008 Yield x s -> do

1887− fs <- initial

18882009 let wrd = addToWord 0 x

1889− r <- if withSep then fstep fs x else return $ FL.Partial fs

2010+ r <- if withSep then fstep fs0 x else return $ FL.Partial fs0

18902011 case r of

18912012 FL.Partial fs1 -> go SPEC 1 wrd s fs1

18922013 FL.Done b -> do

1893− let next = SplitOnSuffixSeqWordInit s

1894− in skip $ SplitOnSuffixSeqYield b next

1895− Skip s -> skip (SplitOnSuffixSeqWordInit s)

2014+ let jump c = SplitOnSuffixSeqWordInit c s

2015+ yieldProceed jump b

2016+ Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)

18962017 Stop -> return Stop

18972018

18982019 where

@@ -1902,6 +2023,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

19022023 res <- step (adaptState gst) st

19032024 case res of

19042025 Yield x s -> do

2026+ let jump c = SplitOnSuffixSeqWordInit c s

19052027 let wrd1 = addToWord wrd x

19062028 r <- if withSep then fstep fs x else return $ FL.Partial fs

19072029 case r of

@@ -1910,13 +2032,8 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

19102032 then go SPEC (idx + 1) wrd1 s fs1

19112033 else if wrd1 .&. wordMask /= wordPat

19122034 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

1913− else do

1914− b <- done fs

1915− let next = SplitOnSuffixSeqWordInit s

1916− skip $ SplitOnSuffixSeqYield b next

1917− FL.Done b ->

1918− let next = SplitOnSuffixSeqWordInit s

1919− in skip $ SplitOnSuffixSeqYield b next

2035+ else do done fs >>= yieldProceed jump

2036+ FL.Done b -> yieldProceed jump b

19202037 Skip s -> go SPEC idx wrd s fs

19212038 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

19222039

@@ -1930,7 +2047,8 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

19302047 res <- step (adaptState gst) st

19312048 case res of

19322049 Yield x s -> do

1933− let wrd1 = addToWord wrd x

2050+ let jump c = SplitOnSuffixSeqWordInit c s

2051+ wrd1 = addToWord wrd x

19342052 old = (wordMask .&. wrd)

19352053 `shiftR` (elemBits * (patLen - 1))

19362054 r <-

@@ -1940,14 +2058,9 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

19402058 case r of

19412059 FL.Partial fs1 ->

19422060 if wrd1 .&. wordMask == wordPat

1943− then do

1944− b <- done fs1

1945− let next = SplitOnSuffixSeqWordInit s

1946− skip $ SplitOnSuffixSeqYield b next

2061+ then done fs1 >>= yieldProceed jump

19472062 else go SPEC wrd1 s fs1

1948− FL.Done b ->

1949− let next = SplitOnSuffixSeqWordInit s

1950− in skip $ SplitOnSuffixSeqYield b next

2063+ FL.Done b -> yieldProceed jump b

19512064 Skip s -> go SPEC wrd s fs

19522065 Stop ->

19532066 if wrd .&. wordMask == wordPat

@@ -1962,20 +2075,20 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

19622075 -- General Pattern - Karp Rabin

19632076 -------------------------------

19642077

1965− stepOuter gst (SplitOnSuffixSeqKRInit idx0 st0 rb rh0) = do

2078+ stepOuter gst (SplitOnSuffixSeqKRInit idx0 fs st0 rb rh0) = do

19662079 res <- step (adaptState gst) st0

19672080 case res of

19682081 Yield x s -> do

19692082 rh1 <- liftIO $ RB.unsafeInsert rb rh0 x

1970− fs <- initial

19712083 r <- if withSep then fstep fs x else return $ FL.Partial fs

19722084 case r of

19732085 FL.Partial fs1 ->

19742086 skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1

1975− FL.Done b ->

1976− let next = SplitOnSuffixSeqKRInit 0 s rb (RB.startOf rb)

1977− in skip $ SplitOnSuffixSeqYield b next

1978− Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 s rb rh0

2087+ FL.Done b -> do

2088+ let rst = RB.startOf rb

2089+ jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

2090+ yieldProceed jump b

2091+ Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0

19792092 Stop -> return Stop

19802093

19812094 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

@@ -2000,10 +2113,10 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

20002113 then SplitOnSuffixSeqKRCheck fs1 s rb rh1

20012114 else SplitOnSuffixSeqKRLoop

20022115 fs1 s rb rh1 ringHash

2003− FL.Done b ->

2004− let next = SplitOnSuffixSeqKRInit

2005− 0 st rb (RB.startOf rb)

2006− in skip $ SplitOnSuffixSeqYield b next

2116+ FL.Done b -> do

2117+ let rst = RB.startOf rb

2118+ jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

2119+ yieldProceed jump b

20072120 Skip s -> go SPEC idx rh s fs

20082121 Stop -> do

20092122 -- do not issue a blank segment when we end at pattern

@@ -2033,10 +2146,10 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

20332146 if (cksum1 /= patHash)

20342147 then go SPEC fs1 s rh1 cksum1

20352148 else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1

2036− FL.Done b ->

2037− let next = SplitOnSuffixSeqKRInit

2038− 0 st rb (RB.startOf rb)

2039− in skip $ SplitOnSuffixSeqYield b next

2149+ FL.Done b -> do

2150+ let rst = RB.startOf rb

2151+ jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

2152+ yieldProceed jump b

20402153 Skip s -> go SPEC fs s rh cksum

20412154 Stop ->

20422155 if RB.unsafeEqArray rb rh patArr

@@ -2051,8 +2164,9 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

20512164 if RB.unsafeEqArray rb rh patArr

20522165 then do

20532166 r <- done fs

2054− let next = SplitOnSuffixSeqKRInit 0 st rb (RB.startOf rb)

2055− skip $ SplitOnSuffixSeqYield r next

2167+ let rst = RB.startOf rb

2168+ jump c = SplitOnSuffixSeqKRInit 0 c st rb rst

2169+ yieldProceed jump r

20562170 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

20572171

20582172 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

@@ -2065,9 +2179,8 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

20652179 case r of

20662180 FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

20672181 FL.Done b -> do

2068− fs1 <- initial

2069− let next = SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

2070− skip $ SplitOnSuffixSeqYield b next

2182+ let jump c = SplitOnSuffixSeqKRDone (n - 1) c rb rh1

2183+ yieldProceed jump b

20712184

20722185------------------------------------------------------------------------------

20732186-- Nested Container Transformation

src/Streamly/Internal/Data/Stream/StreamD/Transform.hs+59−22

@@ -258,12 +258,15 @@ tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

258258 where

259259

260260 step' _ TapInit = do

261− r <- initial

262− return $ Skip (Tapping r state)

261+ res <- initial

262+ return

263+ $ Skip

264+ $ case res of

265+ FL.Partial s -> Tapping s state

266+ FL.Done _ -> TapDone state

263267 step' gst (Tapping acc st) = do

264268 r <- step gst st

265269 case r of

266− -- XXX Abstract Yield?

267270 Yield x s -> do

268271 res <- fstep acc x

269272 return

@@ -299,8 +302,12 @@ tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

299302

300303 {-# INLINE_LATE step' #-}

301304 step' _ TapOffInit = do

302− r <- initial

303− return $ Skip $ TapOffTapping r state (offset `mod` n)

305+ res <- initial

306+ return

307+ $ Skip

308+ $ case res of

309+ FL.Partial s -> TapOffTapping s state (offset `mod` n)

310+ FL.Done _ -> TapOffDone state

304311 step' gst (TapOffTapping acc st count) = do

305312 r <- step gst st

306313 case r of

@@ -478,35 +485,65 @@ tapAsync f (Stream step1 state1) = Stream step TapInit

478485-- Scanning with a Fold

479486------------------------------------------------------------------------------

480487

481−data PostScanState s f = PostScan s !f

488+data ScanState s f = ScanInit s | ScanDo s !f | ScanDone

482489

483490{-# INLINE_NORMAL postscanOnce #-}

484491postscanOnce :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b

485−postscanOnce (FL.Fold fstep begin done) (Stream step state) =

486− Stream step' (PostScan state begin)

492+postscanOnce (FL.Fold fstep initial extract) (Stream sstep state) =

493+ Stream step (ScanInit state)

487494

488495 where

489496

490− {-# INLINE_LATE step' #-}

491− step' gst (PostScan st acc) = do

492− r <- step (adaptState gst) st

493− case r of

497+ {-# INLINE_LATE step #-}

498+ step _ (ScanInit st) = do

499+ res <- initial

500+ return

501+ $ case res of

502+ FL.Partial fs -> Skip $ ScanDo st fs

503+ FL.Done b -> Yield b ScanDone

504+ step gst (ScanDo st fs) = do

505+ res <- sstep (adaptState gst) st

506+ case res of

494507 Yield x s -> do

495− old <- acc

496− res <- fstep old x

497− case res of

498− FL.Partial fs -> do

499− !v <- done fs

500− return $ Yield v $ PostScan s (return fs)

501− FL.Done _ -> return Stop

502− Skip s -> return $ Skip $ PostScan s acc

508+ r <- fstep fs x

509+ case r of

510+ FL.Partial fs1 -> do

511+ !b <- extract fs1

512+ return $ Yield b $ ScanDo s fs1

513+ FL.Done b -> return $ Yield b ScanDone

514+ Skip s -> return $ Skip $ ScanDo s fs

503515 Stop -> return Stop

516+ step _ ScanDone = return Stop

504517

505518{-# INLINE scanOnce #-}

506519scanOnce :: Monad m

507520 => FL.Fold m a b -> Stream m a -> Stream m b

508−scanOnce fld@(FL.Fold _ begin done) s =

509− (begin >>= \x -> x `seq` done x) `consM` postscanOnce fld s

521+scanOnce (FL.Fold fstep initial extract) (Stream sstep state) =

522+ Stream step (ScanInit state)

523+

524+ where

525+

526+ {-# INLINE_LATE step #-}

527+ step _ (ScanInit st) = do

528+ res <- initial

529+ case res of

530+ FL.Partial fs -> do

531+ !b <- extract fs

532+ return $ Yield b $ ScanDo st fs

533+ FL.Done b -> return $ Yield b ScanDone

534+ step gst (ScanDo st fs) = do

535+ res <- sstep (adaptState gst) st

536+ case res of

537+ Yield x s -> do

538+ r <- fstep fs x

539+ case r of

540+ FL.Partial fs1 -> do

541+ !b <- extract fs1

542+ return $ Yield b $ ScanDo s fs1

543+ FL.Done b -> return $ Yield b ScanDone

544+ Skip s -> return $ Skip $ ScanDo s fs

545+ Stop -> return Stop

546+ step _ ScanDone = return Stop

510547

511548------------------------------------------------------------------------------

512549-- Scanning - Prescans

src/Streamly/Internal/Data/Stream/StreamD/Type.hs+76−26

@@ -388,8 +388,11 @@ toStreamD = fromStreamK . K.toStream

388388

389389{-# INLINE_NORMAL foldOnce #-}

390390foldOnce :: (Monad m) => Fold m a b -> Stream m a -> m b

391−foldOnce (Fold fstep begin done) (Stream step state) =

392− begin >>= \x -> go SPEC x state

391+foldOnce (Fold fstep begin done) (Stream step state) = do

392+ res <- begin

393+ case res of

394+ FL.Partial fs -> go SPEC fs state

395+ FL.Done fb -> return fb

393396

394397 where

395398

@@ -942,6 +945,15 @@ data GroupState s fs b a

942945 | GroupYield b (GroupState s fs b a)

943946 | GroupFinish

944947

948+-- | This is the stream equivalent of "Data.Fold.Internal.many". The fold

949+-- may consume 0 or more elements. It means:

950+--

951+-- * If the stream is empty the default value of the fold would still be

952+-- emitted in the output.

953+-- * At the end of the stream if the last application of the fold did not

954+-- receive any input it would still yield the default fold accumulator as the

955+-- last value.

956+--

945957{-# INLINE_NORMAL foldMany #-}

946958foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b

947959foldMany (Fold fstep initial extract) (Stream step state) =

@@ -951,16 +963,21 @@ foldMany (Fold fstep initial extract) (Stream step state) =

951963

952964 {-# INLINE_LATE step' #-}

953965 step' _ (GroupStart st) = do

954− -- fs = fold state

955− fs <- initial

956− return $ Skip (GroupBuffer st fs)

966+ r <- initial

967+ return

968+ $ Skip

969+ $ case r of

970+ FL.Done b -> GroupYield b (GroupStart st)

971+ FL.Partial fs -> GroupBuffer st fs

957972 -- This state is not strictly required but it helps the compiler fuse the

958973 -- code.

959974 step' _ (GroupConsume st fs x) = do

960− fs' <- fstep fs x

961− case fs' of

962− FL.Done b -> return $ Skip (GroupYield b (GroupStart st))

963− FL.Partial ps -> return $ Skip (GroupBuffer st ps)

975+ r <- fstep fs x

976+ return

977+ $ Skip

978+ $ case r of

979+ FL.Done b -> GroupYield b (GroupStart st)

980+ FL.Partial fs1 -> GroupBuffer st fs1

964981 step' gst (GroupBuffer st fs) = do

965982 r <- step (adaptState gst) st

966983 case r of

@@ -972,37 +989,70 @@ foldMany (Fold fstep initial extract) (Stream step state) =

972989 step' _ (GroupYield b next) = return $ Yield b next

973990 step' _ GroupFinish = return Stop

974991

992+{-# ANN type FoldMany1 Fuse #-}

993+data FoldMany1 s fs b a

994+ = FoldMany1Start s

995+ | FoldMany1First fs s

996+ | FoldMany1Consume s fs a

997+ | FoldMany1Gen s fs

998+ | FoldMany1Yield b (FoldMany1 s fs b a)

999+ | FoldMany1Done

1000+

1001+-- | Like 'foldMany' except that the fold consumes 1 or more elements. It

1002+-- means:

1003+--

1004+-- * If the stream is empty the output would be empty.

1005+-- * At the end of the stream if the last application of the fold did not

1006+-- receive any input it would not result in any output.

1007+--

1008+-- @foldMany1 f = parseMany (fromFold f)@

1009+--

1010+-- This could be problematic unless we use an accumulator fold instead of a

1011+-- terminating fold. A terminating fold may terminate even without accepting a

1012+-- single element. We can use parseMany instead where we can return the input

1013+-- if the fold terminates without accepting any input. The alternative is to

1014+-- always execute the fold's initial action and discard it in case the stream

1015+-- stops without actually feeding input to it.

1016+--

9751017{-# INLINE_NORMAL foldMany1 #-}

9761018foldMany1 :: Monad m => Fold m a b -> Stream m a -> Stream m b

9771019foldMany1 (Fold fstep initial extract) (Stream step state) =

978− Stream step' (GroupStart state)

1020+ Stream step' (FoldMany1Start state)

9791021

9801022 where

9811023

9821024 {-# INLINE_LATE step' #-}

983− step' gst (GroupStart st) = do

1025+ step' _ (FoldMany1Start st) = do

1026+ r <- initial

1027+ return

1028+ $ Skip

1029+ $ case r of

1030+ FL.Done b -> FoldMany1Yield b (FoldMany1Start st)

1031+ FL.Partial fs -> FoldMany1First fs st

1032+ step' gst (FoldMany1First fs st) = do

9841033 r <- step (adaptState gst) st

9851034 case r of

9861035 Yield x s -> do

987− fi <- initial

988− return $ Skip $ GroupConsume s fi x

989− Skip s -> return $ Skip (GroupStart s)

990− Stop -> return $ Stop

991− step' _ (GroupConsume st fs x) = do

992− fs' <- fstep fs x

993− case fs' of

994− FL.Done b -> return $ Skip (GroupYield b (GroupStart st))

995− FL.Partial ps -> return $ Skip (GroupBuffer st ps)

996− step' gst (GroupBuffer st fs) = do

1036+ return $ Skip $ FoldMany1Consume s fs x

1037+ Skip s -> return $ Skip (FoldMany1Start s)

1038+ Stop -> return Stop

1039+ step' _ (FoldMany1Consume st fs x) = do

1040+ r <- fstep fs x

1041+ return

1042+ $ Skip

1043+ $ case r of

1044+ FL.Done b -> FoldMany1Yield b (FoldMany1Start st)

1045+ FL.Partial fs1 -> FoldMany1Gen st fs1

1046+ step' gst (FoldMany1Gen st fs) = do

9971047 r <- step (adaptState gst) st

9981048 case r of

999− Yield x s -> return $ Skip $ GroupConsume s fs x

1000− Skip s -> return $ Skip (GroupBuffer s fs)

1049+ Yield x s -> return $ Skip $ FoldMany1Consume s fs x

1050+ Skip s -> return $ Skip (FoldMany1Gen s fs)

10011051 Stop -> do

10021052 b <- extract fs

1003− return $ Skip (GroupYield b GroupFinish)

1004− step' _ (GroupYield b next) = return $ Yield b next

1005− step' _ GroupFinish = return Stop

1053+ return $ Skip (FoldMany1Yield b FoldMany1Done)

1054+ step' _ (FoldMany1Yield b next) = return $ Yield b next

1055+ step' _ FoldMany1Done = return Stop

10061056

10071057data GroupState2 s fs

10081058 = GroupStart2 s

src/Streamly/Internal/Data/Stream/StreamK.hs+10−7

@@ -436,19 +436,22 @@ foldlMx' step begin done m = go begin m

436436

437437{-# INLINABLE foldOnce #-}

438438foldOnce :: (IsStream t, Monad m) => FL.Fold m a b -> t m a -> m b

439−foldOnce (FL.Fold step begin done) = go begin

439+foldOnce (FL.Fold step begin done) m = do

440+ res <- begin

441+ case res of

442+ FL.Partial fs -> go fs m

443+ FL.Done fb -> return fb

444+

440445 where

441446 go !acc m1 =

442− let stop = acc >>= done

443− single a = acc

444− >>= \b -> step b a

447+ let stop = done acc

448+ single a = step acc a

445449 >>= \case

446450 FL.Partial s -> done s

447451 FL.Done b1 -> return b1

448− yieldk a r = acc

449− >>= \b -> step b a

452+ yieldk a r = step acc a

450453 >>= \case

451− FL.Partial s -> go (return s) r

454+ FL.Partial s -> go s r

452455 FL.Done b1 -> return b1

453456 in foldStream defState yieldk single stop m1

454457

src/Streamly/Internal/Data/Unfold.hs+5−2

@@ -276,8 +276,11 @@ swap = lmap Tuple.swap

276276--

277277{-# INLINE_NORMAL fold #-}

278278fold :: Monad m => Unfold m a b -> Fold m b c -> a -> m c

279−fold (Unfold ustep inject) (Fold fstep initial extract) a =

280− initial >>= \x -> inject a >>= go SPEC x

279+fold (Unfold ustep inject) (Fold fstep initial extract) a = do

280+ res <- initial

281+ case res of

282+ FL.Partial x -> inject a >>= go SPEC x

283+ FL.Done b -> return b

281284

282285 where

283286

src/Streamly/Internal/FileSystem/File.hs+5−2

@@ -357,13 +357,16 @@ writeChunks path = Fold step initial extract

357357 h <- liftIO (openFile path WriteMode)

358358 fld <- FL.initialize (FH.writeChunks h)

359359 `MC.onException` liftIO (hClose h)

360− return (fld, h)

360+ return $ FL.Partial (fld, h)

361361 step (fld, h) x = do

362362 r <- FL.runStep fld x `MC.onException` liftIO (hClose h)

363363 return $ FL.Partial (r, h)

364364 extract (Fold _ initial1 extract1, h) = do

365365 liftIO $ hClose h

366− initial1 >>= extract1

366+ res <- initial1

367+ case res of

368+ FL.Partial fs -> extract1 fs

369+ FL.Done fb -> return fb

367370

368371-- | @writeWithBufferOf chunkSize handle@ writes the input stream to @handle@.

369372-- Bytes in the input stream are collected into a buffer until we have a chunk

src/Streamly/Internal/Network/Inet/TCP.hs+5−2

@@ -357,13 +357,16 @@ writeChunks addr port = Fold step initial extract

357357 initial = do

358358 skt <- liftIO (connect addr port)

359359 fld <- FL.initialize (SK.writeChunks skt) `MC.onException` liftIO (Net.close skt)

360− return (Tuple' fld skt)

360+ return $ FL.Partial (Tuple' fld skt)

361361 step (Tuple' fld skt) x = do

362362 r <- FL.runStep fld x `MC.onException` liftIO (Net.close skt)

363363 return $ FL.Partial (Tuple' r skt)

364364 extract (Tuple' (Fold _ initial1 extract1) skt) = do

365365 liftIO $ Net.close skt

366− initial1 >>= extract1

366+ res <- initial1

367+ case res of

368+ FL.Partial fs -> extract1 fs

369+ FL.Done fb -> return fb

367370

368371-- | Like 'write' but provides control over the write buffer. Output will

369372-- be written to the IO device as soon as we collect the specified number of

test/Streamly/Test/Data/Parser.hs+19−30

@@ -7,7 +7,7 @@ import Test.Hspec (Spec, hspec, describe)

77import Test.Hspec.QuickCheck

88import Test.QuickCheck

99 (arbitrary, forAll, elements, Property, property, listOf,

10− vectorOf, Gen, suchThat)

10+ vectorOf, Gen)

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

1212

1313import Prelude hiding (sequence)

@@ -490,9 +490,9 @@ many :: Property

490490many =

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

492492 let fldstp conL currL = return $ FL.Partial $ conL ++ currL

493− concatFold = FL.Fold fldstp (return []) return

494− prsr = P.many concatFold

495− $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

493+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return

494+ prsr =

495+ P.many concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

496496 in

497497 case S.parse prsr (S.fromList ls) of

498498 Right res_list -> checkListEqual res_list

@@ -510,13 +510,10 @@ some =

510510 forAll (listOf (chooseInt (0, 1))) $ \genLs ->

511511 let

512512 ls = 0 : genLs

513− concatFold = FL.Fold

514− (\concatList curr_list ->

515− return $ FL.Partial $ concatList ++ curr_list)

516− (return [])

517− return

518− prsr = P.some concatFold

519− $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

513+ fldstp conL currL = return $ FL.Partial $ conL ++ currL

514+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return

515+ prsr =

516+ P.some concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

520517 in

521518 case S.parse prsr (S.fromList ls) of

522519 Right res_list -> res_list == Prelude.filter (== 0) ls

@@ -532,11 +529,9 @@ some =

532529-- Instances

533530-------------------------------------------------------------------------------

534531

535−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

536−-- fixed.

537532applicative :: Property

538533applicative =

539− forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->

534+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

540535 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

541536 let parser =

542537 (,)

@@ -548,32 +543,26 @@ applicative =

548543 listEquals (==) olist1 list1

549544 listEquals (==) olist2 list2

550545

551−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

552−-- fixed.

553546sequence :: Property

554547sequence =

555− forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat`

556− (\x -> length x > 0))) $ \ ins ->

557− let p xs = P.fromFold (FL.ltake (length xs) FL.toList)

558− in monadicIO $ do

548+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->

549+ let p xs = P.fromFold (FL.ltake (length xs) FL.toList)

550+ in monadicIO $ do

559551 outs <- run $

560552 S.parse

561553 (Prelude.sequence $ fmap p ins)

562554 (S.fromList $ concat ins)

563555 listEquals (==) outs ins

564556

565−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

566−-- fixed.

567557monad :: Property

568558monad =

569− forAll (listOf (chooseAny :: Gen Int) `suchThat`

570− (\x -> length x > 0)) $ \ list1 ->

571− forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

572− let parser = do

573− olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)

574− olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)

575− return (olist1, olist2)

576− in monadicIO $ do

559+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

560+ forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

561+ let parser = do

562+ olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)

563+ olist2 <- P.fromFold (FL.ltake (length list2) FL.toList)

564+ return (olist1, olist2)

565+ in monadicIO $ do

577566 (olist1, olist2) <-

578567 run $ S.parse parser (S.fromList $ list1 ++ list2)

579568 listEquals (==) olist1 list1

test/Streamly/Test/Data/Parser/ParserD.hs+12−14

@@ -7,7 +7,7 @@ import Test.Hspec (Spec, hspec, describe)

77import Test.Hspec.QuickCheck

88import Test.QuickCheck

99 (arbitrary, forAll, elements, Property,

10− property, listOf, vectorOf, (.&&.), Gen, suchThat)

10+ property, listOf, vectorOf, (.&&.), Gen)

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

1212

1313import qualified Data.List as List

@@ -492,8 +492,10 @@ many =

492492 $ \ls ->

493493 let fldstp conL currL = return $ FL.Partial (conL ++ currL)

494494 concatFold =

495− FL.Fold fldstp (return []) return

496− prsr = P.many concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

495+ FL.Fold fldstp (return (FL.Partial [])) return

496+ prsr =

497+ P.many concatFold

498+ $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

497499 in case S.parseD prsr (S.fromList ls) of

498500 Right res_list ->

499501 checkListEqual res_list (Prelude.filter (== 0) ls)

@@ -510,8 +512,10 @@ some =

510512 forAll (listOf (chooseInt (0, 1)))

511513 $ \ls ->

512514 let fldstp conL currL = return $ FL.Partial $ conL ++ currL

513− concatFold = FL.Fold fldstp (return []) return

514− prsr = P.some concatFold $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

515+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return

516+ prsr =

517+ P.some concatFold

518+ $ P.fromFold $ FL.sliceSepBy (== 1) FL.toList

515519 in case S.parseD prsr (S.fromList ls) of

516520 Right res_list -> res_list == Prelude.filter (== 0) ls

517521 Left _ -> False

@@ -526,11 +530,9 @@ someFail =

526530-- Instances

527531-------------------------------------------------------------------------------

528532

529−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

530−-- fixed.

531533applicative :: Property

532534applicative =

533− forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->

535+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

534536 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

535537 let parser =

536538 (,)

@@ -542,11 +544,9 @@ applicative =

542544 listEquals (==) olist1 list1

543545 listEquals (==) olist2 list2

544546

545−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

546−-- fixed.

547547sequence :: Property

548548sequence =

549− forAll (vectorOf 11 (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0))) $ \ ins ->

549+ forAll (vectorOf 11 (listOf (chooseAny :: Gen Int))) $ \ ins ->

550550 let parsers = fmap (\xs -> P.fromFold $ FL.ltake (length xs) FL.toList) ins

551551 in monadicIO $ do

552552 outs <- run $

@@ -555,11 +555,9 @@ sequence =

555555 (S.fromList $ concat ins)

556556 listEquals (==) outs ins

557557

558−-- XXX Remove "`suchThat` (\x -> length x > 0)) $ \ list1 ->" once FL.ltake is

559−-- fixed.

560558monad :: Property

561559monad =

562− forAll (listOf (chooseAny :: Gen Int) `suchThat` (\x -> length x > 0)) $ \ list1 ->

560+ forAll (listOf (chooseAny :: Gen Int)) $ \ list1 ->

563561 forAll (listOf (chooseAny :: Gen Int)) $ \ list2 ->

564562 let parser = do

565563 olist1 <- P.fromFold (FL.ltake (length list1) FL.toList)

test/lib/Streamly/Test/Prelude/Common.hs+2−2

@@ -1168,8 +1168,8 @@ transformCombineOpsCommon constr desc eq t = do

11681168 withMaxSuccess maxTestCount $

11691169 monadicIO $ do

11701170 cref <- run $ newIORef 0

1171− let fldstp _ e = FL.Partial <$> modifyIORef' cref (e+)

1172− sumfoldinref = FL.Fold fldstp (return ()) (const $ return ())

1171+ let fldstp _ e = modifyIORef' cref (e +)

1172+ sumfoldinref = FL.mkAccumM_ fldstp (return ())

11731173 op = S.tap sumfoldinref . S.mapM (\x -> return (x+1))

11741174 listOp = fmap (+1)

11751175 stream <- run ((S.toList . t) $ op (constr a <> constr b))