32390c5 · streamly · git.iko.soy

git.iko.soy/streamly

Add a finalizer action in Fold type

This was needed especially for concurrent fold combinators. A fold combinator that uses concurrent folds needs to wait for the concurrent folds to finish before it can finish. The finalizing action in folds can deallocate any resources allocated by the "initial" action and also wait for folds that it has initialized. This complicates fold combinators in general. We can potentially introduce a type for non-failing parsers and support finalization only in those. The current use cases can be covered by that. Parsers do not support scanning, which is not required in the use cases where we need finalization (there is no known use case).

commit32390c592e80c680840eb9951f5b6eaf2802e5ea authorHarendra Kumar <harendra@composewell.com> dateTue 23 May 2023, 22:51 (3 years ago) parent0ed37ff

36 files changed+762−477

compare with master

unifiedsplit

benchmark/Streamly/Benchmark/Data/Parser.hs+2−2

@@ -348,7 +348,7 @@ split_ value =

348348-- PR.dropWhile (<= (value * 1 `div` 4)) *> PR.die "alt"

349349{-# INLINE takeWhileFail #-}

350350takeWhileFail :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

351−takeWhileFail predicate (Fold fstep finitial fextract) =

351+takeWhileFail predicate (Fold fstep finitial _ ffinal) =

352352 Parser step initial extract

353353

354354 where

@@ -369,7 +369,7 @@ takeWhileFail predicate (Fold fstep finitial fextract) =

369369 Fold.Done b -> Done 0 b

370370 else return $ Error "fail"

371371

372− extract s = fmap (Done 0) (fextract s)

372+ extract s = fmap (Done 0) (ffinal s)

373373

374374{-# INLINE alt2 #-}

375375alt2 :: Monad m

benchmark/Streamly/Benchmark/Data/ParserK.hs+2−2

@@ -213,7 +213,7 @@ sequence_ value =

213213

214214{-# INLINE takeWhileFailD #-}

215215takeWhileFailD :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

216−takeWhileFailD predicate (Fold fstep finitial fextract) =

216+takeWhileFailD predicate (Fold fstep finitial _ ffinal) =

217217 Parser step initial extract

218218

219219 where

@@ -234,7 +234,7 @@ takeWhileFailD predicate (Fold fstep finitial fextract) =

234234 Fold.Done b -> Done 0 b

235235 else return $ Error "fail"

236236

237− extract s = fmap (Done 0) (fextract s)

237+ extract s = fmap (Done 0) (ffinal s)

238238

239239{-# INLINE takeWhileFail #-}

240240takeWhileFail :: CONSTRAINT =>

benchmark/Streamly/Benchmark/Unicode/Stream.hs+18−1

@@ -11,6 +11,11 @@

1111{-# LANGUAGE CPP #-}

1212{-# LANGUAGE ScopedTypeVariables #-}

1313

14+#undef FUSION_CHECK

15+#ifdef FUSION_CHECK

16+{-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all #-}

17+#endif

18+

1419#ifdef __HADDOCK_VERSION__

1520#undef INSPECTION

1621#endif

@@ -280,7 +285,8 @@ _copyStreamUtf8'Fold :: Handle -> Handle -> IO ()

280285_copyStreamUtf8'Fold inh outh =

281286 Stream.fold (Handle.write outh)

282287 $ Unicode.encodeUtf8

283− $ Stream.foldMany Unicode.writeCharUtf8'

288+ $ Stream.catRights

289+ $ Stream.parseMany Unicode.writeCharUtf8'

284290 $ Stream.unfold Handle.reader inh

285291

286292{-# NOINLINE _copyStreamUtf8Parser #-}

@@ -317,6 +323,7 @@ o_1_space_decode_encode_read env =

317323

318324main :: IO ()

319325main = do

326+#ifndef FUSION_CHECK

320327 env <- mkHandleBenchEnv

321328 defaultMain (allBenchmarks env)

322329

@@ -329,3 +336,13 @@ main = do

329336 , o_1_space_decode_encode_read env

330337 ]

331338 ]

339+#else

340+ -- Enable FUSION_CHECK macro at the beginning of the file

341+ -- Enable one benchmark below, and run the benchmark

342+ -- Check the .dump-simpl output

343+ env <- mkHandleBenchEnv

344+ let mkHandles (RefHandles {bigInH = inh, outputH = outh}) = Handles inh outh

345+ (Handles inh outh) <- getHandles env mkHandles

346+ copyStreamLatin1' inh outh

347+ return ()

348+#endif

benchmark/lib/Streamly/Benchmark/Common/Handle.hs+2

@@ -30,6 +30,8 @@ module Streamly.Benchmark.Common.Handle

3030 , isSpace

3131 , isSp

3232 , mkHandleBenchEnv

33+ , Handles(..)

34+ , getHandles

3335 )

3436where

3537

core/src/Streamly/Internal/Data/Array.hs+1−1

@@ -258,7 +258,7 @@ writeLastN ::

258258 (Storable a, Unbox a, MonadIO m) => Int -> Fold m a (Array a)

259259writeLastN n

260260 | n <= 0 = fmap (const mempty) FL.drain

261− | otherwise = A.unsafeFreeze <$> Fold step initial done

261+ | otherwise = A.unsafeFreeze <$> Fold step initial done done

262262

263263 where

264264

core/src/Streamly/Internal/Data/Array/Type.hs+2−1

@@ -596,10 +596,11 @@ pinnedWrite = fmap unsafeFreeze MA.pinnedWrite

596596--

597597{-# INLINE unsafeMakePure #-}

598598unsafeMakePure :: Monad m => Fold IO a b -> Fold m a b

599−unsafeMakePure (Fold step initial extract) =

599+unsafeMakePure (Fold step initial extract final) =

600600 Fold (\x a -> return $! unsafeInlineIO (step x a))

601601 (return $! unsafePerformIO initial)

602602 (\s -> return $! unsafeInlineIO $ extract s)

603+ (\s -> return $! unsafeInlineIO $ final s)

603604

604605-- | Convert a pure stream in Identity monad to an immutable array.

605606--

core/src/Streamly/Internal/Data/Fold/Chunked.hs+4−2

@@ -103,8 +103,8 @@ newtype ChunkFold m a b = ChunkFold (ParserD.Parser (Array a) m b)

103103{-# INLINE fromFold #-}

104104fromFold :: forall m a b. (MonadIO m, Unbox a) =>

105105 Fold.Fold m a b -> ChunkFold m a b

106−fromFold (Fold.Fold fstep finitial fextract) =

107− ChunkFold (ParserD.Parser step initial (fmap (Done 0) . fextract))

106+fromFold (Fold.Fold fstep finitial _ ffinal) =

107+ ChunkFold (ParserD.Parser step initial extract)

108108

109109 where

110110

@@ -134,6 +134,8 @@ fromFold (Fold.Fold fstep finitial fextract) =

134134 Fold.Partial fs1 ->

135135 goArray SPEC next fs1

136136

137+ extract = fmap (Done 0) . ffinal

138+

137139-- | Convert an element 'ParserD.Parser' into an array stream fold. If the

138140-- parser fails the fold would throw an exception.

139141--

core/src/Streamly/Internal/Data/Fold/Combinators.hs+87−51

@@ -443,8 +443,8 @@ trace f = lmapM (tracing f)

443443-- /Pre-release/

444444{-# INLINE transform #-}

445445transform :: Monad m => Pipe m a b -> Fold m b c -> Fold m a c

446−transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =

447− Fold step initial extract

446+transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract ffinal) =

447+ Fold step initial extract final

448448

449449 where

450450

@@ -477,10 +477,14 @@ transform (Pipe pstep1 pstep2 pinitial) (Fold fstep finitial fextract) =

477477

478478 extract (Tuple' _ fs) = fextract fs

479479

480+ final (Tuple' _ fs) = ffinal fs

481+

480482{-# INLINE scanWith #-}

481483scanWith :: Monad m => Bool -> Fold m a b -> Fold m b c -> Fold m a c

482−scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

483− Fold step initial extract

484+scanWith isMany

485+ (Fold stepL initialL extractL finalL)

486+ (Fold stepR initialR extractR finalR) =

487+ Fold step initial extract final

484488

485489 where

486490

@@ -494,15 +498,14 @@ scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

494498 Partial sR1 ->

495499 if isMany

496500 then runStep initialL sR1

497− else Done <$> extractR sR1

501+ else Done <$> finalR sR1

498502 Done bR -> return $ Done bR

499503 Partial sL -> do

500504 !b <- extractL sL

501505 rR <- stepR sR b

502− return

503− $ case rR of

504− Partial sR1 -> Partial (sL, sR1)

505− Done bR -> Done bR

506+ case rR of

507+ Partial sR1 -> return $ Partial (sL, sR1)

508+ Done bR -> finalL sL >> return (Done bR)

506509

507510 initial = do

508511 r <- initialR

@@ -514,6 +517,8 @@ scanWith isMany (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

514517

515518 extract = extractR . snd

516519

520+ final (sL, sR) = finalL sL *> finalR sR

521+

517522-- | Scan the input of a 'Fold' to change it in a stateful manner using another

518523-- 'Fold'. The scan stops as soon as the fold terminates.

519524--

@@ -565,7 +570,7 @@ deleteBy eq x0 = fmap extract $ foldl' step (Tuple' False Nothing)

565570--

566571{-# INLINE slide2 #-}

567572slide2 :: Monad m => Fold m (a, Maybe a) b -> Fold m a b

568−slide2 (Fold step1 initial1 extract1) = Fold step initial extract

573+slide2 (Fold step1 initial1 extract1 final1) = Fold step initial extract final

569574

570575 where

571576

@@ -577,6 +582,8 @@ slide2 (Fold step1 initial1 extract1) = Fold step initial extract

577582

578583 extract (Tuple' _ s) = extract1 s

579584

585+ final (Tuple' _ s) = final1 s

586+

580587-- | Return the latest unique element using the supplied comparison function.

581588-- Returns 'Nothing' if the current element is same as the last element

582589-- otherwise returns 'Just'.

@@ -932,7 +939,7 @@ rollingHashFirstN n = take n rollingHash

932939--

933940{-# INLINE rollingMapM #-}

934941rollingMapM :: Monad m => (Maybe a -> a -> m b) -> Fold m a b

935−rollingMapM f = Fold step initial extract

942+rollingMapM f = Fold step initial extract extract

936943

937944 where

938945

@@ -1173,7 +1180,8 @@ head = one

11731180-- /Pre-release/

11741181{-# INLINE findM #-}

11751182findM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)

1176−findM predicate = Fold step (return $ Partial ()) (const $ return Nothing)

1183+findM predicate =

1184+ Fold step (return $ Partial ()) extract extract

11771185

11781186 where

11791187

@@ -1184,6 +1192,8 @@ findM predicate = Fold step (return $ Partial ()) (const $ return Nothing)

11841192 else Partial ()

11851193 in f <$> predicate a

11861194

1195+ extract = const $ return Nothing

1196+

11871197-- | Returns the first element that satisfies the given predicate.

11881198--

11891199{-# INLINE find #-}

@@ -1426,7 +1436,7 @@ splitAt n fld = splitWith (,) (take n fld)

14261436

14271437{-# INLINE takingEndByM #-}

14281438takingEndByM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)

1429−takingEndByM p = Fold step initial (return . toMaybe)

1439+takingEndByM p = Fold step initial extract extract

14301440

14311441 where

14321442

@@ -1439,6 +1449,8 @@ takingEndByM p = Fold step initial (return . toMaybe)

14391449 then Done $ Just a

14401450 else Partial $ Just' a

14411451

1452+ extract = return . toMaybe

1453+

14421454-- |

14431455--

14441456-- >>> takingEndBy p = Fold.takingEndByM (return . p)

@@ -1449,7 +1461,7 @@ takingEndBy p = takingEndByM (return . p)

14491461

14501462{-# INLINE takingEndByM_ #-}

14511463takingEndByM_ :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)

1452−takingEndByM_ p = Fold step initial (return . toMaybe)

1464+takingEndByM_ p = Fold step initial extract extract

14531465

14541466 where

14551467

@@ -1462,6 +1474,8 @@ takingEndByM_ p = Fold step initial (return . toMaybe)

14621474 then Done Nothing

14631475 else Partial $ Just' a

14641476

1477+ extract = return . toMaybe

1478+

14651479-- |

14661480--

14671481-- >>> takingEndBy_ p = Fold.takingEndByM_ (return . p)

@@ -1472,7 +1486,7 @@ takingEndBy_ p = takingEndByM_ (return . p)

14721486

14731487{-# INLINE droppingWhileM #-}

14741488droppingWhileM :: Monad m => (a -> m Bool) -> Fold m a (Maybe a)

1475−droppingWhileM p = Fold step initial (return . toMaybe)

1489+droppingWhileM p = Fold step initial extract extract

14761490

14771491 where

14781492

@@ -1487,6 +1501,8 @@ droppingWhileM p = Fold step initial (return . toMaybe)

14871501 else Just' a

14881502 step _ a = return $ Partial $ Just' a

14891503

1504+ extract = return . toMaybe

1505+

14901506-- |

14911507-- >>> droppingWhile p = Fold.droppingWhileM (return . p)

14921508--

@@ -1515,15 +1531,15 @@ droppingWhile p = droppingWhileM (return . p)

15151531{-# INLINE takeEndBy_ #-}

15161532takeEndBy_ :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

15171533-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)

1518−takeEndBy_ predicate (Fold fstep finitial fextract) =

1519− Fold step finitial fextract

1534+takeEndBy_ predicate (Fold fstep finitial fextract ffinal) =

1535+ Fold step finitial fextract ffinal

15201536

15211537 where

15221538

15231539 step s a =

15241540 if not (predicate a)

15251541 then fstep s a

1526− else Done <$> fextract s

1542+ else Done <$> ffinal s

15271543

15281544-- Note:

15291545-- > Stream.splitWithSuffix p f = Stream.foldMany (Fold.takeEndBy p f)

@@ -1544,8 +1560,8 @@ takeEndBy_ predicate (Fold fstep finitial fextract) =

15441560{-# INLINE takeEndBy #-}

15451561takeEndBy :: Monad m => (a -> Bool) -> Fold m a b -> Fold m a b

15461562-- takeEndBy predicate = scanMaybe (takingEndBy predicate)

1547−takeEndBy predicate (Fold fstep finitial fextract) =

1548− Fold step finitial fextract

1563+takeEndBy predicate (Fold fstep finitial fextract ffinal) =

1564+ Fold step finitial fextract ffinal

15491565

15501566 where

15511567

@@ -1555,7 +1571,7 @@ takeEndBy predicate (Fold fstep finitial fextract) =

15551571 then return res

15561572 else do

15571573 case res of

1558− Partial s1 -> Done <$> fextract s1

1574+ Partial s1 -> Done <$> ffinal s1

15591575 Done b -> return $ Done b

15601576

15611577------------------------------------------------------------------------------

@@ -1590,8 +1606,8 @@ takeEndBySeq :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>

15901606 Array.Array a

15911607 -> Fold m a b

15921608 -> Fold m a b

1593−takeEndBySeq patArr (Fold fstep finitial fextract) =

1594− Fold step initial extract

1609+takeEndBySeq patArr (Fold fstep finitial fextract ffinal) =

1610+ Fold step initial extract final

15951611

15961612 where

15971613

@@ -1604,7 +1620,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

16041620 | patLen == 0 ->

16051621 -- XXX Should we match nothing or everything on empty

16061622 -- pattern?

1607− -- Done <$> fextract acc

1623+ -- Done <$> ffinal acc

16081624 return $ Partial $ SplitOnSeqEmpty acc

16091625 | patLen == 1 -> do

16101626 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

@@ -1655,7 +1671,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

16551671 case res of

16561672 Partial s1

16571673 | pat /= x -> return $ Partial $ SplitOnSeqSingle s1 pat

1658− | otherwise -> Done <$> fextract s1

1674+ | otherwise -> Done <$> ffinal s1

16591675 Done b -> return $ Done b

16601676 step (SplitOnSeqWord s idx wrd) x = do

16611677 res <- fstep s x

@@ -1664,7 +1680,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

16641680 Partial s1

16651681 | idx == maxIndex -> do

16661682 if wrd1 .&. wordMask == wordPat

1667− then Done <$> fextract s1

1683+ then Done <$> ffinal s1

16681684 else return $ Partial $ SplitOnSeqWordLoop s1 wrd1

16691685 | otherwise ->

16701686 return $ Partial $ SplitOnSeqWord s1 (idx + 1) wrd1

@@ -1675,7 +1691,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

16751691 case res of

16761692 Partial s1

16771693 | wrd1 .&. wordMask == wordPat ->

1678− Done <$> fextract s1

1694+ Done <$> ffinal s1

16791695 | otherwise ->

16801696 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

16811697 Done b -> return $ Done b

@@ -1689,7 +1705,7 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

16891705 let fld = Ring.unsafeFoldRing (Ring.ringBound rb)

16901706 let !ringHash = fld addCksum 0 rb

16911707 if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr

1692− then Done <$> fextract s1

1708+ then Done <$> ffinal s1

16931709 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

16941710 else

16951711 return $ Partial $ SplitOnSeqKR s1 (idx + 1) rb rh1

@@ -1702,11 +1718,11 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

17021718 rh1 <- liftIO $ Ring.unsafeInsert rb rh x

17031719 let ringHash = deltaCksum cksum old x

17041720 if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr

1705− then Done <$> fextract s1

1721+ then Done <$> ffinal s1

17061722 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

17071723 Done b -> return $ Done b

17081724

1709− extract state =

1725+ extractFunc fex state =

17101726 let st =

17111727 case state of

17121728 SplitOnSeqEmpty s -> s

@@ -1715,7 +1731,11 @@ takeEndBySeq patArr (Fold fstep finitial fextract) =

17151731 SplitOnSeqWordLoop s _ -> s

17161732 SplitOnSeqKR s _ _ _ -> s

17171733 SplitOnSeqKRLoop s _ _ _ -> s

1718− in fextract st

1734+ in fex st

1735+

1736+ extract state = extractFunc fextract state

1737+

1738+ final state = extractFunc ffinal state

17191739

17201740-- | Like 'takeEndBySeq' but discards the matched sequence.

17211741--

@@ -1726,8 +1746,8 @@ takeEndBySeq_ :: forall m a b. (MonadIO m, Storable a, Unbox a, Enum a, Eq a) =>

17261746 Array.Array a

17271747 -> Fold m a b

17281748 -> Fold m a b

1729−takeEndBySeq_ patArr (Fold fstep finitial fextract) =

1730− Fold step initial extract

1749+takeEndBySeq_ patArr (Fold fstep finitial fextract ffinal) =

1750+ Fold step initial extract final

17311751

17321752 where

17331753

@@ -1740,7 +1760,7 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

17401760 | patLen == 0 ->

17411761 -- XXX Should we match nothing or everything on empty

17421762 -- pattern?

1743− -- Done <$> fextract acc

1763+ -- Done <$> ffinal acc

17441764 return $ Partial $ SplitOnSeqEmpty acc

17451765 | patLen == 1 -> do

17461766 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

@@ -1797,13 +1817,13 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

17971817 case res of

17981818 Partial s1 -> return $ Partial $ SplitOnSeqSingle s1 pat

17991819 Done b -> return $ Done b

1800− else Done <$> fextract s

1820+ else Done <$> ffinal s

18011821 step (SplitOnSeqWord s idx wrd) x = do

18021822 let wrd1 = addToWord wrd x

18031823 if idx == maxIndex

18041824 then do

18051825 if wrd1 .&. wordMask == wordPat

1806− then Done <$> fextract s

1826+ then Done <$> ffinal s

18071827 else return $ Partial $ SplitOnSeqWordLoop s wrd1

18081828 else return $ Partial $ SplitOnSeqWord s (idx + 1) wrd1

18091829 step (SplitOnSeqWordLoop s wrd) x = do

@@ -1814,7 +1834,7 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18141834 case res of

18151835 Partial s1

18161836 | wrd1 .&. wordMask == wordPat ->

1817− Done <$> fextract s1

1837+ Done <$> ffinal s1

18181838 | otherwise ->

18191839 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

18201840 Done b -> return $ Done b

@@ -1825,7 +1845,7 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18251845 let fld = Ring.unsafeFoldRing (Ring.ringBound rb)

18261846 let !ringHash = fld addCksum 0 rb

18271847 if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr

1828− then Done <$> fextract s

1848+ then Done <$> ffinal s

18291849 else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1

18301850 else return $ Partial $ SplitOnSeqKR s (idx + 1) rb rh1

18311851 step (SplitOnSeqKRLoop s cksum rb rh) x = do

@@ -1836,7 +1856,7 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18361856 rh1 <- liftIO $ Ring.unsafeInsert rb rh x

18371857 let ringHash = deltaCksum cksum old x

18381858 if ringHash == patHash && Ring.unsafeEqArray rb rh1 patArr

1839− then Done <$> fextract s1

1859+ then Done <$> ffinal s1

18401860 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

18411861 Done b -> return $ Done b

18421862

@@ -1844,10 +1864,10 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18441864 -- terminates early inside extract, we may still have buffered data

18451865 -- remaining which will be lost if we do not communicate that to the

18461866 -- driver.

1847− extract state = do

1867+ extractFunc fex state = do

18481868 let consumeWord s n wrd = do

18491869 if n == 0

1850− then fextract s

1870+ then fex s

18511871 else do

18521872 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

18531873 r <- fstep s (toEnum $ fromIntegral old)

@@ -1857,7 +1877,7 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18571877

18581878 let consumeRing s n rb rh =

18591879 if n == 0

1860− then fextract s

1880+ then fex s

18611881 else do

18621882 old <- liftIO $ peek rh

18631883 let rh1 = Ring.advance rb rh

@@ -1867,13 +1887,17 @@ takeEndBySeq_ patArr (Fold fstep finitial fextract) =

18671887 Done b -> return b

18681888

18691889 case state of

1870− SplitOnSeqEmpty s -> fextract s

1871− SplitOnSeqSingle s _ -> fextract s

1890+ SplitOnSeqEmpty s -> fex s

1891+ SplitOnSeqSingle s _ -> fex s

18721892 SplitOnSeqWord s idx wrd -> consumeWord s idx wrd

18731893 SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd

18741894 SplitOnSeqKR s idx rb _ -> consumeRing s idx rb (Ring.startOf rb)

18751895 SplitOnSeqKRLoop s _ rb rh -> consumeRing s patLen rb rh

18761896

1897+ extract state = extractFunc fextract state

1898+

1899+ final state = extractFunc ffinal state

1900+

18771901------------------------------------------------------------------------------

18781902-- Distributing

18791903------------------------------------------------------------------------------

@@ -2317,8 +2341,8 @@ toStreamRev = fmap StreamD.fromList toListRev

23172341-- /Pre-release/

23182342{-# INLINE unfoldMany #-}

23192343unfoldMany :: Monad m => Unfold m a b -> Fold m b c -> Fold m a c

2320−unfoldMany (Unfold ustep inject) (Fold fstep initial extract) =

2321− Fold consume initial extract

2344+unfoldMany (Unfold ustep inject) (Fold fstep initial extract final) =

2345+ Fold consume initial extract final

23222346

23232347 where

23242348

@@ -2345,7 +2369,7 @@ bottomBy :: (MonadIO m, Unbox a) =>

23452369 (a -> a -> Ordering)

23462370 -> Int

23472371 -> Fold m a (MutArray a)

2348−bottomBy cmp n = Fold step initial extract

2372+bottomBy cmp n = Fold step initial extract extract

23492373

23502374 where

23512375

@@ -2440,8 +2464,8 @@ intersperseWithQuotes

24402464 quote

24412465 esc

24422466 separator

2443− (Fold stepL initialL extractL)

2444− (Fold stepR initialR extractR) = Fold step initial extract

2467+ (Fold stepL initialL _ finalL)

2468+ (Fold stepR initialR extractR finalR) = Fold step initial extract final

24452469

24462470 where

24472471

@@ -2484,11 +2508,13 @@ intersperseWithQuotes

24842508 r <- stepL sL a

24852509 case r of

24862510 Partial s -> return $ Partial (nextState sR s)

2487− Done _ -> error "Collecting fold finished inside quote"

2511+ Done _ -> do

2512+ _ <- finalR sR

2513+ error "Collecting fold finished inside quote"

24882514

24892515 step (IntersperseQUnquoted sR sL) a

24902516 | a == separator = do

2491− b <- extractL sL

2517+ b <- finalL sL

24922518 collect IntersperseQUnquoted sR b

24932519 | a == quote = processQuoted a sL sR IntersperseQQuoted

24942520 | otherwise = process a sL sR IntersperseQUnquoted

@@ -2506,3 +2532,13 @@ intersperseWithQuotes

25062532 error "intersperseWithQuotes: finished inside quote"

25072533 extract (IntersperseQQuotedEsc _ _) =

25082534 error "intersperseWithQuotes: finished inside quote, at escape char"

2535+

2536+ final (IntersperseQUnquoted sR sL) = finalL sL *> finalR sR

2537+ final (IntersperseQQuoted sR sL) = do

2538+ _ <- finalR sR

2539+ _ <- finalL sL

2540+ error "intersperseWithQuotes: finished inside quote"

2541+ final (IntersperseQQuotedEsc sR sL) = do

2542+ _ <- finalR sR

2543+ _ <- finalL sL

2544+ error "intersperseWithQuotes: finished inside quote, at escape char"

core/src/Streamly/Internal/Data/Fold/Container.hs+73−28

@@ -270,14 +270,15 @@ demuxGeneric :: (Monad m, IsMap f, Traversable f) =>

270270 (a -> Key f)

271271 -> (a -> m (Fold m a b))

272272 -> Fold m a (m (f b), Maybe (Key f, b))

273−demuxGeneric getKey getFold = fmap extract $ foldlM' step initial

273+demuxGeneric getKey getFold =

274+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final

274275

275276 where

276277

277278 initial = return $ Tuple' IsMap.mapEmpty Nothing

278279

279280 {-# INLINE runFold #-}

280− runFold kv (Fold step1 initial1 extract1) (k, a) = do

281+ runFold kv (Fold step1 initial1 extract1 final1) (k, a) = do

281282 res <- initial1

282283 case res of

283284 Partial s -> do

@@ -285,7 +286,7 @@ demuxGeneric getKey getFold = fmap extract $ foldlM' step initial

285286 return

286287 $ case res1 of

287288 Partial _ ->

288− let fld = Fold step1 (return res1) extract1

289+ let fld = Fold step1 (return res1) extract1 final1

289290 in Tuple' (IsMap.mapInsert k fld kv) Nothing

290291 Done b -> Tuple' (IsMap.mapDelete k kv) (Just (k, b))

291292 Done b -> return $ Tuple' kv (Just (k, b))

@@ -298,15 +299,25 @@ demuxGeneric getKey getFold = fmap extract $ foldlM' step initial

298299 runFold kv fld (k, a)

299300 Just f -> runFold kv f (k, a)

300301

301− extract (Tuple' kv x) = (Prelude.mapM f kv, x)

302+ extract (Tuple' kv x) = return (Prelude.mapM f kv, x)

302303

303304 where

304305

305− f (Fold _ i e) = do

306+ f (Fold _ i e _) = do

306307 r <- i

307308 case r of

308309 Partial s -> e s

309− Done b -> return b

310+ _ -> error "demuxGeneric: unreachable code"

311+

312+ final (Tuple' kv x) = return (Prelude.mapM f kv, x)

313+

314+ where

315+

316+ f (Fold _ i _ fin) = do

317+ r <- i

318+ case r of

319+ Partial s -> fin s

320+ _ -> error "demuxGeneric: unreachable code"

310321

311322-- | @demux getKey getFold@: In a key value stream, fold values corresponding

312323-- to each key using a key specific fold. @getFold@ is invoked to generate a

@@ -348,35 +359,36 @@ demuxGenericIO :: (MonadIO m, IsMap f, Traversable f) =>

348359 (a -> Key f)

349360 -> (a -> m (Fold m a b))

350361 -> Fold m a (m (f b), Maybe (Key f, b))

351−demuxGenericIO getKey getFold = fmap extract $ foldlM' step initial

362+demuxGenericIO getKey getFold =

363+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final

352364

353365 where

354366

355367 initial = return $ Tuple' IsMap.mapEmpty Nothing

356368

357369 {-# INLINE initFold #-}

358− initFold kv (Fold step1 initial1 extract1) (k, a) = do

370+ initFold kv (Fold step1 initial1 extract1 final1) (k, a) = do

359371 res <- initial1

360372 case res of

361373 Partial s -> do

362374 res1 <- step1 s a

363375 case res1 of

364376 Partial _ -> do

365− let fld = Fold step1 (return res1) extract1

377+ let fld = Fold step1 (return res1) extract1 final1

366378 ref <- liftIO $ newIORef fld

367379 return $ Tuple' (IsMap.mapInsert k ref kv) Nothing

368380 Done b -> return $ Tuple' kv (Just (k, b))

369381 Done b -> return $ Tuple' kv (Just (k, b))

370382

371383 {-# INLINE runFold #-}

372− runFold kv ref (Fold step1 initial1 extract1) (k, a) = do

384+ runFold kv ref (Fold step1 initial1 extract1 final1) (k, a) = do

373385 res <- initial1

374386 case res of

375387 Partial s -> do

376388 res1 <- step1 s a

377389 case res1 of

378390 Partial _ -> do

379− let fld = Fold step1 (return res1) extract1

391+ let fld = Fold step1 (return res1) extract1 final1

380392 liftIO $ writeIORef ref fld

381393 return $ Tuple' kv Nothing

382394 Done b ->

@@ -394,16 +406,27 @@ demuxGenericIO getKey getFold = fmap extract $ foldlM' step initial

394406 f <- liftIO $ readIORef ref

395407 runFold kv ref f (k, a)

396408

397− extract (Tuple' kv x) = (Prelude.mapM f kv, x)

409+ extract (Tuple' kv x) = return (Prelude.mapM f kv, x)

398410

399411 where

400412

401413 f ref = do

402− (Fold _ i e) <- liftIO $ readIORef ref

414+ Fold _ i e _ <- liftIO $ readIORef ref

403415 r <- i

404416 case r of

405417 Partial s -> e s

406− Done b -> return b

418+ _ -> error "demuxGenericIO: unreachable code"

419+

420+ final (Tuple' kv x) = return (Prelude.mapM f kv, x)

421+

422+ where

423+

424+ f ref = do

425+ Fold _ i _ fin <- liftIO $ readIORef ref

426+ r <- i

427+ case r of

428+ Partial s -> fin s

429+ _ -> error "demuxGenericIO: unreachable code"

407430

408431-- | This is specialized version of 'demux' that uses mutable IO cells as

409432-- fold accumulators for better performance.

@@ -418,6 +441,13 @@ demuxIO :: (MonadIO m, Ord k) =>

418441 -> Fold m a (m (Map k b), Maybe (k, b))

419442demuxIO = demuxGenericIO

420443

444+-- | Fold a key value stream to a key-value Map. If the same key appears

445+-- multiple times, only the last value is retained.

446+{-# INLINE kvToMapOverwriteGeneric #-}

447+kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)

448+kvToMapOverwriteGeneric =

449+ foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty

450+

421451{-# INLINE demuxToContainer #-}

422452demuxToContainer :: (Monad m, IsMap f, Traversable f) =>

423453 (a -> Key f) -> (a -> m (Fold m a b)) -> Fold m a (f b)

@@ -505,8 +535,8 @@ classifyGeneric :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>

505535 -- for that use case. We return an action because we want it to be lazy so

506536 -- that the downstream consumers can choose to process or discard it.

507537 (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))

508−classifyGeneric f (Fold step1 initial1 extract1) =

509− fmap extract $ foldlM' step initial

538+classifyGeneric f (Fold step1 initial1 extract1 final1) =

539+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final

510540

511541 where

512542

@@ -543,7 +573,16 @@ classifyGeneric f (Fold step1 initial1 extract1) =

543573 let kv1 = IsMap.mapDelete k kv

544574 in Tuple3' kv1 (Set.insert k set) (Just (k, b))

545575

546− extract (Tuple3' kv _ x) = (Prelude.mapM extract1 kv, x)

576+ extract (Tuple3' kv _ x) = return (Prelude.mapM extract1 kv, x)

577+

578+ final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey f1 kv, x)

579+

580+ where

581+

582+ f1 k s = do

583+ if Set.member k set

584+ then extract1 s

585+ else final1 s

547586

548587-- | Folds the values for each key using the supplied fold. When scanning, as

549588-- soon as the fold is complete, its result is available in the second

@@ -568,8 +607,8 @@ classify = classifyGeneric

568607{-# INLINE classifyGenericIO #-}

569608classifyGenericIO :: (MonadIO m, IsMap f, Traversable f, Ord (Key f)) =>

570609 (a -> Key f) -> Fold m a b -> Fold m a (m (f b), Maybe (Key f, b))

571−classifyGenericIO f (Fold step1 initial1 extract1) =

572− fmap extract $ foldlM' step initial

610+classifyGenericIO f (Fold step1 initial1 extract1 final1) =

611+ Fold (\s a -> Partial <$> step s a) (Partial <$> initial) extract final

573612

574613 where

575614

@@ -608,8 +647,21 @@ classifyGenericIO f (Fold step1 initial1 extract1) =

608647 in return

609648 $ Tuple3' kv1 (Set.insert k set) (Just (k, b))

610649

611− extract (Tuple3' kv _ x) =

612− (Prelude.mapM (\ref -> liftIO (readIORef ref) >>= extract1) kv, x)

650+ extract (Tuple3' kv _ x) = return (Prelude.mapM g kv, x)

651+

652+ where

653+

654+ g ref = liftIO (readIORef ref) >>= extract1

655+

656+ final (Tuple3' kv set x) = return (IsMap.mapTraverseWithKey g kv, x)

657+

658+ where

659+

660+ g k ref = do

661+ s <- liftIO $ readIORef ref

662+ if Set.member k set

663+ then extract1 s

664+ else final1 s

613665

614666-- | Same as classify except that it uses mutable IORef cells in the

615667-- Map providing better performance. Be aware that if this is used as a scan,

@@ -624,13 +676,6 @@ classifyIO :: (MonadIO m, Ord k) =>

624676 (a -> k) -> Fold m a b -> Fold m a (m (Map k b), Maybe (k, b))

625677classifyIO = classifyGenericIO

626678

627−-- | Fold a key value stream to a key-value Map. If the same key appears

628−-- multiple times, only the last value is retained.

629−{-# INLINE kvToMapOverwriteGeneric #-}

630−kvToMapOverwriteGeneric :: (Monad m, IsMap f) => Fold m (Key f, a) (f a)

631−kvToMapOverwriteGeneric =

632− foldl' (\kv (k, v) -> IsMap.mapInsert k v kv) IsMap.mapEmpty

633−

634679{-# INLINE toContainer #-}

635680toContainer :: (Monad m, IsMap f, Traversable f, Ord (Key f)) =>

636681 (a -> Key f) -> Fold m a b -> Fold m a (f b)

core/src/Streamly/Internal/Data/Fold/Step.hs+1−1

@@ -40,7 +40,7 @@ data Step s b

4040 = Partial !s

4141 | Done !b

4242

43−-- | 'first' maps over 'Partial' and 'second' maps over 'Done'.

43+-- | 'first' maps over the fold state and 'second' maps over the fold result.

4444--

4545instance Bifunctor Step where

4646 {-# INLINE bimap #-}

core/src/Streamly/Internal/Data/Fold/Type.hs+220−106

@@ -445,7 +445,7 @@ where

445445#if !MIN_VERSION_base(4,18,0)

446446import Control.Applicative (liftA2)

447447#endif

448−import Control.Monad ((>=>))

448+import Control.Monad ((>=>), void)

449449import Data.Bifunctor (Bifunctor(..))

450450import Data.Either (fromLeft, fromRight, isLeft, isRight)

451451import Data.Functor.Identity (Identity(..))

@@ -471,23 +471,49 @@ import Streamly.Internal.Data.Fold.Step

471471-- The type @b@ is the accumulator of the writer. That's the reason the

472472-- default folds in various modules are called "write".

473473

474−-- | The type @Fold m a b@ having constructor @Fold step initial extract@

475−-- represents a fold over an input stream of values of type @a@ to a final

476−-- value of type @b@ in 'Monad' @m@.

474+-- An alternative to using an "extract" function is to use "Partial s b" style

475+-- partial value so that we always emit the output value and there is no need

476+-- to extract. Then extract can be used for cleanup purposes. But in this case

477+-- in some cases we may need a "Continue" constructor where an output value is

478+-- not available, this was implicit earlier. Also, "b" should be lazy here so

479+-- that we do not always compute it even if we do not need it.

480+--

481+-- Partial s b --> extract :: s -> b

482+-- Continue --> extract :: s -> Maybe b

483+--

484+-- But keeping 'b' lazy does not let the fold optimize well. It leads to

485+-- significant regressions in the key-value folds.

486+--

487+-- The "final" function complicates combinators that take other folds as

488+-- argument because we need to call their finalizers at right places. An

489+-- alternative to reduce this complexity where it is not required is to use a

490+-- separate type for bracketed folds but then we need to manage the complexity

491+-- of two different fold types.

492+

493+-- The "final" function could be (s -> m (Step s b)), like in parsers so that

494+-- it can be called in a loop to drain the fold.

495+

496+-- | The type @Fold m a b@ having constructor @Fold step initial extract

497+-- final@ represents a fold over an input stream of values of type @a@ to a

498+-- final value of type @b@ in 'Monad' @m@.

477499--

478500-- The fold uses an intermediate state @s@ as accumulator, the type @s@ is

479501-- internal to the specific fold definition. The initial value of the fold

480502-- state @s@ is returned by @initial@. The @step@ function consumes an input

481503-- and either returns the final result @b@ if the fold is done or the next

482504-- intermediate state (see 'Step'). At any point the fold driver can extract

483−-- the result from the intermediate state using the @extract@ function.

505+-- the result from the intermediate state using the @extract@ function. The

506+-- "final" function is used to finalize the fold, the driver can call it

507+-- whenever it holds a valid fold state which it will not be using anymore. The

508+-- state should not be used after finalization. Note that if the fold

509+-- terminates itself we won't have a valid fold state.

484510--

485511-- NOTE: The constructor is not yet released, smart constructors are provided

486512-- to create folds.

487513--

488514data Fold m a b =

489− -- | @Fold @ @ step @ @ initial @ @ extract@

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

515+ -- | @Fold@ @step@ @initial@ @extract@ @final@

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

491517

492518------------------------------------------------------------------------------

493519-- Mapping on the output

@@ -497,7 +523,8 @@ data Fold m a b =

497523--

498524{-# INLINE rmapM #-}

499525rmapM :: Monad m => (b -> m c) -> Fold m a b -> Fold m a c

500−rmapM f (Fold step initial extract) = Fold step1 initial1 (extract >=> f)

526+rmapM f (Fold step initial extract final) =

527+ Fold step1 initial1 (extract >=> f) (final >=> f)

501528

502529 where

503530

@@ -528,6 +555,7 @@ foldl' step initial =

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

529556 (return (Partial initial))

530557 return

558+ return

531559

532560-- | Make a fold from a left fold style monadic step function and initial value

533561-- of the accumulator.

@@ -542,7 +570,7 @@ foldl' step initial =

542570{-# INLINE foldlM' #-}

543571foldlM' :: Monad m => (b -> a -> m b) -> m b -> Fold m a b

544572foldlM' step initial =

545− Fold (\s a -> Partial <$> step s a) (Partial <$> initial) return

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

546574

547575-- | Make a strict left fold, for non-empty streams, using first element as the

548576-- starting value. Returns Nothing if the stream is empty.

@@ -640,7 +668,11 @@ foldrM' g z =

640668{-# INLINE foldt' #-}

641669foldt' :: Monad m => (s -> a -> Step s b) -> Step s b -> (s -> b) -> Fold m a b

642670foldt' step initial extract =

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

671+ Fold

672+ (\s a -> return $ step s a)

673+ (return initial)

674+ (return . extract)

675+ (return . extract)

644676

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

646678-- and a state extraction function.

@@ -653,7 +685,7 @@ foldt' step initial extract =

653685--

654686{-# INLINE foldtM' #-}

655687foldtM' :: (s -> a -> m (Step s b)) -> m (Step s b) -> (s -> m b) -> Fold m a b

656−foldtM' = Fold

688+foldtM' step initial extract = Fold step initial extract extract

657689

658690------------------------------------------------------------------------------

659691-- Refold

@@ -667,7 +699,7 @@ foldtM' = Fold

667699-- /Internal/

668700fromRefold :: Refold m c a b -> c -> Fold m a b

669701fromRefold (Refold step inject extract) c =

670− Fold step (inject c) extract

702+ Fold step (inject c) extract extract

671703

672704------------------------------------------------------------------------------

673705-- Basic Folds

@@ -727,7 +759,8 @@ toStreamK = foldr K.cons K.nil

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

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

729761 {-# INLINE fmap #-}

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

762+ fmap f (Fold step1 initial1 extract final) =

763+ Fold step initial (fmap2 f extract) (fmap2 f final)

731764

732765 where

733766

@@ -762,7 +795,7 @@ instance Functor m => Functor (Fold m a) where

762795--

763796{-# INLINE fromPure #-}

764797fromPure :: Applicative m => b -> Fold m a b

765−fromPure b = Fold undefined (pure $ Done b) pure

798+fromPure b = Fold undefined (pure $ Done b) pure pure

766799

767800-- | Make a fold that yields the result of the supplied effectful action

768801-- without consuming any further input.

@@ -771,7 +804,7 @@ fromPure b = Fold undefined (pure $ Done b) pure

771804--

772805{-# INLINE fromEffect #-}

773806fromEffect :: Applicative m => m b -> Fold m a b

774−fromEffect b = Fold undefined (Done <$> b) pure

807+fromEffect b = Fold undefined (Done <$> b) pure pure

775808

776809{-# ANN type SeqFoldState Fuse #-}

777810data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr

@@ -804,8 +837,10 @@ data SeqFoldState sl f sr = SeqFoldL !sl | SeqFoldR !f !sr

804837{-# INLINE splitWith #-}

805838splitWith :: Monad m =>

806839 (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c

807−splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

808− Fold step initial extract

840+splitWith func

841+ (Fold stepL initialL _ finalL)

842+ (Fold stepR initialR _ finalR) =

843+ Fold step initial extract final

809844

810845 where

811846

@@ -822,13 +857,18 @@ splitWith func (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

822857 step (SeqFoldL st) a = runL (stepL st a)

823858 step (SeqFoldR f st) a = runR (stepR st a) f

824859

825− extract (SeqFoldR f sR) = fmap f (extractR sR)

826− extract (SeqFoldL sL) = do

827− rL <- extractL sL

860+ -- XXX splitWith should not be used for scanning

861+ -- It would rarely make sense and resource cleanup would be expensive.

862+ -- especially when multiple splitWith are chained.

863+ extract _ = error "splitWith: cannot be used for scanning"

864+

865+ final (SeqFoldR f sR) = fmap f (finalR sR)

866+ final (SeqFoldL sL) = do

867+ rL <- finalL sL

828868 res <- initialR

829869 fmap (func rL)

830870 $ case res of

831− Partial sR -> extractR sR

871+ Partial sR -> finalR sR

832872 Done rR -> return rR

833873

834874{-# DEPRECATED serialWith "Please use \"splitWith\" instead" #-}

@@ -848,8 +888,8 @@ data SeqFoldState_ sl sr = SeqFoldL_ !sl | SeqFoldR_ !sr

848888--

849889{-# INLINE split_ #-}

850890split_ :: Monad m => Fold m x a -> Fold m x b -> Fold m x b

851−split_ (Fold stepL initialL _) (Fold stepR initialR extractR) =

852− Fold step initial extract

891+split_ (Fold stepL initialL _ finalL) (Fold stepR initialR _ finalR) =

892+ Fold step initial extract final

853893

854894 where

855895

@@ -872,11 +912,16 @@ split_ (Fold stepL initialL _) (Fold stepR initialR extractR) =

872912 resR <- stepR st a

873913 return $ first SeqFoldR_ resR

874914

875− extract (SeqFoldR_ sR) = extractR sR

876− extract (SeqFoldL_ _) = do

915+ -- XXX split_ should not be used for scanning

916+ -- See splitWith for more details.

917+ extract _ = error "split_: cannot be used for scanning"

918+

919+ final (SeqFoldR_ sR) = finalR sR

920+ final (SeqFoldL_ sL) = do

921+ _ <- finalL sL

877922 res <- initialR

878923 case res of

879− Partial sR -> extractR sR

924+ Partial sR -> finalR sR

880925 Done rR -> return rR

881926

882927-- | 'Applicative' form of 'splitWith'. Split the input serially over two

@@ -924,8 +969,10 @@ data TeeState sL sR bL bR

924969--

925970{-# INLINE teeWith #-}

926971teeWith :: Monad m => (a -> b -> c) -> Fold m x a -> Fold m x b -> Fold m x c

927−teeWith f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

928− Fold step initial extract

972+teeWith f

973+ (Fold stepL initialL extractL finalL)

974+ (Fold stepR initialR extractR finalR) =

975+ Fold step initial extract final

929976

930977 where

931978

@@ -952,6 +999,10 @@ teeWith f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

952999 extract (TeeLeft bR sL) = (`f` bR) <$> extractL sL

9531000 extract (TeeRight bL sR) = f bL <$> extractR sR

9541001

1002+ final (TeeBoth sL sR) = f <$> finalL sL <*> finalR sR

1003+ final (TeeLeft bR sL) = (`f` bR) <$> finalL sL

1004+ final (TeeRight bL sR) = f bL <$> finalR sR

1005+

9551006{-# ANN type TeeFstState Fuse #-}

9561007data TeeFstState sL sR b

9571008 = TeeFstBoth !sL !sR

@@ -964,8 +1015,10 @@ data TeeFstState sL sR b

9641015{-# INLINE teeWithFst #-}

9651016teeWithFst :: Monad m =>

9661017 (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d

967−teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

968− Fold step initial extract

1018+teeWithFst f

1019+ (Fold stepL initialL extractL finalL)

1020+ (Fold stepR initialR extractR finalR) =

1021+ Fold step initial extract final

9691022

9701023 where

9711024

@@ -984,7 +1037,7 @@ teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

9841037 Done bl -> do

9851038 Done . f bl <$>

9861039 case resR of

987− Partial sr -> extractR sr

1040+ Partial sr -> finalR sr

9881041 Done br -> return br

9891042

9901043 initial = runBoth initialL initialR

@@ -995,6 +1048,9 @@ teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

9951048 extract (TeeFstBoth sL sR) = f <$> extractL sL <*> extractR sR

9961049 extract (TeeFstLeft bR sL) = (`f` bR) <$> extractL sL

9971050

1051+ final (TeeFstBoth sL sR) = f <$> finalL sL <*> finalR sR

1052+ final (TeeFstLeft bR sL) = (`f` bR) <$> finalL sL

1053+

9981054-- | Like 'teeWith' but terminates as soon as any one of the two folds

9991055-- terminates.

10001056--

@@ -1003,8 +1059,10 @@ teeWithFst f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

10031059{-# INLINE teeWithMin #-}

10041060teeWithMin :: Monad m =>

10051061 (b -> c -> d) -> Fold m a b -> Fold m a c -> Fold m a d

1006−teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

1007− Fold step initial extract

1062+teeWithMin f

1063+ (Fold stepL initialL extractL finalL)

1064+ (Fold stepR initialR extractR finalR) =

1065+ Fold step initial extract final

10081066

10091067 where

10101068

@@ -1016,12 +1074,12 @@ teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

10161074 Partial sl -> do

10171075 case resR of

10181076 Partial sr -> return $ Partial $ Tuple' sl sr

1019− Done br -> Done . (`f` br) <$> extractL sl

1077+ Done br -> Done . (`f` br) <$> finalL sl

10201078

10211079 Done bl -> do

10221080 Done . f bl <$>

10231081 case resR of

1024− Partial sr -> extractR sr

1082+ Partial sr -> finalR sr

10251083 Done br -> return br

10261084

10271085 initial = runBoth initialL initialR

@@ -1030,6 +1088,8 @@ teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

10301088

10311089 extract (Tuple' sL sR) = f <$> extractL sL <*> extractR sR

10321090

1091+ final (Tuple' sL sR) = f <$> finalL sL <*> finalR sR

1092+

10331093-- | Shortest alternative. Apply both folds in parallel but choose the result

10341094-- from the one which consumed least input i.e. take the shortest succeeding

10351095-- fold.

@@ -1041,8 +1101,8 @@ teeWithMin f (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

10411101--

10421102{-# INLINE shortest #-}

10431103shortest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)

1044−shortest (Fold stepL initialL extractL) (Fold stepR initialR _) =

1045− Fold step initial extract

1104+shortest (Fold stepL initialL extractL finalL) (Fold stepR initialR _ finalR) =

1105+ Fold step initial extract final

10461106

10471107 where

10481108

@@ -1050,10 +1110,16 @@ shortest (Fold stepL initialL extractL) (Fold stepR initialR _) =

10501110 runBoth actionL actionR = do

10511111 resL <- actionL

10521112 resR <- actionR

1053− return $

1054− case resL of

1055− Partial sL -> bimap (Tuple' sL) Right resR

1056− Done bL -> Done $ Left bL

1113+ case resL of

1114+ Partial sL ->

1115+ case resR of

1116+ Partial sR -> return $ Partial $ Tuple' sL sR

1117+ Done bR -> finalL sL >> return (Done (Right bR))

1118+ Done bL -> do

1119+ case resR of

1120+ Partial sR -> void (finalR sR)

1121+ Done _ -> return ()

1122+ return (Done (Left bL))

10571123

10581124 initial = runBoth initialL initialR

10591125

@@ -1061,6 +1127,8 @@ shortest (Fold stepL initialL extractL) (Fold stepR initialR _) =

10611127

10621128 extract (Tuple' sL _) = Left <$> extractL sL

10631129

1130+ final (Tuple' sL sR) = Left <$> finalL sL <* finalR sR

1131+

10641132{-# ANN type LongestState Fuse #-}

10651133data LongestState sL sR

10661134 = LongestBoth !sL !sR

@@ -1078,8 +1146,10 @@ data LongestState sL sR

10781146--

10791147{-# INLINE longest #-}

10801148longest :: Monad m => Fold m x a -> Fold m x b -> Fold m x (Either a b)

1081−longest (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

1082− Fold step initial extract

1149+longest

1150+ (Fold stepL initialL _ finalL)

1151+ (Fold stepR initialR _ finalR) =

1152+ Fold step initial extract final

10831153

10841154 where

10851155

@@ -1102,14 +1172,18 @@ longest (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

11021172 step (LongestLeft sL) a = bimap LongestLeft Left <$> stepL sL a

11031173 step (LongestRight sR) a = bimap LongestRight Right <$> stepR sR a

11041174

1105− left sL = Left <$> extractL sL

1106− extract (LongestLeft sL) = left sL

1107− extract (LongestRight sR) = Right <$> extractR sR

1108− extract (LongestBoth sL _) = left sL

1175+ -- XXX Scan with this may not make sense as we cannot determine the longest

1176+ -- until one of them have exhausted.

1177+ extract _ = error $ "longest: scan is not allowed as longest cannot be "

1178+ ++ "determined until one fold has exhausted."

1179+

1180+ final (LongestLeft sL) = Left <$> finalL sL

1181+ final (LongestRight sR) = Right <$> finalR sR

1182+ final (LongestBoth sL sR) = Left <$> finalL sL <* finalR sR

11091183

1110−data ConcatMapState m sa a c

1111− = B !sa

1112− | forall s. C (s -> a -> m (Step s c)) !s (s -> m c)

1184+data ConcatMapState m sa a b c

1185+ = B !sa (sa -> m b)

1186+ | forall s. C (s -> a -> m (Step s c)) !s (s -> m c) (s -> m c)

11131187

11141188-- | Map a 'Fold' returning function on the result of a 'Fold' and run the

11151189-- returned fold. This operation can be used to express data dependencies

@@ -1132,43 +1206,47 @@ data ConcatMapState m sa a c

11321206--

11331207{-# INLINE concatMap #-}

11341208concatMap :: Monad m => (b -> Fold m a c) -> Fold m a b -> Fold m a c

1135−concatMap f (Fold stepa initiala extracta) = Fold stepc initialc extractc

1209+concatMap f (Fold stepa initiala _ finala) =

1210+ Fold stepc initialc extractc finalc

11361211 where

11371212 initialc = do

11381213 r <- initiala

11391214 case r of

1140− Partial s -> return $ Partial (B s)

1215+ Partial s -> return $ Partial (B s finala)

11411216 Done b -> initInnerFold (f b)

11421217

1143− stepc (B s) a = do

1218+ stepc (B s fin) a = do

11441219 r <- stepa s a

11451220 case r of

1146− Partial s1 -> return $ Partial (B s1)

1221+ Partial s1 -> return $ Partial (B s1 fin)

11471222 Done b -> initInnerFold (f b)

11481223

1149− stepc (C stepInner s extractInner) a = do

1224+ stepc (C stepInner s extractInner fin) a = do

11501225 r <- stepInner s a

11511226 return $ case r of

1152− Partial sc -> Partial (C stepInner sc extractInner)

1227+ Partial sc -> Partial (C stepInner sc extractInner fin)

11531228 Done c -> Done c

11541229

1155− extractc (B s) = do

1156− r <- extracta s

1157− initExtract (f r)

1158− extractc (C _ sInner extractInner) = extractInner sInner

1230+ -- XXX Cannot use for scanning

1231+ extractc _ = error "concatMap: cannot be used for scanning"

11591232

1160− initInnerFold (Fold step i e) = do

1233+ initInnerFold (Fold step i e fin) = do

11611234 r <- i

11621235 return $ case r of

1163− Partial s -> Partial (C step s e)

1236+ Partial s -> Partial (C step s e fin)

11641237 Done c -> Done c

11651238

1166− initExtract (Fold _ i e) = do

1239+ initFinalize (Fold _ i _ fin) = do

11671240 r <- i

11681241 case r of

1169− Partial s -> e s

1242+ Partial s -> fin s

11701243 Done c -> return c

11711244

1245+ finalc (B s fin) = do

1246+ r <- fin s

1247+ initFinalize (f r)

1248+ finalc (C _ sInner _ fin) = fin sInner

1249+

11721250------------------------------------------------------------------------------

11731251-- Mapping on input

11741252------------------------------------------------------------------------------

@@ -1187,7 +1265,7 @@ concatMap f (Fold stepa initiala extracta) = Fold stepc initialc extractc

11871265--

11881266{-# INLINE lmap #-}

11891267lmap :: (a -> b) -> Fold m b r -> Fold m a r

1190−lmap f (Fold step begin done) = Fold step' begin done

1268+lmap f (Fold step begin done final) = Fold step' begin done final

11911269 where

11921270 step' x a = step x (f a)

11931271

@@ -1195,7 +1273,7 @@ lmap f (Fold step begin done) = Fold step' begin done

11951273--

11961274{-# INLINE lmapM #-}

11971275lmapM :: Monad m => (a -> m b) -> Fold m b r -> Fold m a r

1198−lmapM f (Fold step begin done) = Fold step' begin done

1276+lmapM f (Fold step begin done final) = Fold step' begin done final

11991277 where

12001278 step' x a = f a >>= step x

12011279

@@ -1207,8 +1285,10 @@ lmapM f (Fold step begin done) = Fold step' begin done

12071285-- /Pre-release/

12081286{-# INLINE postscan #-}

12091287postscan :: Monad m => Fold m a b -> Fold m b c -> Fold m a c

1210−postscan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

1211− Fold step initial extract

1288+postscan

1289+ (Fold stepL initialL extractL finalL)

1290+ (Fold stepR initialR extractR finalR) =

1291+ Fold step initial extract final

12121292

12131293 where

12141294

@@ -1219,30 +1299,32 @@ postscan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

12191299 Done bL -> do

12201300 rR <- stepR sR bL

12211301 case rR of

1222− Partial sR1 -> Done <$> extractR sR1

1302+ Partial sR1 -> Done <$> finalR sR1

12231303 Done bR -> return $ Done bR

12241304 Partial sL -> do

12251305 !b <- extractL sL

12261306 rR <- stepR sR b

1227− return

1228− $ case rR of

1229− Partial sR1 -> Partial (sL, sR1)

1230− Done bR -> Done bR

1307+ case rR of

1308+ Partial sR1 -> return $ Partial (sL, sR1)

1309+ Done bR -> finalL sL >> return (Done bR)

12311310

12321311 initial = do

1233− r <- initialR

1234− rL <- initialL

1235− case r of

1236− Partial sR ->

1312+ rR <- initialR

1313+ case rR of

1314+ Partial sR -> do

1315+ rL <- initialL

12371316 case rL of

1238− Done _ -> Done <$> extractR sR

1317+ Done _ -> Done <$> finalR sR

12391318 Partial sL -> return $ Partial (sL, sR)

12401319 Done b -> return $ Done b

12411320

1321+ -- XXX should use Tuple'

12421322 step (sL, sR) x = runStep (stepL sL x) sR

12431323

12441324 extract = extractR . snd

12451325

1326+ final (sL, sR) = finalL sL *> finalR sR

1327+

12461328------------------------------------------------------------------------------

12471329-- Filtering

12481330------------------------------------------------------------------------------

@@ -1255,7 +1337,7 @@ postscan (Fold stepL initialL extractL) (Fold stepR initialR extractR) =

12551337--

12561338{-# INLINE_NORMAL catMaybes #-}

12571339catMaybes :: Monad m => Fold m a b -> Fold m (Maybe a) b

1258−catMaybes (Fold step initial extract) = Fold step1 initial extract

1340+catMaybes (Fold step initial extract final) = Fold step1 initial extract final

12591341

12601342 where

12611343

@@ -1295,7 +1377,7 @@ filtering f = foldl' step Nothing

12951377{-# INLINE filter #-}

12961378filter :: Monad m => (a -> Bool) -> Fold m a r -> Fold m a r

12971379-- filter p = scanMaybe (filtering p)

1298−filter f (Fold step begin done) = Fold step' begin done

1380+filter f (Fold step begin extract final) = Fold step' begin extract final

12991381 where

13001382 step' x a = if f a then step x a else return $ Partial x

13011383

@@ -1306,7 +1388,7 @@ filter f (Fold step begin done) = Fold step' begin done

13061388--

13071389{-# INLINE filterM #-}

13081390filterM :: Monad m => (a -> m Bool) -> Fold m a r -> Fold m a r

1309−filterM f (Fold step begin done) = Fold step' begin done

1391+filterM f (Fold step begin extract final) = Fold step' begin extract final

13101392 where

13111393 step' x a = do

13121394 use <- f a

@@ -1395,7 +1477,7 @@ dropping n = foldt' step initial extract

13951477{-# INLINE take #-}

13961478take :: Monad m => Int -> Fold m a b -> Fold m a b

13971479-- take n = scanMaybe (taking n)

1398−take n (Fold fstep finitial fextract) = Fold step initial extract

1480+take n (Fold fstep finitial fextract ffinal) = Fold step initial extract final

13991481

14001482 where

14011483

@@ -1407,7 +1489,7 @@ take n (Fold fstep finitial fextract) = Fold step initial extract

14071489 s1 = Tuple'Fused i1 s

14081490 if i1 < n

14091491 then return $ Partial s1

1410− else Done <$> fextract s

1492+ else Done <$> ffinal s

14111493 Done b -> return $ Done b

14121494

14131495 initial = finitial >>= next (-1)

@@ -1416,6 +1498,8 @@ take n (Fold fstep finitial fextract) = Fold step initial extract

14161498

14171499 extract (Tuple'Fused _ r) = fextract r

14181500

1501+ final (Tuple'Fused _ r) = ffinal r

1502+

14191503------------------------------------------------------------------------------

14201504-- Nesting

14211505------------------------------------------------------------------------------

@@ -1433,8 +1517,8 @@ take n (Fold fstep finitial fextract) = Fold step initial extract

14331517-- /Pre-release/

14341518{-# INLINE duplicate #-}

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

1436−duplicate (Fold step1 initial1 extract1) =

1437− Fold step initial (\s -> pure $ Fold step1 (pure $ Partial s) extract1)

1520+duplicate (Fold step1 initial1 extract1 final1) =

1521+ Fold step initial extract final

14381522

14391523 where

14401524

@@ -1442,6 +1526,11 @@ duplicate (Fold step1 initial1 extract1) =

14421526

14431527 step s a = second fromPure <$> step1 s a

14441528

1529+ -- Scanning may be problematic due to multiple finalizations.

1530+ extract = error "duplicate: scanning may be problematic"

1531+

1532+ final s = pure $ Fold step1 (pure $ Partial s) extract1 final1

1533+

14451534-- If there were a finalize/flushing action in the stream type that would be

14461535-- equivalent to running initialize in Fold. But we do not have a flushing

14471536-- action in streams.

@@ -1453,9 +1542,9 @@ duplicate (Fold step1 initial1 extract1) =

14531542-- /Pre-release/

14541543{-# INLINE reduce #-}

14551544reduce :: Monad m => Fold m a b -> m (Fold m a b)

1456−reduce (Fold step initial extract) = do

1545+reduce (Fold step initial extract final) = do

14571546 i <- initial

1458− return $ Fold step (return i) extract

1547+ return $ Fold step (return i) extract final

14591548

14601549-- This is the dual of Stream @cons@.

14611550

@@ -1465,7 +1554,8 @@ reduce (Fold step initial extract) = do

14651554-- /Pre-release/

14661555{-# INLINE snoclM #-}

14671556snoclM :: Monad m => Fold m a b -> m a -> Fold m a b

1468−snoclM (Fold fstep finitial fextract) action = Fold fstep initial fextract

1557+snoclM (Fold fstep finitial fextract ffinal) action =

1558+ Fold fstep initial fextract ffinal

14691559

14701560 where

14711561

@@ -1492,7 +1582,8 @@ snoclM (Fold fstep finitial fextract) action = Fold fstep initial fextract

14921582{-# INLINE snocl #-}

14931583snocl :: Monad m => Fold m a b -> a -> Fold m a b

14941584-- snocl f = snoclM f . return

1495−snocl (Fold fstep finitial fextract) a = Fold fstep initial fextract

1585+snocl (Fold fstep finitial fextract ffinal) a =

1586+ Fold fstep initial fextract ffinal

14961587

14971588 where

14981589

@@ -1512,12 +1603,12 @@ snocl (Fold fstep finitial fextract) a = Fold fstep initial fextract

15121603-- /Pre-release/

15131604{-# INLINE snocM #-}

15141605snocM :: Monad m => Fold m a b -> m a -> m (Fold m a b)

1515−snocM (Fold step initial extract) action = do

1606+snocM (Fold step initial extract final) action = do

15161607 res <- initial

15171608 r <- case res of

15181609 Partial fs -> action >>= step fs

15191610 Done _ -> return res

1520− return $ Fold step (return r) extract

1611+ return $ Fold step (return r) extract final

15211612

15221613-- Definitions:

15231614--

@@ -1536,12 +1627,12 @@ snocM (Fold step initial extract) action = do

15361627-- /Pre-release/

15371628{-# INLINE snoc #-}

15381629snoc :: Monad m => Fold m a b -> a -> m (Fold m a b)

1539−snoc (Fold step initial extract) a = do

1630+snoc (Fold step initial extract final) a = do

15401631 res <- initial

15411632 r <- case res of

15421633 Partial fs -> step fs a

15431634 Done _ -> return res

1544− return $ Fold step (return r) extract

1635+ return $ Fold step (return r) extract final

15451636

15461637-- | Append a singleton value to the fold.

15471638--

@@ -1569,7 +1660,7 @@ addOne = flip snoc

15691660-- /Pre-release/

15701661{-# INLINE extractM #-}

15711662extractM :: Monad m => Fold m a b -> m b

1572−extractM (Fold _ initial extract) = do

1663+extractM (Fold _ initial extract _) = do

15731664 res <- initial

15741665 case res of

15751666 Partial fs -> extract fs

@@ -1578,14 +1669,15 @@ extractM (Fold _ initial extract) = do

15781669-- | Close a fold so that it does not accept any more input.

15791670{-# INLINE close #-}

15801671close :: Monad m => Fold m a b -> Fold m a b

1581−close (Fold _ initial1 extract1) = Fold undefined initial undefined

1672+close (Fold _ initial1 _ final1) =

1673+ Fold undefined initial undefined undefined

15821674

15831675 where

15841676

15851677 initial = do

15861678 res <- initial1

15871679 case res of

1588− Partial s -> Done <$> extract1 s

1680+ Partial s -> Done <$> final1 s

15891681 Done b -> return $ Done b

15901682

15911683-- Corresponds to the null check for streams.

@@ -1595,7 +1687,7 @@ close (Fold _ initial1 extract1) = Fold undefined initial undefined

15951687-- /Pre-release/

15961688{-# INLINE isClosed #-}

15971689isClosed :: Monad m => Fold m a b -> m Bool

1598−isClosed (Fold _ initial _) = do

1690+isClosed (Fold _ initial _ _) = do

15991691 res <- initial

16001692 return $ case res of

16011693 Partial _ -> False

@@ -1629,8 +1721,10 @@ data ManyState s1 s2

16291721--

16301722{-# INLINE many #-}

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

1632−many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =

1633− Fold step initial extract

1724+many

1725+ (Fold sstep sinitial sextract sfinal)

1726+ (Fold cstep cinitial cextract cfinal) =

1727+ Fold step initial extract final

16341728

16351729 where

16361730

@@ -1679,6 +1773,13 @@ many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =

16791773 Partial s -> cextract s

16801774 Done b -> return b

16811775

1776+ final (ManyFirst ss cs) = sfinal ss *> cfinal cs

1777+ final (ManyLoop ss cs) = do

1778+ cres <- sfinal ss >>= cstep cs

1779+ case cres of

1780+ Partial s -> cfinal s

1781+ Done b -> return b

1782+

16821783-- | Like many, but the "first" fold emits an output at the end even if no

16831784-- input is received.

16841785--

@@ -1688,8 +1789,10 @@ many (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =

16881789--

16891790{-# INLINE manyPost #-}

16901791manyPost :: Monad m => Fold m a b -> Fold m b c -> Fold m a c

1691−manyPost (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =

1692− Fold step initial extract

1792+manyPost

1793+ (Fold sstep sinitial sextract sfinal)

1794+ (Fold cstep cinitial cextract cfinal) =

1795+ Fold step initial extract final

16931796

16941797 where

16951798

@@ -1725,6 +1828,12 @@ manyPost (Fold sstep sinitial sextract) (Fold cstep cinitial cextract) =

17251828 Partial s -> cextract s

17261829 Done b -> return b

17271830

1831+ final (Tuple' ss cs) = do

1832+ cres <- sfinal ss >>= cstep cs

1833+ case cres of

1834+ Partial s -> cfinal s

1835+ Done b -> return b

1836+

17281837-- | @groupsOf n split collect@ repeatedly applies the @split@ fold to chunks

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

17301839-- fold.

@@ -1753,7 +1862,10 @@ groupsOf n split = many (take n split)

17531862--

17541863{-# INLINE refoldMany #-}

17551864refoldMany :: Monad m => Fold m a b -> Refold m x b c -> Refold m x a c

1756−refoldMany (Fold sstep sinitial sextract) (Refold cstep cinject cextract) =

1865+refoldMany

1866+ (Fold sstep sinitial sextract _sfinal)

1867+ -- XXX We will need a "final" in refold as well

1868+ (Refold cstep cinject cextract) =

17571869 Refold step inject extract

17581870

17591871 where

@@ -1804,7 +1916,9 @@ data ConsumeManyState x cs ss = ConsumeMany x cs (Either ss ss)

18041916-- /Internal/

18051917{-# INLINE refoldMany1 #-}

18061918refoldMany1 :: Monad m => Refold m x a b -> Fold m b c -> Refold m x a c

1807−refoldMany1 (Refold sstep sinject sextract) (Fold cstep cinitial cextract) =

1919+refoldMany1

1920+ (Refold sstep sinject sextract)

1921+ (Fold cstep cinitial cextract _cfinal) =

18081922 Refold step inject extract

18091923

18101924 where

@@ -1855,7 +1969,7 @@ refoldMany1 (Refold sstep sinject sextract) (Fold cstep cinitial cextract) =

18551969{-# INLINE refold #-}

18561970refold :: Monad m => Refold m b a c -> Fold m a b -> Fold m a c

18571971refold (Refold step inject extract) f =

1858− Fold step (extractM f >>= inject) extract

1972+ Fold step (extractM f >>= inject) extract extract

18591973

18601974------------------------------------------------------------------------------

18611975-- morphInner

@@ -1865,8 +1979,8 @@ refold (Refold step inject extract) f =

18651979--

18661980-- /Pre-release/

18671981morphInner :: (forall x. m x -> n x) -> Fold m a b -> Fold n a b

1868−morphInner f (Fold step initial extract) =

1869− Fold (\x a -> f $ step x a) (f initial) (f . extract)

1982+morphInner f (Fold step initial extract final) =

1983+ Fold (\x a -> f $ step x a) (f initial) (f . extract) (f . final)

18701984

18711985-- | Adapt a pure fold to any monad.

18721986--

core/src/Streamly/Internal/Data/Fold/Window.hs+3−3

@@ -148,7 +148,7 @@ windowRollingMap f = Fold.foldl' f1 initial

148148--

149149{-# INLINE windowSumInt #-}

150150windowSumInt :: forall m a. (Monad m, Integral a) => Fold m (a, Maybe a) a

151−windowSumInt = Fold step initial extract

151+windowSumInt = Fold step initial extract extract

152152

153153 where

154154

@@ -182,7 +182,7 @@ windowSumInt = Fold step initial extract

182182--

183183{-# INLINE windowSum #-}

184184windowSum :: forall m a. (Monad m, Num a) => Fold m (a, Maybe a) a

185−windowSum = Fold step initial extract

185+windowSum = Fold step initial extract extract

186186

187187 where

188188

@@ -267,7 +267,7 @@ windowPowerSumFrac p = windowLmap (** p) windowSum

267267--

268268{-# INLINE windowRange #-}

269269windowRange :: (MonadIO m, Storable a, Ord a) => Int -> Fold m a (Maybe (a, a))

270−windowRange n = Fold step initial extract

270+windowRange n = Fold step initial extract extract

271271

272272 where

273273

core/src/Streamly/Internal/Data/IsMap.hs+4

@@ -28,6 +28,8 @@ class IsMap f where

2828 mapDelete :: Key f -> f a -> f a

2929 mapUnion :: f a -> f a -> f a

3030 mapNull :: f a -> Bool

31+ mapTraverseWithKey ::

32+ Applicative t => (Key f -> a -> t b) -> f a -> t (f b)

3133

3234instance Ord k => IsMap (Map k) where

3335 type Key (Map k) = k

@@ -39,6 +41,7 @@ instance Ord k => IsMap (Map k) where

3941 mapDelete = Map.delete

4042 mapUnion = Map.union

4143 mapNull = Map.null

44+ mapTraverseWithKey = Map.traverseWithKey

4245

4346instance IsMap IntMap.IntMap where

4447 type Key IntMap.IntMap = Int

@@ -50,3 +53,4 @@ instance IsMap IntMap.IntMap where

5053 mapDelete = IntMap.delete

5154 mapUnion = IntMap.union

5255 mapNull = IntMap.null

56+ mapTraverseWithKey = IntMap.traverseWithKey

core/src/Streamly/Internal/Data/MutArray/Generic.hs+1−1

@@ -598,7 +598,7 @@ arrayChunkSize = 1024

598598-- /Pre-release/

599599{-# INLINE_NORMAL writeNUnsafe #-}

600600writeNUnsafe :: MonadIO m => Int -> Fold m a (MutArray a)

601−writeNUnsafe n = Fold step initial return

601+writeNUnsafe n = Fold step initial return return

602602

603603 where

604604

core/src/Streamly/Internal/Data/Parser.hs+123−118

@@ -21,8 +21,8 @@ module Streamly.Internal.Data.Parser

2121 , Step (..)

2222 , Initial (..)

2323

24− -- * Downgrade to Fold

25− , toFold

24+ -- -- * Downgrade to Fold

25+ -- , toFold

2626

2727 -- First order parsers

2828 -- * Accumulators

@@ -270,6 +270,10 @@ import Prelude hiding

270270-- Downgrade a parser to a Fold

271271-------------------------------------------------------------------------------

272272

273+-- XXX Parsers cannot be converted to folds, because they do not have a

274+-- scanning function. Can we move the applicative folds to parsers instead?

275+-- need to measure the performance.

276+{-

273277-- | Make a 'Fold' from a 'Parser'. The fold just throws an exception if the

274278-- parser fails or tries to backtrack.

275279--

@@ -281,7 +285,7 @@ import Prelude hiding

281285--

282286{-# INLINE toFold #-}

283287toFold :: Monad m => Parser a m b -> Fold m a b

284−toFold (Parser pstep pinitial pextract) = Fold step initial extract

288+toFold (Parser pstep pinitial pextract) = Fold step initial extract final

285289

286290 where

287291

@@ -317,6 +321,7 @@ toFold (Parser pstep pinitial pextract) = Fold step initial extract

317321 Continue n _ -> cerror n

318322 Done n _ -> derror n

319323 Error err -> eerror err

324+-}

320325

321326-------------------------------------------------------------------------------

322327-- Upgrade folds to parses

@@ -327,7 +332,7 @@ toFold (Parser pstep pinitial pextract) = Fold step initial extract

327332--

328333{-# INLINE fromFold #-}

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

330−fromFold (Fold fstep finitial fextract) = Parser step initial extract

335+fromFold (Fold fstep finitial _ ffinal) = Parser step initial extract

331336

332337 where

333338

@@ -345,7 +350,7 @@ fromFold (Fold fstep finitial fextract) = Parser step initial extract

345350 FL.Partial s1 -> Partial 0 s1

346351 FL.Done b -> Done 0 b

347352

348− extract = fmap (Done 0) . fextract

353+ extract = fmap (Done 0) . ffinal

349354

350355-- | Convert a Maybe returning fold to an error returning parser. The first

351356-- argument is the error message that the parser would return when the fold

@@ -355,7 +360,7 @@ fromFold (Fold fstep finitial fextract) = Parser step initial extract

355360--

356361{-# INLINE fromFoldMaybe #-}

357362fromFoldMaybe :: Monad m => String -> Fold m a (Maybe b) -> Parser a m b

358−fromFoldMaybe errMsg (Fold fstep finitial fextract) =

363+fromFoldMaybe errMsg (Fold fstep finitial _ ffinal) =

359364 Parser step initial extract

360365

361366 where

@@ -381,7 +386,7 @@ fromFoldMaybe errMsg (Fold fstep finitial fextract) =

381386 Nothing -> Error errMsg

382387

383388 extract s = do

384− res <- fextract s

389+ res <- ffinal s

385390 case res of

386391 Just x -> return $ Done 0 x

387392 Nothing -> return $ Error errMsg

@@ -630,7 +635,7 @@ data Tuple'Fused a b = Tuple'Fused !a !b deriving Show

630635--

631636{-# INLINE takeBetween #-}

632637takeBetween :: Monad m => Int -> Int -> Fold m a b -> Parser a m b

633−takeBetween low high (Fold fstep finitial fextract) =

638+takeBetween low high (Fold fstep finitial _ ffinal) =

634639

635640 Parser step initial (extract streamErr)

636641

@@ -685,7 +690,7 @@ takeBetween low high (Fold fstep finitial fextract) =

685690 then return $ Continue 0 s1

686691 else if i1 < high

687692 then return $ Partial 0 s1

688− else fmap (Done 0) (fextract s)

693+ else fmap (Done 0) (ffinal s)

689694 FL.Done b ->

690695 return

691696 $ if i1 >= low

@@ -695,12 +700,12 @@ takeBetween low high (Fold fstep finitial fextract) =

695700 step (Tuple'Fused i s) a = fstep s a >>= snext i

696701

697702 extract f (Tuple'Fused i s)

698− | i >= low && i <= high = fmap (Done 0) (fextract s)

703+ | i >= low && i <= high = fmap (Done 0) (ffinal s)

699704 | otherwise = return $ Error (f i)

700705

701706 -- XXX Need to make Initial return type Step to deduplicate this

702707 iextract f (Tuple'Fused i s)

703− | i >= low && i <= high = fmap IDone (fextract s)

708+ | i >= low && i <= high = fmap IDone (ffinal s)

704709 | otherwise = return $ IError (f i)

705710

706711-- | Stops after taking exactly @n@ input elements.

@@ -717,7 +722,7 @@ takeBetween low high (Fold fstep finitial fextract) =

717722--

718723{-# INLINE takeEQ #-}

719724takeEQ :: Monad m => Int -> Fold m a b -> Parser a m b

720−takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

725+takeEQ n (Fold fstep finitial _ ffinal) = Parser step initial extract

721726

722727 where

723728

@@ -727,7 +732,7 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

727732 FL.Partial s ->

728733 if n > 0

729734 then return $ IPartial $ Tuple'Fused 1 s

730− else fmap IDone (fextract s)

735+ else fmap IDone (ffinal s)

731736 FL.Done b -> return $

732737 if n > 0

733738 then IError

@@ -751,7 +756,7 @@ takeEQ n (Fold fstep finitial fextract) = Parser step initial extract

751756 -- assert (n == i1)

752757 Done 0

753758 <$> case res of

754− FL.Partial s -> fextract s

759+ FL.Partial s -> ffinal s

755760 FL.Done b -> return b

756761

757762 extract (Tuple'Fused i _) =

@@ -783,7 +788,7 @@ data TakeGEState s =

783788--

784789{-# INLINE takeGE #-}

785790takeGE :: Monad m => Int -> Fold m a b -> Parser a m b

786−takeGE n (Fold fstep finitial fextract) = Parser step initial extract

791+takeGE n (Fold fstep finitial _ ffinal) = Parser step initial extract

787792

788793 where

789794

@@ -831,7 +836,7 @@ takeGE n (Fold fstep finitial fextract) = Parser step initial extract

831836 $ Error

832837 $ "takeGE: Expecting at least " ++ show n

833838 ++ " elements, input terminated on " ++ show (i - 1)

834− extract (TakeGEGE r) = fmap (Done 0) $ fextract r

839+ extract (TakeGEGE r) = fmap (Done 0) $ ffinal r

835840

836841-------------------------------------------------------------------------------

837842-- Conditional splitting

@@ -892,7 +897,7 @@ takeWhileP predicate (Parser pstep pinitial pextract) =

892897{-# INLINE takeWhile #-}

893898takeWhile :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

894899-- takeWhile cond f = takeWhileP cond (fromFold f)

895−takeWhile predicate (Fold fstep finitial fextract) =

900+takeWhile predicate (Fold fstep finitial _ ffinal) =

896901 Parser step initial extract

897902

898903 where

@@ -911,9 +916,9 @@ takeWhile predicate (Fold fstep finitial fextract) =

911916 $ case fres of

912917 FL.Partial s1 -> Partial 0 s1

913918 FL.Done b -> Done 0 b

914− else Done 1 <$> fextract s

919+ else Done 1 <$> ffinal s

915920

916− extract s = fmap (Done 0) (fextract s)

921+ extract s = fmap (Done 0) (ffinal s)

917922

918923{-

919924-- XXX This may not be composable because of the b argument. We can instead

@@ -933,7 +938,7 @@ takeWhile1 acc cond f = undefined

933938{-# INLINE takeWhile1 #-}

934939takeWhile1 :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

935940-- takeWhile1 cond f = takeWhileP cond (takeBetween 1 maxBound f)

936−takeWhile1 predicate (Fold fstep finitial fextract) =

941+takeWhile1 predicate (Fold fstep finitial _ ffinal) =

937942 Parser step initial extract

938943

939944 where

@@ -963,11 +968,11 @@ takeWhile1 predicate (Fold fstep finitial fextract) =

963968 if predicate a

964969 then process s a

965970 else do

966− b <- fextract s

971+ b <- ffinal s

967972 return $ Done 1 b

968973

969974 extract (Left' _) = return $ Error "takeWhile1: end of input"

970− extract (Right' s) = fmap (Done 0) (fextract s)

975+ extract (Right' s) = fmap (Done 0) (ffinal s)

971976

972977-- | Drain the input as long as the predicate succeeds, running the effects and

973978-- discarding the results.

@@ -996,7 +1001,7 @@ takeFramedByGeneric :: Monad m =>

9961001 -> Maybe (a -> Bool) -- is frame end?

9971002 -> Fold m a b

9981003 -> Parser a m b

999−takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

1004+takeFramedByGeneric esc begin end (Fold fstep finitial _ ffinal) =

10001005

10011006 Parser step initial extract

10021007

@@ -1028,20 +1033,20 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

10281033 if isEnd a

10291034 then

10301035 if n == 0

1031− then Done 0 <$> fextract s

1036+ then Done 0 <$> ffinal s

10321037 else process s a (n - 1)

10331038 else

10341039 let n1 = if isBegin a then n + 1 else n

10351040 in process s a n1

10361041 Nothing -> -- takeEndBy case

10371042 if isEnd a

1038− then Done 0 <$> fextract s

1043+ then Done 0 <$> ffinal s

10391044 else process s a n

10401045 Nothing -> -- takeStartBy case

10411046 case begin of

10421047 Just isBegin ->

10431048 if isBegin a

1044− then Done 0 <$> fextract s

1049+ then Done 0 <$> ffinal s

10451050 else process s a n

10461051 Nothing ->

10471052 error $ "takeFramedByGeneric: "

@@ -1066,7 +1071,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

10661071 case end of

10671072 Just isEnd ->

10681073 if isEnd a

1069− then Done 0 <$> fextract s

1074+ then Done 0 <$> ffinal s

10701075 else processCheckEsc s a 0

10711076 Nothing ->

10721077 error "Both begin and end frame predicate missing"

@@ -1081,7 +1086,7 @@ takeFramedByGeneric esc begin end (Fold fstep finitial fextract) =

10811086 case begin of

10821087 Just _ ->

10831088 case end of

1084− Nothing -> fmap (Done 0) $ fextract s

1089+ Nothing -> fmap (Done 0) $ ffinal s

10851090 Just _ -> err "takeFramedByGeneric: missing frame end"

10861091 Nothing -> err "takeFramedByGeneric: missing closing frame"

10871092 extract (FrameEscEsc _ _) = err "takeFramedByGeneric: trailing escape"

@@ -1120,7 +1125,7 @@ blockWithQuotes :: (Monad m, Eq a) =>

11201125 -> Fold m a b

11211126 -> Parser a m b

11221127blockWithQuotes isEsc isQuote bopen bclose

1123− (Fold fstep finitial fextract) =

1128+ (Fold fstep finitial _ ffinal) =

11241129 Parser step initial extract

11251130

11261131 where

@@ -1150,7 +1155,7 @@ blockWithQuotes isEsc isQuote bopen bclose

11501155 | a == bopen = process s a (BlockUnquoted (level + 1))

11511156 | a == bclose =

11521157 if level == 1

1153− then fmap (Done 0) (fextract s)

1158+ then fmap (Done 0) (ffinal s)

11541159 else process s a (BlockUnquoted (level - 1))

11551160 | isQuote a = process s a (BlockQuoted level)

11561161 | otherwise = process s a (BlockUnquoted level)

@@ -1164,7 +1169,7 @@ blockWithQuotes isEsc isQuote bopen bclose

11641169

11651170 err = return . Error

11661171

1167− extract (BlockInit s) = fmap (Done 0) $ fextract s

1172+ extract (BlockInit s) = fmap (Done 0) $ ffinal s

11681173 extract (BlockUnquoted level _) =

11691174 err $ "blockWithQuotes: finished at block nest level " ++ show level

11701175 extract (BlockQuoted level _) =

@@ -1299,7 +1304,7 @@ takeEitherSepBy _cond = undefined -- D.toParserK . D.takeEitherSepBy cond

12991304--

13001305{-# INLINE takeStartBy #-}

13011306takeStartBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

1302−takeStartBy cond (Fold fstep finitial fextract) =

1307+takeStartBy cond (Fold fstep finitial _ ffinal) =

13031308

13041309 Parser step initial extract

13051310

@@ -1327,10 +1332,10 @@ takeStartBy cond (Fold fstep finitial fextract) =

13271332 step (Right' s) a =

13281333 if not (cond a)

13291334 then process s a

1330− else Done 1 <$> fextract s

1335+ else Done 1 <$> ffinal s

13311336

1332− extract (Left' s) = fmap (Done 0) $ fextract s

1333− extract (Right' s) = fmap (Done 0) $ fextract s

1337+ extract (Left' s) = fmap (Done 0) $ ffinal s

1338+ extract (Right' s) = fmap (Done 0) $ ffinal s

13341339

13351340-- | Like 'takeStartBy' but drops the separator.

13361341--

@@ -1366,7 +1371,7 @@ takeFramedByEsc_ :: Monad m =>

13661371 (a -> Bool) -> (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b

13671372-- takeFramedByEsc_ isEsc isEnd p =

13681373-- takeFramedByGeneric (Just isEsc) Nothing (Just isEnd) (toFold p)

1369−takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =

1374+takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial _ ffinal ) =

13701375

13711376 Parser step initial extract

13721377

@@ -1402,7 +1407,7 @@ takeFramedByEsc_ isEsc isBegin isEnd (Fold fstep finitial fextract) =

14021407 in process s a n1

14031408 else

14041409 if n == 0

1405− then Done 0 <$> fextract s

1410+ then Done 0 <$> ffinal s

14061411 else process s a (n - 1)

14071412 step (FrameEscEsc s n) a = process s a n

14081413

@@ -1424,7 +1429,7 @@ takeFramedBy_ :: Monad m =>

14241429 (a -> Bool) -> (a -> Bool) -> Fold m a b -> Parser a m b

14251430-- takeFramedBy_ isBegin isEnd =

14261431-- takeFramedByGeneric (Just (const False)) (Just isBegin) (Just isEnd)

1427−takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =

1432+takeFramedBy_ isBegin isEnd (Fold fstep finitial _ ffinal) =

14281433

14291434 Parser step initial extract

14301435

@@ -1454,7 +1459,7 @@ takeFramedBy_ isBegin isEnd (Fold fstep finitial fextract) =

14541459 | not (isEnd a) =

14551460 let n1 = if isBegin a then n + 1 else n

14561461 in process s a n1

1457− | n == 0 = Done 0 <$> fextract s

1462+ | n == 0 = Done 0 <$> ffinal s

14581463 | otherwise = process s a (n - 1)

14591464

14601465 err = return . Error

@@ -1489,7 +1494,7 @@ data WordByState s b = WBLeft !s | WBWord !s | WBRight !b

14891494--

14901495{-# INLINE wordBy #-}

14911496wordBy :: Monad m => (a -> Bool) -> Fold m a b -> Parser a m b

1492−wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

1497+wordBy predicate (Fold fstep finitial _ ffinal) = Parser step initial extract

14931498

14941499 where

14951500

@@ -1516,7 +1521,7 @@ wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

15161521 if not (predicate a)

15171522 then worder s a

15181523 else do

1519− b <- fextract s

1524+ b <- ffinal s

15201525 return $ Partial 0 $ WBRight b

15211526 step (WBRight b) a =

15221527 return

@@ -1524,8 +1529,8 @@ wordBy predicate (Fold fstep finitial fextract) = Parser step initial extract

15241529 then Done 1 b

15251530 else Partial 0 $ WBRight b

15261531

1527− extract (WBLeft s) = fmap (Done 0) $ fextract s

1528− extract (WBWord s) = fmap (Done 0) $ fextract s

1532+ extract (WBLeft s) = fmap (Done 0) $ ffinal s

1533+ extract (WBWord s) = fmap (Done 0) $ ffinal s

15291534 extract (WBRight b) = return (Done 0 b)

15301535

15311536data WordFramedState s b =

@@ -1562,7 +1567,7 @@ wordFramedBy :: Monad m =>

15621567 -> Fold m a b

15631568 -> Parser a m b

15641569wordFramedBy isEsc isBegin isEnd isSep

1565− (Fold fstep finitial fextract) =

1570+ (Fold fstep finitial _ ffinal) =

15661571 Parser step initial extract

15671572

15681573 where

@@ -1593,7 +1598,7 @@ wordFramedBy isEsc isBegin isEnd isSep

15931598 step (WordFramedWord s n) a

15941599 | isEsc a = return $ Continue 0 $ WordFramedEsc s n

15951600 | n == 0 && isSep a = do

1596− b <- fextract s

1601+ b <- ffinal s

15971602 return $ Partial 0 $ WordFramedSkipPost b

15981603 | otherwise = do

15991604 -- We need to use different order for checking begin and end for

@@ -1626,10 +1631,10 @@ wordFramedBy isEsc isBegin isEnd isSep

16261631

16271632 err = return . Error

16281633

1629− extract (WordFramedSkipPre s) = fmap (Done 0) $ fextract s

1634+ extract (WordFramedSkipPre s) = fmap (Done 0) $ ffinal s

16301635 extract (WordFramedWord s n) =

16311636 if n == 0

1632− then fmap (Done 0) $ fextract s

1637+ then fmap (Done 0) $ ffinal s

16331638 else err "wordFramedBy: missing frame end"

16341639 extract (WordFramedEsc _ _) =

16351640 err "wordFramedBy: trailing escape"

@@ -1716,7 +1721,7 @@ wordWithQuotes :: (Monad m, Eq a) =>

17161721 -> Fold m a b

17171722 -> Parser a m b

17181723wordWithQuotes keepQuotes tr escChar toRight isSep

1719− (Fold fstep finitial fextract) =

1724+ (Fold fstep finitial _ ffinal) =

17201725 Parser step initial extract

17211726

17221727 where

@@ -1767,7 +1772,7 @@ wordWithQuotes keepQuotes tr escChar toRight isSep

17671772 step (WordUnquotedWord s) a

17681773 | isEsc a = return $ Continue 0 $ WordUnquotedEsc s

17691774 | isSep a = do

1770− b <- fextract s

1775+ b <- ffinal s

17711776 return $ Partial 0 $ WordQuotedSkipPost b

17721777 | otherwise = do

17731778 case toRight a of

@@ -1815,11 +1820,11 @@ wordWithQuotes keepQuotes tr escChar toRight isSep

18151820

18161821 err = return . Error

18171822

1818− extract (WordQuotedSkipPre s) = fmap (Done 0) $ fextract s

1819− extract (WordUnquotedWord s) = fmap (Done 0) $ fextract s

1823+ extract (WordQuotedSkipPre s) = fmap (Done 0) $ ffinal s

1824+ extract (WordUnquotedWord s) = fmap (Done 0) $ ffinal s

18201825 extract (WordQuotedWord s n _ _) =

18211826 if n == 0

1822− then fmap (Done 0) $ fextract s

1827+ then fmap (Done 0) $ ffinal s

18231828 else err "wordWithQuotes: missing frame end"

18241829 extract WordQuotedEsc {} =

18251830 err "wordWithQuotes: trailing escape"

@@ -1897,7 +1902,7 @@ data GroupByState a s

18971902--

18981903{-# INLINE groupBy #-}

18991904groupBy :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b

1900−groupBy eq (Fold fstep finitial fextract) = Parser step initial extract

1905+groupBy eq (Fold fstep finitial _ ffinal) = Parser step initial extract

19011906

19021907 where

19031908

@@ -1920,10 +1925,10 @@ groupBy eq (Fold fstep finitial fextract) = Parser step initial extract

19201925 step (GroupByGrouping a0 s) a =

19211926 if eq a0 a

19221927 then grouper s a0 a

1923− else Done 1 <$> fextract s

1928+ else Done 1 <$> ffinal s

19241929

1925− extract (GroupByInit s) = fmap (Done 0) $ fextract s

1926− extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s

1930+ extract (GroupByInit s) = fmap (Done 0) $ ffinal s

1931+ extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s

19271932

19281933-- | Unlike 'groupBy' this combinator performs a rolling comparison of two

19291934-- successive elements in the input stream. Assuming the input stream

@@ -1957,7 +1962,7 @@ groupBy eq (Fold fstep finitial fextract) = Parser step initial extract

19571962--

19581963{-# INLINE groupByRolling #-}

19591964groupByRolling :: Monad m => (a -> a -> Bool) -> Fold m a b -> Parser a m b

1960−groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract

1965+groupByRolling eq (Fold fstep finitial _ ffinal) = Parser step initial extract

19611966

19621967 where

19631968

@@ -1980,10 +1985,10 @@ groupByRolling eq (Fold fstep finitial fextract) = Parser step initial extract

19801985 step (GroupByGrouping a0 s) a =

19811986 if eq a0 a

19821987 then grouper s a

1983− else Done 1 <$> fextract s

1988+ else Done 1 <$> ffinal s

19841989

1985− extract (GroupByInit s) = fmap (Done 0) $ fextract s

1986− extract (GroupByGrouping _ s) = fmap (Done 0) $ fextract s

1990+ extract (GroupByInit s) = fmap (Done 0) $ ffinal s

1991+ extract (GroupByGrouping _ s) = fmap (Done 0) $ ffinal s

19871992

19881993{-# ANN type GroupByStatePair Fuse #-}

19891994data GroupByStatePair a s1 s2

@@ -2007,8 +2012,8 @@ groupByRollingEither :: Monad m =>

20072012 (a -> a -> Bool) -> Fold m a b -> Fold m a c -> Parser a m (Either b c)

20082013groupByRollingEither

20092014 eq

2010− (Fold fstep1 finitial1 fextract1)

2011− (Fold fstep2 finitial2 fextract2) = Parser step initial extract

2015+ (Fold fstep1 finitial1 _ ffinal1)

2016+ (Fold fstep2 finitial2 _ ffinal2) = Parser step initial extract

20122017

20132018 where

20142019

@@ -2067,21 +2072,21 @@ groupByRollingEither

20672072 step (GroupByGroupingPairL a0 s1 s2) a =

20682073 if not (eq a0 a)

20692074 then grouperL2 s1 s2 a

2070− else Done 1 . Left <$> fextract1 s1

2075+ else Done 1 . Left <$> ffinal1 s1

20712076

20722077 step (GroupByGroupingPairR a0 s1 s2) a =

20732078 if eq a0 a

20742079 then grouperR2 s1 s2 a

2075− else Done 1 . Right <$> fextract2 s2

2080+ else Done 1 . Right <$> ffinal2 s2

20762081

2077− extract (GroupByInitPair s1 _) = Done 0 . Left <$> fextract1 s1

2078− extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> fextract1 s1

2079− extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> fextract2 s2

2082+ extract (GroupByInitPair s1 _) = Done 0 . Left <$> ffinal1 s1

2083+ extract (GroupByGroupingPairL _ s1 _) = Done 0 . Left <$> ffinal1 s1

2084+ extract (GroupByGroupingPairR _ _ s2) = Done 0 . Right <$> ffinal2 s2

20802085 extract (GroupByGroupingPair a s1 _) = do

20812086 res <- fstep1 s1 a

20822087 case res of

20832088 FL.Done b -> return $ Done 0 (Left b)

2084− FL.Partial s11 -> Done 0 . Left <$> fextract1 s11

2089+ FL.Partial s11 -> Done 0 . Left <$> ffinal1 s11

20852090

20862091-- XXX use an Unfold instead of a list?

20872092-- XXX custom combinators for matching list, array and stream?

@@ -2234,7 +2239,7 @@ postscan = undefined

22342239{-# INLINE zipWithM #-}

22352240zipWithM :: Monad m =>

22362241 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x

2237−zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

2242+zipWithM zf (D.Stream sstep state) (Fold fstep finitial _ ffinal) =

22382243 Parser step initial extract

22392244

22402245 where

@@ -2247,7 +2252,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

22472252 case r of

22482253 D.Yield x s -> return $ IPartial (Just' x, s, fs)

22492254 D.Stop -> do

2250− x <- fextract fs

2255+ x <- ffinal fs

22512256 return $ IDone x

22522257 -- Need Skip/Continue in initial to loop right here

22532258 D.Skip s -> return $ IPartial (Nothing', s, fs)

@@ -2262,7 +2267,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

22622267 case r of

22632268 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)

22642269 D.Stop -> do

2265− x <- fextract fs1

2270+ x <- ffinal fs1

22662271 return $ Done 0 x

22672272 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)

22682273 FL.Done x -> return $ Done 0 x

@@ -2277,7 +2282,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

22772282 return $ Continue 0 (Nothing', s, fs1)

22782283 FL.Done x -> return $ Done 0 x

22792284 D.Stop -> do

2280− x <- fextract fs

2285+ x <- ffinal fs

22812286 return $ Done 1 x

22822287 D.Skip s -> return $ Continue 1 (Nothing', s, fs)

22832288

@@ -2561,7 +2566,7 @@ deintercalateAll :: Monad m =>

25612566deintercalateAll

25622567 (Parser stepL initialL extractL)

25632568 (Parser stepR initialR _)

2564− (Fold fstep finitial fextract) = Parser step initial extract

2569+ (Fold fstep finitial _ ffinal) = Parser step initial extract

25652570

25662571 where

25672572

@@ -2632,9 +2637,9 @@ deintercalateAll

26322637 extractResult n fs r = do

26332638 res <- fstep fs r

26342639 case res of

2635− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2640+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

26362641 FL.Done c -> return (Done n c)

2637− extract (DeintercalateAllInitL fs) = fmap (Done 0) $ fextract fs

2642+ extract (DeintercalateAllInitL fs) = fmap (Done 0) $ ffinal fs

26382643 extract (DeintercalateAllL fs sL) = do

26392644 r <- extractL sL

26402645 case r of

@@ -2642,7 +2647,7 @@ deintercalateAll

26422647 Error err -> return $ Error err

26432648 Continue n s -> return $ Continue n (DeintercalateAllL fs s)

26442649 Partial _ _ -> error "Partial in extract"

2645− extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs

2650+ extract (DeintercalateAllInitR fs) = fmap (Done 0) $ ffinal fs

26462651 extract (DeintercalateAllR _ _) =

26472652 return $ Error "deintercalateAll: input ended at 'Right' value"

26482653

@@ -2685,7 +2690,7 @@ deintercalate :: Monad m =>

26852690deintercalate

26862691 (Parser stepL initialL extractL)

26872692 (Parser stepR initialR _)

2688− (Fold fstep finitial fextract) = Parser step initial extract

2693+ (Fold fstep finitial _ ffinal) = Parser step initial extract

26892694

26902695 where

26912696

@@ -2716,7 +2721,7 @@ deintercalate

27162721 Done n b ->

27172722 processL (fstep fs (Left b)) n DeintercalateInitR

27182723 Error _ -> do

2719− xs <- fextract fs

2724+ xs <- ffinal fs

27202725 return $ Done cnt1 xs

27212726

27222727 {-# INLINE processR #-}

@@ -2736,7 +2741,7 @@ deintercalate

27362741 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)

27372742 Done n b -> processR (cnt1 - n) b fs n

27382743 Error _ -> do

2739− xs <- fextract fs

2744+ xs <- ffinal fs

27402745 return $ Done cnt1 xs

27412746

27422747 step (DeintercalateInitL fs) a = do

@@ -2771,17 +2776,17 @@ deintercalate

27712776 -- XXX We could have the fold accept pairs of (bR, bL)

27722777 FL.Done _ -> error "Fold terminated consuming partial input"

27732778 Error _ -> do

2774− xs <- fextract fs

2779+ xs <- ffinal fs

27752780 return $ Done cnt1 xs

27762781

27772782 {-# INLINE extractResult #-}

27782783 extractResult n fs r = do

27792784 res <- fstep fs r

27802785 case res of

2781− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2786+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

27822787 FL.Done c -> return (Done n c)

27832788

2784− extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs

2789+ extract (DeintercalateInitL fs) = fmap (Done 0) $ ffinal fs

27852790 extract (DeintercalateL cnt fs sL) = do

27862791 r <- extractL sL

27872792 case r of

@@ -2789,10 +2794,10 @@ deintercalate

27892794 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)

27902795 Partial _ _ -> error "Partial in extract"

27912796 Error _ -> do

2792− xs <- fextract fs

2797+ xs <- ffinal fs

27932798 return $ Done cnt xs

2794− extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs

2795− extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs

2799+ extract (DeintercalateInitR fs) = fmap (Done 0) $ ffinal fs

2800+ extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ ffinal fs

27962801 extract (DeintercalateRL cnt bR fs sL) = do

27972802 r <- extractL sL

27982803 case r of

@@ -2804,7 +2809,7 @@ deintercalate

28042809 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)

28052810 Partial _ _ -> error "Partial in extract"

28062811 Error _ -> do

2807− xs <- fextract fs

2812+ xs <- ffinal fs

28082813 return $ Done cnt xs

28092814

28102815{-# ANN type Deintercalate1State Fuse #-}

@@ -2841,7 +2846,7 @@ deintercalate1 :: Monad m =>

28412846deintercalate1

28422847 (Parser stepL initialL extractL)

28432848 (Parser stepR initialR _)

2844− (Fold fstep finitial fextract) = Parser step initial extract

2849+ (Fold fstep finitial _ ffinal) = Parser step initial extract

28452850

28462851 where

28472852

@@ -2895,7 +2900,7 @@ deintercalate1

28952900 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)

28962901 Done n b -> processR (cnt1 - n) b fs n

28972902 Error _ -> do

2898− xs <- fextract fs

2903+ xs <- ffinal fs

28992904 return $ Done cnt1 xs

29002905

29012906 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a

@@ -2924,14 +2929,14 @@ deintercalate1

29242929 -- XXX We could have the fold accept pairs of (bR, bL)

29252930 FL.Done _ -> error "Fold terminated consuming partial input"

29262931 Error _ -> do

2927− xs <- fextract fs

2932+ xs <- ffinal fs

29282933 return $ Done cnt1 xs

29292934

29302935 {-# INLINE extractResult #-}

29312936 extractResult n fs r = do

29322937 res <- fstep fs r

29332938 case res of

2934− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2939+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

29352940 FL.Done c -> return (Done n c)

29362941

29372942 extract (Deintercalate1InitL cnt fs sL) = do

@@ -2941,8 +2946,8 @@ deintercalate1

29412946 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)

29422947 Partial _ _ -> error "Partial in extract"

29432948 Error err -> return $ Error err

2944− extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs

2945− extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs

2949+ extract (Deintercalate1InitR fs) = fmap (Done 0) $ ffinal fs

2950+ extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ ffinal fs

29462951 extract (Deintercalate1RL cnt bR fs sL) = do

29472952 r <- extractL sL

29482953 case r of

@@ -2954,7 +2959,7 @@ deintercalate1

29542959 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)

29552960 Partial _ _ -> error "Partial in extract"

29562961 Error _ -> do

2957− xs <- fextract fs

2962+ xs <- ffinal fs

29582963 return $ Done cnt xs

29592964

29602965{-# ANN type SepByState Fuse #-}

@@ -2997,7 +3002,7 @@ sepBy :: Monad m =>

29973002sepBy

29983003 (Parser stepL initialL extractL)

29993004 (Parser stepR initialR _)

3000− (Fold fstep finitial fextract) = Parser step initial extract

3005+ (Fold fstep finitial _ ffinal) = Parser step initial extract

30013006

30023007 where

30033008

@@ -3028,7 +3033,7 @@ sepBy

30283033 Done n b ->

30293034 processL (fstep fs b) n SepByInitR

30303035 Error _ -> do

3031− xs <- fextract fs

3036+ xs <- ffinal fs

30323037 return $ Done cnt1 xs

30333038

30343039 {-# INLINE processR #-}

@@ -3048,7 +3053,7 @@ sepBy

30483053 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)

30493054 Done n _ -> processR (cnt1 - n) fs n

30503055 Error _ -> do

3051− xs <- fextract fs

3056+ xs <- ffinal fs

30523057 return $ Done cnt1 xs

30533058

30543059 step (SepByInitL fs) a = do

@@ -3070,10 +3075,10 @@ sepBy

30703075 extractResult n fs r = do

30713076 res <- fstep fs r

30723077 case res of

3073− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3078+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

30743079 FL.Done c -> return (Done n c)

30753080

3076− extract (SepByInitL fs) = fmap (Done 0) $ fextract fs

3081+ extract (SepByInitL fs) = fmap (Done 0) $ ffinal fs

30773082 extract (SepByL cnt fs sL) = do

30783083 r <- extractL sL

30793084 case r of

@@ -3081,10 +3086,10 @@ sepBy

30813086 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)

30823087 Partial _ _ -> error "Partial in extract"

30833088 Error _ -> do

3084− xs <- fextract fs

3089+ xs <- ffinal fs

30853090 return $ Done cnt xs

3086− extract (SepByInitR fs) = fmap (Done 0) $ fextract fs

3087− extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs

3091+ extract (SepByInitR fs) = fmap (Done 0) $ ffinal fs

3092+ extract (SepByR cnt fs _) = fmap (Done cnt) $ ffinal fs

30883093

30893094-- | Non-backtracking version of sepBy. Several times faster.

30903095{-# INLINE sepByAll #-}

@@ -3139,7 +3144,7 @@ sepBy1 :: Monad m =>

31393144sepBy1

31403145 (Parser stepL initialL extractL)

31413146 (Parser stepR initialR _)

3142− (Fold fstep finitial fextract) = Parser step initial extract

3147+ (Fold fstep finitial _ ffinal) = Parser step initial extract

31433148

31443149 where

31453150

@@ -3186,7 +3191,7 @@ sepBy1

31863191 Done n b ->

31873192 processL (fstep fs b) n SepBy1InitR

31883193 Error _ -> do

3189− xs <- fextract fs

3194+ xs <- ffinal fs

31903195 return $ Done cnt1 xs

31913196

31923197 {-# INLINE processR #-}

@@ -3206,7 +3211,7 @@ sepBy1

32063211 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)

32073212 Done n _ -> processR (cnt1 - n) fs n

32083213 Error _ -> do

3209− xs <- fextract fs

3214+ xs <- ffinal fs

32103215 return $ Done cnt1 xs

32113216

32123217 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a

@@ -3223,7 +3228,7 @@ sepBy1

32233228 extractResult n fs r = do

32243229 res <- fstep fs r

32253230 case res of

3226− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3231+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

32273232 FL.Done c -> return (Done n c)

32283233

32293234 extract (SepBy1InitL cnt fs sL) = do

@@ -3240,10 +3245,10 @@ sepBy1

32403245 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)

32413246 Partial _ _ -> error "Partial in extract"

32423247 Error _ -> do

3243− xs <- fextract fs

3248+ xs <- ffinal fs

32443249 return $ Done cnt xs

3245− extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs

3246− extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs

3250+ extract (SepBy1InitR fs) = fmap (Done 0) $ ffinal fs

3251+ extract (SepBy1R cnt fs _) = fmap (Done cnt) $ ffinal fs

32473252

32483253-------------------------------------------------------------------------------

32493254-- Interleaving a collection of parsers

@@ -3273,7 +3278,7 @@ roundRobin _ps _f = undefined

32733278{-# INLINE sequence #-}

32743279sequence :: Monad m =>

32753280 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c

3276−sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

3281+sequence (D.Stream sstep sstate) (Fold fstep finitial _ ffinal) =

32773282 Parser step initial extract

32783283

32793284 where

@@ -3291,7 +3296,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

32913296 case sres of

32923297 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)

32933298 D.Stop -> do

3294− c <- fextract fs

3299+ c <- ffinal fs

32953300 return $ Done 1 c

32963301 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)

32973302

@@ -3327,7 +3332,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

33273332 FL.Done c -> return $ Done 1 c

33283333 IError err -> return $ Error err

33293334

3330− extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs

3335+ extract (Nothing', _, fs) = fmap (Done 0) $ ffinal fs

33313336 extract (Just' (Parser pstep pinit pextr), ss, fs) = do

33323337 ps <- pinit

33333338 case ps of

@@ -3337,7 +3342,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

33373342 Done n b -> do

33383343 res <- fstep fs b

33393344 case res of

3340− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3345+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

33413346 FL.Done c -> return (Done n c)

33423347 Error err -> return $ Error err

33433348 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)

@@ -3345,7 +3350,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

33453350 IDone b -> do

33463351 fres <- fstep fs b

33473352 case fres of

3348− FL.Partial fs1 -> fmap (Done 0) $ fextract fs1

3353+ FL.Partial fs1 -> fmap (Done 0) $ ffinal fs1

33493354 FL.Done c -> return (Done 0 c)

33503355 IError err -> return $ Error err

33513356

@@ -3480,7 +3485,7 @@ manyTill :: Monad m

34803485 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c

34813486manyTill (Parser stepL initialL extractL)

34823487 (Parser stepR initialR _)

3483− (Fold fstep finitial fextract) =

3488+ (Fold fstep finitial _ ffinal) =

34843489 Parser step initial extract

34853490

34863491 where

@@ -3502,7 +3507,7 @@ manyTill (Parser stepL initialL extractL)

35023507 resR <- initialR

35033508 case resR of

35043509 IPartial sr -> return $ p (ManyTillR 0 fs sr)

3505− IDone _ -> d <$> fextract fs

3510+ IDone _ -> d <$> ffinal fs

35063511 IError _ -> scrutL fs p c d e

35073512

35083513 initial = do

@@ -3519,7 +3524,7 @@ manyTill (Parser stepL initialL extractL)

35193524 assertM(cnt + 1 - n >= 0)

35203525 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)

35213526 Done n _ -> do

3522− b <- fextract fs

3527+ b <- ffinal fs

35233528 return $ Done n b

35243529 Error _ -> do

35253530 resL <- initialL

@@ -3558,12 +3563,12 @@ manyTill (Parser stepL initialL extractL)

35583563 Done n b -> do

35593564 r <- fstep fs b

35603565 case r of

3561− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3566+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

35623567 FL.Done c -> return (Done n c)

35633568 Error err -> return $ Error err

35643569 Continue n s -> return $ Continue n (ManyTillL fs s)

35653570 Partial _ _ -> error "Partial in extract"

3566− extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs

3571+ extract (ManyTillR _ fs _) = fmap (Done 0) $ ffinal fs

35673572

35683573-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and

35693574-- collects the output in the supplied fold. If the the parser @collect@ fails,

core/src/Streamly/Internal/Data/Parser/Type.hs+17−17

@@ -927,7 +927,7 @@ data Fused3 a b c = Fused3 !a !b !c

927927--

928928{-# INLINE splitMany #-}

929929splitMany :: Monad m => Parser a m b -> Fold m b c -> Parser a m c

930−splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

930+splitMany (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =

931931 Parser step initial extract

932932

933933 where

@@ -943,7 +943,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

943943 IPartial ps -> return $ partial $ Fused3 ps 0 fs

944944 IDone pb ->

945945 runCollectorWith (handleCollect partial done) fs pb

946− IError _ -> done <$> fextract fs

946+ IError _ -> done <$> ffinal fs

947947 FL.Done fb -> return $ done fb

948948

949949 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -967,19 +967,19 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

967967 assertM(cnt1 - n >= 0)

968968 fstep fs b >>= handleCollect (Partial n) (Done n)

969969 Error _ -> do

970− xs <- fextract fs

970+ xs <- ffinal fs

971971 return $ Done cnt xs

972972

973− extract (Fused3 _ 0 fs) = fmap (Done 0) (fextract fs)

973+ extract (Fused3 _ 0 fs) = fmap (Done 0) (ffinal fs)

974974 extract (Fused3 s cnt fs) = do

975975 r <- extract1 s

976976 case r of

977− Error _ -> fmap (Done cnt) (fextract fs)

977+ Error _ -> fmap (Done cnt) (ffinal fs)

978978 Done n b -> do

979979 assertM(n <= cnt)

980980 fs1 <- fstep fs b

981981 case fs1 of

982− FL.Partial s1 -> fmap (Done n) (fextract s1)

982+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

983983 FL.Done b1 -> return (Done n b1)

984984 Partial _ _ -> error "splitMany: Partial in extract"

985985 Continue n s1 -> do

@@ -993,7 +993,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

993993--

994994{-# INLINE splitManyPost #-}

995995splitManyPost :: Monad m => Parser a m b -> Fold m b c -> Parser a m c

996−splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

996+splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =

997997 Parser step initial extract

998998

999999 where

@@ -1009,7 +1009,7 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10091009 IPartial ps -> return $ partial $ Fused3 ps 0 fs

10101010 IDone pb ->

10111011 runCollectorWith (handleCollect partial done) fs pb

1012− IError _ -> done <$> fextract fs

1012+ IError _ -> done <$> ffinal fs

10131013 FL.Done fb -> return $ done fb

10141014

10151015 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -1031,18 +1031,18 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10311031 assertM(cnt1 - n >= 0)

10321032 fstep fs b >>= handleCollect (Partial n) (Done n)

10331033 Error _ -> do

1034− xs <- fextract fs

1034+ xs <- ffinal fs

10351035 return $ Done cnt1 xs

10361036

10371037 extract (Fused3 s cnt fs) = do

10381038 r <- extract1 s

10391039 case r of

1040− Error _ -> fmap (Done cnt) (fextract fs)

1040+ Error _ -> fmap (Done cnt) (ffinal fs)

10411041 Done n b -> do

10421042 assertM(n <= cnt)

10431043 fs1 <- fstep fs b

10441044 case fs1 of

1045− FL.Partial s1 -> fmap (Done n) (fextract s1)

1045+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

10461046 FL.Done b1 -> return (Done n b1)

10471047 Partial _ _ -> error "splitMany: Partial in extract"

10481048 Continue n s1 -> do

@@ -1055,7 +1055,7 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10551055--

10561056{-# INLINE splitSome #-}

10571057splitSome :: Monad m => Parser a m b -> Fold m b c -> Parser a m c

1058−splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1058+splitSome (Parser step1 initial1 extract1) (Fold fstep finitial _ ffinal) =

10591059 Parser step initial extract

10601060

10611061 where

@@ -1071,7 +1071,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

10711071 IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs

10721072 IDone pb ->

10731073 runCollectorWith (handleCollect partial done) fs pb

1074− IError _ -> done <$> fextract fs

1074+ IError _ -> done <$> ffinal fs

10751075 FL.Done fb -> return $ done fb

10761076

10771077 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -1121,7 +1121,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11211121 Done n b -> do

11221122 assertM(cnt1 - n >= 0)

11231123 fstep fs b >>= handleCollect (Partial n) (Done n)

1124− Error _ -> Done cnt1 <$> fextract fs

1124+ Error _ -> Done cnt1 <$> ffinal fs

11251125

11261126 extract (Fused3 s cnt (Left fs)) = do

11271127 r <- extract1 s

@@ -1131,7 +1131,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

11311131 assertM(n <= cnt)

11321132 fs1 <- fstep fs b

11331133 case fs1 of

1134− FL.Partial s1 -> fmap (Done n) (fextract s1)

1134+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

11351135 FL.Done b1 -> return (Done n b1)

11361136 Partial _ _ -> error "splitSome: Partial in extract"

11371137 Continue n s1 -> do

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

11401140 extract (Fused3 s cnt (Right fs)) = do

11411141 r <- extract1 s

11421142 case r of

1143− Error _ -> fmap (Done cnt) (fextract fs)

1143+ Error _ -> fmap (Done cnt) (ffinal fs)

11441144 Done n b -> do

11451145 assertM(n <= cnt)

11461146 fs1 <- fstep fs b

11471147 case fs1 of

1148− FL.Partial s1 -> fmap (Done n) (fextract s1)

1148+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

11491149 FL.Done b1 -> return (Done n b1)

11501150 Partial _ _ -> error "splitSome: Partial in extract"

11511151 Continue n s1 -> do

core/src/Streamly/Internal/Data/Ring.hs+4−1

@@ -558,7 +558,8 @@ data Tuple4' a b c d = Tuple4' !a !b !c !d deriving Show

558558{-# INLINE slidingWindowWith #-}

559559slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)

560560 => Int -> Fold m ((a, Maybe a), m (MutArray a)) b -> Fold m a b

561−slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract

561+slidingWindowWith n (Fold step1 initial1 extract1 final1) =

562+ Fold step initial extract final

562563

563564 where

564565

@@ -601,6 +602,8 @@ slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract

601602

602603 extract (Tuple4' _ _ _ st) = extract1 st

603604

605+ final (Tuple4' _ _ _ st) = final1 st

606+

604607-- | @slidingWindow collector@ is an incremental sliding window

605608-- fold that does not require all the intermediate elements in a computation.

606609-- This maintains @n@ elements in the window, when a new element comes it slides

core/src/Streamly/Internal/Data/Ring/Generic.hs+1−1

@@ -69,7 +69,7 @@ createRing count = liftIO $ do

6969-- the Ring.

7070{-# INLINE writeLastN #-}

7171writeLastN :: MonadIO m => Int -> Fold m a (Ring a)

72−writeLastN n = Fold step initial extract

72+writeLastN n = Fold step initial extract extract

7373

7474 where

7575

core/src/Streamly/Internal/Data/Stream/Chunked.hs+4−4

@@ -327,7 +327,7 @@ splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice

327327{-# INLINE_NORMAL foldBreakD #-}

328328foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>

329329 Fold m a b -> D.Stream m (Array a) -> m (b, D.Stream m (Array a))

330−foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do

330+foldBreakD (FL.Fold fstep initial _ final) stream@(D.Stream step state) = do

331331 res <- initial

332332 case res of

333333 FL.Partial fs -> go SPEC state fs

@@ -344,7 +344,7 @@ foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do

344344 in goArray SPEC s fp start fs

345345 D.Skip s -> go SPEC s fs

346346 D.Stop -> do

347− b <- extract fs

347+ b <- final fs

348348 return (b, D.nil)

349349

350350 goArray !_ s (Tuple' end _) !cur !fs

@@ -363,7 +363,7 @@ foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do

363363{-# INLINE_NORMAL foldBreakK #-}

364364foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>

365365 Fold m a b -> K.StreamK m (Array a) -> m (b, K.StreamK m (Array a))

366−foldBreakK (FL.Fold fstep initial extract) stream = do

366+foldBreakK (FL.Fold fstep initial _ final) stream = do

367367 res <- initial

368368 case res of

369369 FL.Partial fs -> go fs stream

@@ -373,7 +373,7 @@ foldBreakK (FL.Fold fstep initial extract) stream = do

373373

374374 {-# INLINE go #-}

375375 go !fs st = do

376− let stop = (, K.nil) <$> extract fs

376+ let stop = (, K.nil) <$> final fs

377377 single a = yieldk a K.nil

378378 yieldk (Array contents start end) r =

379379 let fp = Tuple' end contents

core/src/Streamly/Internal/Data/Stream/MutChunked.hs+20−12

@@ -131,8 +131,8 @@ packArraysChunksOf n (D.Stream step state) =

131131{-# INLINE_NORMAL lpackArraysChunksOf #-}

132132lpackArraysChunksOf :: (MonadIO m, Unbox a)

133133 => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()

134−lpackArraysChunksOf n (Fold step1 initial1 extract1) =

135− Fold step initial extract

134+lpackArraysChunksOf n (Fold step1 initial1 _ final1) =

135+ Fold step initial extract final

136136

137137 where

138138

@@ -145,13 +145,6 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

145145 r <- initial1

146146 return $ first (Tuple' Nothing) r

147147

148− extract (Tuple' Nothing r1) = extract1 r1

149− extract (Tuple' (Just buf) r1) = do

150− r <- step1 r1 buf

151− case r of

152− FL.Partial rr -> extract1 rr

153− FL.Done _ -> return ()

154−

155148 step (Tuple' Nothing r1) arr =

156149 let len = MArray.byteLength arr

157150 in if len >= n

@@ -160,7 +153,7 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

160153 case r of

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

162155 FL.Partial s -> do

163− extract1 s

156+ _ <- final1 s

164157 res <- initial1

165158 return $ first (Tuple' Nothing) res

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

@@ -179,11 +172,26 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

179172 case r of

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

181174 FL.Partial s -> do

182− extract1 s

175+ _ <- final1 s

183176 res <- initial1

184177 return $ first (Tuple' Nothing) res

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

186179

180+ -- XXX Several folds do extract >=> final, therefore, we need to make final

181+ -- return "m b" rather than using extract post it if we want extract to be

182+ -- partial.

183+ --

184+ -- extract forces the pending buffer to be sent to the fold which is not

185+ -- what we want.

186+ extract _ = error "lpackArraysChunksOf: not designed for scanning"

187+

188+ final (Tuple' Nothing r1) = final1 r1

189+ final (Tuple' (Just buf) r1) = do

190+ r <- step1 r1 buf

191+ case r of

192+ FL.Partial rr -> final1 rr

193+ FL.Done _ -> return ()

194+

187195-- XXX Same as compactLE, to be removed once that is implemented.

188196--

189197-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a

@@ -256,7 +264,7 @@ compactLEParserD n = ParserD.Parser step initial extract

256264compactGEFold ::

257265 forall m a. (MonadIO m, Unbox a)

258266 => Int -> FL.Fold m (MutArray a) (MutArray a)

259−compactGEFold n = Fold step initial extract

267+compactGEFold n = Fold step initial extract extract

260268

261269 where

262270

core/src/Streamly/Internal/Data/Stream/Nesting.hs+68−57

@@ -1242,6 +1242,7 @@ foldSequence _f _m = undefined

12421242data FIterState s f m a b

12431243 = FIterInit s f

12441244 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)

1245+ (fs -> m b)

12451246 | FIterYield b (FIterState s f m a b)

12461247 | FIterStop

12471248

@@ -1269,26 +1270,26 @@ foldIterateM func seed0 (Stream step state) =

12691270 where

12701271

12711272 {-# INLINE iterStep #-}

1272− iterStep from st fstep extract = do

1273+ iterStep from st fstep extract final = do

12731274 res <- from

12741275 return

12751276 $ Skip

12761277 $ case res of

1277− FL.Partial fs -> FIterStream st fstep fs extract

1278+ FL.Partial fs -> FIterStream st fstep fs extract final

12781279 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)

12791280

12801281 {-# INLINE_LATE stepOuter #-}

12811282 stepOuter _ (FIterInit st seed) = do

1282− (FL.Fold fstep initial extract) <- seed >>= func

1283− iterStep initial st fstep extract

1284− stepOuter gst (FIterStream st fstep fs extract) = do

1283+ (FL.Fold fstep initial extract final) <- seed >>= func

1284+ iterStep initial st fstep extract final

1285+ stepOuter gst (FIterStream st fstep fs extract final) = do

12851286 r <- step (adaptState gst) st

12861287 case r of

12871288 Yield x s -> do

1288− iterStep (fstep fs x) s fstep extract

1289− Skip s -> return $ Skip $ FIterStream s fstep fs extract

1289+ iterStep (fstep fs x) s fstep extract final

1290+ Skip s -> return $ Skip $ FIterStream s fstep fs extract final

12901291 Stop -> do

1291− b <- extract fs

1292+ b <- final fs

12921293 return $ Skip $ FIterYield b FIterStop

12931294 stepOuter _ (FIterYield a next) = return $ Yield a next

12941295 stepOuter _ FIterStop = return Stop

@@ -1338,7 +1339,7 @@ refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =

13381339-- "n" elements at the end are dropped by the fold.

13391340{-# INLINE sliceBy #-}

13401341sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)

1341−sliceBy (Fold step1 initial1 extract1) n = Refold step inject extract

1342+sliceBy (Fold step1 initial1 extract1 _final) n = Refold step inject extract

13421343

13431344 where

13441345

@@ -1916,7 +1917,7 @@ groupsWhile :: Monad m

19161917{-

19171918groupsWhile eq fld = parseMany (PRD.groupBy eq fld)

19181919-}

1919−groupsWhile cmp (Fold fstep initial done) (Stream step state) =

1920+groupsWhile cmp (Fold fstep initial _ final) (Stream step state) =

19201921 Stream stepOuter (GroupingInit state)

19211922

19221923 where

@@ -1939,7 +1940,7 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

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

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

19411942 Skip s -> return $ Skip $ GroupingDo s fs

1942− Stop -> return Stop

1943+ Stop -> final fs >> return Stop

19431944

19441945 where

19451946

@@ -1954,10 +1955,12 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

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

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

19561957 else do

1957− r <- done acc

1958+ r <- final acc

19581959 return $ Yield r (GroupingInitWith s x)

19591960 Skip s -> go SPEC prev s acc

1960− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1961+ Stop -> do

1962+ r <- final acc

1963+ return $ Yield r GroupingDone

19611964 stepOuter _ (GroupingInitWith st x) = do

19621965 res <- initial

19631966 return

@@ -1984,10 +1987,12 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

19841987 FL.Partial fs1 -> go SPEC s fs1

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

19861989 else do

1987− r <- done acc

1990+ r <- final acc

19881991 return $ Yield r (GroupingInitWith s x)

19891992 Skip s -> go SPEC s acc

1990− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1993+ Stop -> do

1994+ r <- final acc

1995+ return $ Yield r GroupingDone

19911996 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"

19921997 stepOuter _ GroupingDone = return Stop

19931998

@@ -2009,7 +2014,7 @@ groupsRollingBy :: Monad m

20092014{-

20102015groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)

20112016-}

2012−groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2017+groupsRollingBy cmp (Fold fstep initial _ final) (Stream step state) =

20132018 Stream stepOuter (GroupingInit state)

20142019

20152020 where

@@ -2032,7 +2037,7 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

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

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

20342039 Skip s -> return $ Skip $ GroupingDo s fs

2035− Stop -> return Stop

2040+ Stop -> final fs >> return Stop

20362041

20372042 where

20382043

@@ -2047,10 +2052,12 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

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

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

20492054 else do

2050− r <- done acc

2055+ r <- final acc

20512056 return $ Yield r (GroupingInitWith s x)

20522057 Skip s -> go SPEC prev s acc

2053− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

2058+ Stop -> do

2059+ r <- final acc

2060+ return $ Yield r GroupingDone

20542061 stepOuter _ (GroupingInitWith st x) = do

20552062 res <- initial

20562063 return

@@ -2081,7 +2088,7 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

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

20822089 else do

20832090 {-

2084− r <- done acc

2091+ r <- final acc

20852092 return $ Yield r (GroupingInitWith s x)

20862093 -}

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

@@ -2090,14 +2097,16 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

20902097 -- GroupingInitWith state here to help GHC with stream

20912098 -- fusion.

20922099 result <- initial

2093− r <- done acc

2100+ r <- final acc

20942101 return

20952102 $ Yield r

20962103 $ case result of

20972104 FL.Partial fsi -> GroupingDoWith s fsi x

20982105 FL.Done b -> GroupingYield b (GroupingInit s)

20992106 Skip s -> go SPEC prev s acc

2100− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

2107+ Stop -> do

2108+ r <- final acc

2109+ return $ Yield r GroupingDone

21012110 stepOuter _ (GroupingYield r next) = return $ Yield r next

21022111 stepOuter _ GroupingDone = return Stop

21032112

@@ -2119,7 +2128,7 @@ data WordsByState st fs b

21192128

21202129{-# INLINE_NORMAL wordsBy #-}

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

2122−wordsBy predicate (Fold fstep initial done) (Stream step state) =

2131+wordsBy predicate (Fold fstep initial _ final) (Stream step state) =

21232132 Stream stepOuter (WordsByInit state)

21242133

21252134 where

@@ -2149,7 +2158,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

21492158 FL.Partial fs1 -> go SPEC s fs1

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

21512160 Skip s -> return $ Skip $ WordsByDo s fs

2152− Stop -> return Stop

2161+ Stop -> final fs >> return Stop

21532162

21542163 where

21552164

@@ -2160,7 +2169,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

21602169 if predicate x

21612170 then do

21622171 {-

2163− r <- done acc

2172+ r <- final acc

21642173 return $ Yield r (WordsByInit s)

21652174 -}

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

@@ -2169,7 +2178,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

21692178 -- state always, we directly go to WordsByDo state in

21702179 -- the common case of Partial.

21712180 resi <- initial

2172− r <- done acc

2181+ r <- final acc

21732182 return

21742183 $ Yield r

21752184 $ case resi of

@@ -2181,7 +2190,9 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

21812190 FL.Partial fs1 -> go SPEC s fs1

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

21832192 Skip s -> go SPEC s acc

2184− Stop -> done acc >>= \r -> return $ Yield r WordsByDone

2193+ Stop -> do

2194+ r <- final acc

2195+ return $ Yield r WordsByDone

21852196

21862197 stepOuter _ WordsByDone = return Stop

21872198

@@ -2239,7 +2250,7 @@ splitOnSeq

22392250 -> Fold m a b

22402251 -> Stream m a

22412252 -> Stream m b

2242−splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2253+splitOnSeq patArr (Fold fstep initial _ final) (Stream step state) =

22432254 Stream stepOuter SplitOnSeqInit

22442255

22452256 where

@@ -2322,12 +2333,12 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

23222333 r <- fstep acc x

23232334 b1 <-

23242335 case r of

2325− FL.Partial acc1 -> done acc1

2336+ FL.Partial acc1 -> final acc1

23262337 FL.Done b -> return b

23272338 let jump c = SplitOnSeqEmpty c s

23282339 in yieldProceed jump b1

23292340 Skip s -> skip (SplitOnSeqEmpty acc s)

2330− Stop -> return Stop

2341+ Stop -> final acc >> return Stop

23312342

23322343 -----------------

23332344 -- Done

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

23452356 Yield x s -> do

23462357 let jump c = SplitOnSeqSingle c s pat

23472358 if pat == x

2348− then done fs >>= yieldProceed jump

2359+ then final fs >>= yieldProceed jump

23492360 else do

23502361 r <- fstep fs x

23512362 case r of

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

23532364 FL.Done b -> yieldProceed jump b

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

23552366 Stop -> do

2356− r <- done fs

2367+ r <- final fs

23572368 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

23582369

23592370 ---------------------------

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

23612372 ---------------------------

23622373

23632374 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

2364− r <- done fs

2375+ r <- final fs

23652376 skip $ SplitOnSeqYield r SplitOnSeqDone

23662377 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

23672378 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

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

23882399 if wrd1 .&. wordMask == wordPat

23892400 then do

23902401 let jump c = SplitOnSeqWordInit c s

2391− done fs >>= yieldProceed jump

2402+ final fs >>= yieldProceed jump

23922403 else skip $ SplitOnSeqWordLoop wrd1 s fs

23932404 else go SPEC (idx + 1) wrd1 s

23942405 Skip s -> go SPEC idx wrd s

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

23962407 if idx /= 0

23972408 then skip $ SplitOnSeqWordDone idx fs wrd

23982409 else do

2399− r <- done fs

2410+ r <- final fs

24002411 skip $ SplitOnSeqYield r SplitOnSeqDone

24012412

24022413 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

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

24172428 case r of

24182429 FL.Partial fs1 -> do

24192430 if wrd1 .&. wordMask == wordPat

2420− then done fs1 >>= yieldProceed jump

2431+ then final fs1 >>= yieldProceed jump

24212432 else go SPEC wrd1 s fs1

24222433 FL.Done b -> yieldProceed jump b

24232434 Skip s -> go SPEC wrd s fs

@@ -2502,14 +2513,14 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

25022513 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

25032514 if RB.unsafeEqArray rb rh patArr

25042515 then do

2505− r <- done fs

2516+ r <- final fs

25062517 let rst = RB.startOf rb

25072518 jump c = SplitOnSeqKRInit 0 c st rb rst

25082519 yieldProceed jump r

25092520 else skip $ SplitOnSeqKRLoop fs st rb rh patHash

25102521

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

2512− r <- done fs

2523+ r <- final fs

25132524 skip $ SplitOnSeqYield r SplitOnSeqDone

25142525 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

25152526 old <- liftIO $ peek rh

@@ -2553,7 +2564,7 @@ splitOnSuffixSeq

25532564 -> Fold m a b

25542565 -> Stream m a

25552566 -> Stream m b

2556−splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2567+splitOnSuffixSeq withSep patArr (Fold fstep initial _ final) (Stream step state) =

25572568 Stream stepOuter SplitOnSuffixSeqInit

25582569

25592570 where

@@ -2593,7 +2604,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

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

25942605 b1 <-

25952606 case r of

2596− FL.Partial fs1 -> done fs1

2607+ FL.Partial fs1 -> final fs1

25972608 FL.Done b -> return b

25982609 yieldProceed jump b1

25992610 else do

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

26562667 r <- fstep acc x

26572668 b1 <-

26582669 case r of

2659− FL.Partial fs -> done fs

2670+ FL.Partial fs -> final fs

26602671 FL.Done b -> return b

26612672 yieldProceed jump b1

26622673 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)

2663− Stop -> return Stop

2674+ Stop -> final acc >> return Stop

26642675

26652676 -----------------

26662677 -- Done

@@ -2677,7 +2688,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

26772688 case res of

26782689 Yield x s -> processYieldSingle pat x s fs

26792690 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat

2680− Stop -> return Stop

2691+ Stop -> final fs >> return Stop

26812692

26822693 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

26832694 res <- step (adaptState gst) st

@@ -2685,7 +2696,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

26852696 Yield x s -> processYieldSingle pat x s fs

26862697 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat

26872698 Stop -> do

2688− r <- done fs

2699+ r <- final fs

26892700 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

26902701

26912702 ---------------------------

@@ -2693,7 +2704,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

26932704 ---------------------------

26942705

26952706 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do

2696− r <- done fs

2707+ r <- final fs

26972708 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

26982709 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do

26992710 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

@@ -2716,7 +2727,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

27162727 let jump c = SplitOnSuffixSeqWordInit c s

27172728 yieldProceed jump b

27182729 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)

2719− Stop -> return Stop

2730+ Stop -> final fs0 >> return Stop

27202731

27212732 where

27222733

@@ -2734,7 +2745,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

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

27352746 else if wrd1 .&. wordMask /= wordPat

27362747 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

2737− else do done fs >>= yieldProceed jump

2748+ else do final fs >>= yieldProceed jump

27382749 FL.Done b -> yieldProceed jump b

27392750 Skip s -> go SPEC idx wrd s fs

27402751 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

@@ -2760,16 +2771,16 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

27602771 case r of

27612772 FL.Partial fs1 ->

27622773 if wrd1 .&. wordMask == wordPat

2763− then done fs1 >>= yieldProceed jump

2774+ then final fs1 >>= yieldProceed jump

27642775 else go SPEC wrd1 s fs1

27652776 FL.Done b -> yieldProceed jump b

27662777 Skip s -> go SPEC wrd s fs

27672778 Stop ->

27682779 if wrd .&. wordMask == wordPat

2769− then return Stop

2780+ then final fs >> return Stop

27702781 else if withSep

27712782 then do

2772− r <- done fs

2783+ r <- final fs

27732784 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

27742785 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd

27752786

@@ -2791,7 +2802,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

27912802 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

27922803 yieldProceed jump b

27932804 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0

2794− Stop -> return Stop

2805+ Stop -> final fs >> return Stop

27952806

27962807 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

27972808 go SPEC 1 rh0 st0 fs0

@@ -2823,10 +2834,10 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

28232834 Stop -> do

28242835 -- do not issue a blank segment when we end at pattern

28252836 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2826− then return Stop

2837+ then final fs >> return Stop

28272838 else if withSep

28282839 then do

2829− r <- done fs

2840+ r <- final fs

28302841 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

28312842 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)

28322843

@@ -2855,24 +2866,24 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

28552866 Skip s -> go SPEC fs s rh cksum

28562867 Stop ->

28572868 if RB.unsafeEqArray rb rh patArr

2858− then return Stop

2869+ then final fs >> return Stop

28592870 else if withSep

28602871 then do

2861− r <- done fs

2872+ r <- final fs

28622873 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

28632874 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh

28642875

28652876 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do

28662877 if RB.unsafeEqArray rb rh patArr

28672878 then do

2868− r <- done fs

2879+ r <- final fs

28692880 let rst = RB.startOf rb

28702881 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst

28712882 yieldProceed jump r

28722883 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

28732884

28742885 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

2875− r <- done fs

2886+ r <- final fs

28762887 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

28772888 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do

28782889 old <- liftIO $ peek rh

core/src/Streamly/Internal/Data/Stream/Transform.hs+8−8

@@ -300,7 +300,7 @@ data TapState fs st a

300300--

301301{-# INLINE tap #-}

302302tap :: Monad m => Fold m a b -> Stream m a -> Stream m a

303−tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

303+tap (Fold fstep initial _ final) (Stream step state) = Stream step' TapInit

304304

305305 where

306306

@@ -323,7 +323,7 @@ tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

323323 FL.Done _ -> TapDone s

324324 Skip s -> return $ Skip (Tapping acc s)

325325 Stop -> do

326− void $ extract acc

326+ void $ final acc

327327 return Stop

328328 step' gst (TapDone st) = do

329329 r <- step gst st

@@ -342,7 +342,7 @@ data TapOffState fs s a

342342{-# INLINE_NORMAL tapOffsetEvery #-}

343343tapOffsetEvery :: Monad m

344344 => Int -> Int -> Fold m a b -> Stream m a -> Stream m a

345−tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

345+tapOffsetEvery offset n (Fold fstep initial _ final) (Stream step state) =

346346 Stream step' TapOffInit

347347

348348 where

@@ -372,7 +372,7 @@ tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

372372 return $ Yield x next

373373 Skip s -> return $ Skip (TapOffTapping acc s count)

374374 Stop -> do

375− void $ extract acc

375+ void $ final acc

376376 return Stop

377377 step' gst (TapOffDone st) = do

378378 r <- step gst st

@@ -437,7 +437,7 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone

437437--

438438{-# INLINE_NORMAL postscan #-}

439439postscan :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b

440−postscan (FL.Fold fstep initial extract) (Stream sstep state) =

440+postscan (FL.Fold fstep initial extract final) (Stream sstep state) =

441441 Stream step (ScanInit state)

442442

443443 where

@@ -460,13 +460,13 @@ postscan (FL.Fold fstep initial extract) (Stream sstep state) =

460460 return $ Yield b $ ScanDo s fs1

461461 FL.Done b -> return $ Yield b ScanDone

462462 Skip s -> return $ Skip $ ScanDo s fs

463− Stop -> return Stop

463+ Stop -> final fs >> return Stop

464464 step _ ScanDone = return Stop

465465

466466{-# INLINE scanWith #-}

467467scanWith :: Monad m

468468 => Bool -> Fold m a b -> Stream m a -> Stream m b

469−scanWith restart (Fold fstep initial extract) (Stream sstep state) =

469+scanWith restart (Fold fstep initial extract final) (Stream sstep state) =

470470 Stream step (ScanInit state)

471471

472472 where

@@ -489,7 +489,7 @@ scanWith restart (Fold fstep initial extract) (Stream sstep state) =

489489 case res of

490490 Yield x s -> runStep s (fstep fs x)

491491 Skip s -> return $ Skip $ ScanDo s fs

492− Stop -> return Stop

492+ Stop -> final fs >> return Stop

493493 step _ ScanDone = return Stop

494494

495495-- XXX It may be useful to have a version of scan where we can keep the

core/src/Streamly/Internal/Data/Stream/Type.hs+13−11

@@ -398,7 +398,7 @@ toStreamK (Stream step state) = go state

398398{-# INLINE_NORMAL foldEither #-}

399399foldEither :: Monad m =>

400400 Fold m a b -> Stream m a -> m (Either (Fold m a b) (b, Stream m a))

401−foldEither (Fold fstep begin done) (UnStream step state) = do

401+foldEither (Fold fstep begin done final) (UnStream step state) = do

402402 res <- begin

403403 case res of

404404 FL.Partial fs -> go SPEC fs state

@@ -416,7 +416,9 @@ foldEither (Fold fstep begin done) (UnStream step state) = do

416416 FL.Done b -> return $! Right (b, Stream step s)

417417 FL.Partial fs1 -> go SPEC fs1 s

418418 Skip s -> go SPEC fs s

419− Stop -> return $! Left (Fold fstep (return $ FL.Partial fs) done)

419+ Stop ->

420+ let f = Fold fstep (return $ FL.Partial fs) done final

421+ in return $! Left f

420422

421423-- | Like 'fold' but also returns the remaining stream. The resulting stream

422424-- would be 'Stream.nil' if the stream finished before the fold.

@@ -427,12 +429,12 @@ foldBreak fld strm = do

427429 r <- foldEither fld strm

428430 case r of

429431 Right res -> return res

430− Left (Fold _ initial extract) -> do

432+ Left (Fold _ initial _ final) -> do

431433 res <- initial

432434 case res of

433435 FL.Done _ -> error "foldBreak: unreachable state"

434436 FL.Partial s -> do

435− b <- extract s

437+ b <- final s

436438 return (b, nil)

437439

438440 where

@@ -475,8 +477,8 @@ fold fld strm = do

475477--

476478{-# INLINE_NORMAL foldAddLazy #-}

477479foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b

478−foldAddLazy (Fold fstep finitial fextract) (Stream sstep state) =

479− Fold fstep initial fextract

480+foldAddLazy (Fold fstep finitial fextract ffinal) (Stream sstep state) =

481+ Fold fstep initial fextract ffinal

480482

481483 where

482484

@@ -1796,7 +1798,7 @@ data FoldManyPost s fs b a

17961798--

17971799{-# INLINE_NORMAL foldManyPost #-}

17981800foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b

1799−foldManyPost (Fold fstep initial extract) (Stream step state) =

1801+foldManyPost (Fold fstep initial _ final) (Stream step state) =

18001802 Stream step' (FoldManyPostStart state)

18011803

18021804 where

@@ -1824,7 +1826,7 @@ foldManyPost (Fold fstep initial extract) (Stream step state) =

18241826 Yield x s -> consume x s fs

18251827 Skip s -> return $ Skip (FoldManyPostLoop s fs)

18261828 Stop -> do

1827− b <- extract fs

1829+ b <- final fs

18281830 return $ Skip (FoldManyPostYield b FoldManyPostDone)

18291831 step' _ (FoldManyPostYield b next) = return $ Yield b next

18301832 step' _ FoldManyPostDone = return Stop

@@ -1868,7 +1870,7 @@ data FoldMany s fs b a

18681870--

18691871{-# INLINE_NORMAL foldMany #-}

18701872foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b

1871−foldMany (Fold fstep initial extract) (Stream step state) =

1873+foldMany (Fold fstep initial _ final) (Stream step state) =

18721874 Stream step' (FoldManyStart state)

18731875

18741876 where

@@ -1895,14 +1897,14 @@ foldMany (Fold fstep initial extract) (Stream step state) =

18951897 case r of

18961898 Yield x s -> consume x s fs

18971899 Skip s -> return $ Skip (FoldManyFirst fs s)

1898− Stop -> return Stop

1900+ Stop -> final fs >> return Stop

18991901 step' gst (FoldManyLoop st fs) = do

19001902 r <- step (adaptState gst) st

19011903 case r of

19021904 Yield x s -> consume x s fs

19031905 Skip s -> return $ Skip (FoldManyLoop s fs)

19041906 Stop -> do

1905− b <- extract fs

1907+ b <- final fs

19061908 return $ Skip (FoldManyYield b FoldManyDone)

19071909 step' _ (FoldManyYield b next) = return $ Yield b next

19081910 step' _ FoldManyDone = return Stop

core/src/Streamly/Internal/Data/StreamK.hs+14−11

@@ -336,7 +336,7 @@ foldlMx' step begin done = go begin

336336--

337337{-# INLINABLE fold #-}

338338fold :: Monad m => FL.Fold m a b -> StreamK m a -> m b

339−fold (FL.Fold step begin done) m = do

339+fold (FL.Fold step begin _ final) m = do

340340 res <- begin

341341 case res of

342342 FL.Partial fs -> go fs m

@@ -344,10 +344,10 @@ fold (FL.Fold step begin done) m = do

344344

345345 where

346346 go !acc m1 =

347− let stop = done acc

347+ let stop = final acc

348348 single a = step acc a

349349 >>= \case

350− FL.Partial s -> done s

350+ FL.Partial s -> final s

351351 FL.Done b1 -> return b1

352352 yieldk a r = step acc a

353353 >>= \case

@@ -365,7 +365,7 @@ fold (FL.Fold step begin done) m = do

365365{-# INLINE foldEither #-}

366366foldEither :: Monad m =>

367367 Fold m a b -> StreamK m a -> m (Either (Fold m a b) (b, StreamK m a))

368−foldEither (FL.Fold step begin done) m = do

368+foldEither (FL.Fold step begin done final) m = do

369369 res <- begin

370370 case res of

371371 FL.Partial fs -> go fs m

@@ -374,12 +374,15 @@ foldEither (FL.Fold step begin done) m = do

374374 where

375375

376376 go !acc m1 =

377− let stop = return $ Left (Fold step (return $ FL.Partial acc) done)

377+ let stop =

378+ let f = Fold step (return $ FL.Partial acc) done final

379+ in return $ Left f

378380 single a =

379381 step acc a

380382 >>= \case

381383 FL.Partial s ->

382− return $ Left (Fold step (return $ FL.Partial s) done)

384+ let f = Fold step (return $ FL.Partial s) done final

385+ in return $ Left f

383386 FL.Done b1 -> return $ Right (b1, nil)

384387 yieldk a r =

385388 step acc a

@@ -397,12 +400,12 @@ foldBreak fld strm = do

397400 r <- foldEither fld strm

398401 case r of

399402 Right res -> return res

400− Left (Fold _ initial extract) -> do

403+ Left (Fold _ initial _ final) -> do

401404 res <- initial

402405 case res of

403406 FL.Done _ -> error "foldBreak: unreachable state"

404407 FL.Partial s -> do

405− b <- extract s

408+ b <- final s

406409 return (b, nil)

407410

408411-- XXX Array folds can be implemented using this.

@@ -421,7 +424,7 @@ foldConcat :: Monad m =>

421424 Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)

422425foldConcat

423426 (Producer pstep pinject pextract)

424− (Fold fstep begin done)

427+ (Fold fstep begin _ final)

425428 stream = do

426429

427430 res <- begin

@@ -433,14 +436,14 @@ foldConcat

433436

434437 go !acc m1 = do

435438 let stop = do

436− r <- done acc

439+ r <- final acc

437440 return (r, nil)

438441 single a = do

439442 st <- pinject a

440443 res <- go1 SPEC acc st

441444 case res of

442445 Left fs -> do

443− r <- done fs

446+ r <- final fs

444447 return (r, nil)

445448 Right (b, s) -> do

446449 x <- pextract s

core/src/Streamly/Internal/Data/Unfold.hs+9−9

@@ -205,7 +205,7 @@ swap = lmap Tuple.swap

205205--

206206{-# INLINE_NORMAL fold #-}

207207fold :: Monad m => Fold m b c -> Unfold m a b -> a -> m c

208−fold (Fold fstep initial extract) (Unfold ustep inject) a = do

208+fold (Fold fstep initial _ final) (Unfold ustep inject) a = do

209209 res <- initial

210210 case res of

211211 FL.Partial x -> inject a >>= go SPEC x

@@ -223,7 +223,7 @@ fold (Fold fstep initial extract) (Unfold ustep inject) a = do

223223 FL.Partial fs1 -> go SPEC fs1 s

224224 FL.Done c -> return c

225225 Skip s -> go SPEC fs s

226− Stop -> extract fs

226+ Stop -> final fs

227227

228228-- {-# ANN type FoldMany Fuse #-}

229229data FoldMany s fs b a

@@ -238,7 +238,7 @@ data FoldMany s fs b a

238238-- /Pre-release/

239239{-# INLINE_NORMAL foldMany #-}

240240foldMany :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c

241−foldMany (Fold fstep initial extract) (Unfold ustep inject1) =

241+foldMany (Fold fstep initial _ final) (Unfold ustep inject1) =

242242 Unfold step inject

243243

244244 where

@@ -269,14 +269,14 @@ foldMany (Fold fstep initial extract) (Unfold ustep inject1) =

269269 case r of

270270 Yield x s -> consume x s fs

271271 Skip s -> return $ Skip (FoldManyFirst fs s)

272− Stop -> return Stop

272+ Stop -> final fs >> return Stop

273273 step (FoldManyLoop st fs) = do

274274 r <- ustep st

275275 case r of

276276 Yield x s -> consume x s fs

277277 Skip s -> return $ Skip (FoldManyLoop s fs)

278278 Stop -> do

279− b <- extract fs

279+ b <- final fs

280280 return $ Skip (FoldManyYield b FoldManyDone)

281281 step (FoldManyYield b next) = return $ Yield b next

282282 step FoldManyDone = return Stop

@@ -317,7 +317,7 @@ either (Unfold stepL injectL) (Unfold stepR injectR) = Unfold step inject

317317-- /Pre-release/

318318{-# INLINE_NORMAL postscan #-}

319319postscan :: Monad m => Fold m b c -> Unfold m a b -> Unfold m a c

320−postscan (Fold stepF initial extract) (Unfold stepU injectU) =

320+postscan (Fold stepF initial extract final) (Unfold stepU injectU) =

321321 Unfold step inject

322322

323323 where

@@ -340,7 +340,7 @@ postscan (Fold stepF initial extract) (Unfold stepU injectU) =

340340 v <- extract fs1

341341 return $ Yield v (Just (fs1, s))

342342 Skip s -> return $ Skip (Just (fs, s))

343− Stop -> return Stop

343+ Stop -> final fs >> return Stop

344344

345345 step Nothing = return Stop

346346

@@ -348,7 +348,7 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone

348348

349349{-# INLINE_NORMAL scanWith #-}

350350scanWith :: Monad m => Bool -> Fold m b c -> Unfold m a b -> Unfold m a c

351−scanWith restart (Fold fstep initial extract) (Unfold stepU injectU) =

351+scanWith restart (Fold fstep initial extract final) (Unfold stepU injectU) =

352352 Unfold step inject

353353

354354 where

@@ -373,7 +373,7 @@ scanWith restart (Fold fstep initial extract) (Unfold stepU injectU) =

373373 case res of

374374 Yield x s -> runStep s (fstep fs x)

375375 Skip s -> return $ Skip $ ScanDo s fs

376− Stop -> return Stop

376+ Stop -> final fs >> return Stop

377377 step ScanDone = return Stop

378378

379379-- | Scan the output of an 'Unfold' to change it in a stateful manner.

core/src/Streamly/Internal/FileSystem/File.hs+7−4

@@ -438,7 +438,7 @@ write = toHandleWith A.defaultChunkSize

438438{-# INLINE writeChunks #-}

439439writeChunks :: (MonadIO m, MonadCatch m)

440440 => FilePath -> Fold m (Array a) ()

441−writeChunks path = Fold step initial extract

441+writeChunks path = Fold step initial extract final

442442 where

443443 initial = do

444444 h <- liftIO (openFile path WriteMode)

@@ -448,12 +448,15 @@ writeChunks path = Fold step initial extract

448448 step (fld, h) x = do

449449 r <- FL.snoc fld x `MC.onException` liftIO (hClose h)

450450 return $ FL.Partial (r, h)

451− extract (Fold _ initial1 extract1, h) = do

451+

452+ extract _ = return ()

453+

454+ final (Fold _ initial1 _ final1, h) = do

452455 liftIO $ hClose h

453456 res <- initial1

454457 case res of

455− FL.Partial fs -> extract1 fs

456− FL.Done fb -> return fb

458+ FL.Partial fs -> final1 fs

459+ FL.Done () -> return ()

457460

458461-- | @writeWith chunkSize handle@ writes the input stream to @handle@.

459462-- Bytes in the input stream are collected into a buffer until we have a chunk

core/src/Streamly/Internal/Unicode/Stream.hs+3−2

@@ -111,6 +111,7 @@ import System.IO.Unsafe (unsafePerformIO)

111111import Streamly.Internal.Data.Array.Type (Array(..))

112112import Streamly.Internal.Data.MutArray.Type (MutableByteArray)

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

114+import Streamly.Internal.Data.Parser (Parser)

114115import Streamly.Internal.Data.Stream (Stream)

115116import Streamly.Internal.Data.Stream (Step (..))

116117import Streamly.Internal.Data.SVar.Type (adaptState)

@@ -523,8 +524,8 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract

523524-- workflow requires backtracking 1 element. This can be revisited once "Fold"

524525-- supports backtracking.

525526{-# INLINE writeCharUtf8' #-}

526−writeCharUtf8' :: Monad m => Fold m Word8 Char

527−writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)

527+writeCharUtf8' :: Monad m => Parser Word8 m Char

528+writeCharUtf8' = parseCharUtf8WithD ErrorOnCodingFailure

528529

529530-- XXX The initial idea was to have "parseCharUtf8" and offload the error

530531-- handling to another parser. So, say we had "parseCharUtf8'",

src/Streamly/Internal/Data/Fold/Async.hs+5−2

@@ -63,7 +63,8 @@ import Streamly.Internal.Data.Tuple.Strict (Tuple3'(..))

6363--

6464{-# INLINE takeInterval #-}

6565takeInterval :: MonadAsync m => Double -> Fold m a b -> Fold m a b

66−takeInterval n (Fold step initial done) = Fold step' initial' done'

66+takeInterval n (Fold step initial done final) =

67+ Fold step' initial' done' final'

6768

6869 where

6970

@@ -90,7 +91,7 @@ takeInterval n (Fold step initial done) = Fold step' initial' done'

9091 then do

9192 res <- step s a

9293 case res of

93− Partial sres -> Done <$> done sres

94+ Partial sres -> Done <$> final sres

9495 Done bres -> return $ Done bres

9596 else do

9697 res <- step s a

@@ -100,6 +101,8 @@ takeInterval n (Fold step initial done) = Fold step' initial' done'

100101

101102 done' (Tuple3' s _ _) = done s

102103

104+ final' (Tuple3' s _ _) = final s

105+

103106 timerThread mv = do

104107 liftIO $ threadDelay (round $ n * 1000000)

105108 -- Use IORef + CAS? instead of MVar since its a Bool?

src/Streamly/Internal/Data/Fold/Concurrent/Channel.hs+25−4

@@ -42,12 +42,13 @@ import Streamly.Internal.Data.Stream.Channel.Types

4242

4343-- | Evaluate a fold asynchronously using a concurrent channel. The driver just

4444-- queues the input stream values to the fold channel buffer and returns. The

45−-- fold evaluates the queued values asynchronously.

45+-- fold evaluates the queued values asynchronously. On finalization, 'parEval'

46+-- waits for the asynchronous fold to complete before it returns.

4647--

4748{-# INLINABLE parEval #-}

4849parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b

4950parEval modifier f =

50− Fold step initial extract

51+ Fold step initial extract final

5152

5253 where

5354

@@ -62,13 +63,33 @@ parEval modifier f =

6263 --

6364 -- A polled stream abstraction may be useful, it would consist of normal

6465 -- events and tick events, latter are guaranteed to arrive.

66+ --

67+ -- XXX We can use the config to indicate if the fold is a scanning type or

68+ -- one-shot, or use a separate parEvalScan for scanning. For a scanning

69+ -- type fold the worker would always send the intermediate values back to

70+ -- the driver. An intermediate value can be returned on an input, or the

71+ -- driver can poll even without input, if we have the Skip input support.

72+ -- When the buffer is full we can return "Skip" and then the next step

73+ -- without input can wait for an output to arrive. Similarly, when "final"

74+ -- is called it can return "Skip" to continue or "Done" to indicate

75+ -- termination.

6576 step chan a = do

6677 status <- sendToWorker chan a

6778 return $ case status of

6879 Nothing -> Partial chan

6980 Just b -> Done b

7081

71− extract chan = do

82+ -- XXX We can use a separate type for non-scanning folds that will

83+ -- introduce a lot of complexity. Are there combinators that rely on the

84+ -- "extract" function even in non-scanning use cases?

85+ -- Instead of making such folds partial we can also make them return a

86+ -- Maybe type.

87+ extract _ = error "Concurrent folds do not support scanning"

88+

89+ -- XXX depending on the use case we may want to either wait for the result

90+ -- or cancel the ongoing work. We can use the config to control that?

91+ -- Currently it waits for the work to complete.

92+ final chan = do

7293 liftIO $ void

7394 $ sendWithDoorBell

7495 (outputQueue chan)

@@ -84,7 +105,7 @@ parEval modifier f =

84105 "parEval: waiting to drain"

85106 $ takeMVar (outputDoorBellFromConsumer chan)

86107 -- XXX remove recursion

87− extract chan

108+ final chan

88109 Just b -> do

89110 when (svarInspectMode chan) $ liftIO $ do

90111 t <- getTime Monotonic

src/Streamly/Internal/Data/Fold/SVar.hs+5−5

@@ -33,7 +33,7 @@ import Streamly.Internal.Data.SVar

3333--

3434{-# INLINE write #-}

3535write :: MonadIO m => SVar t m a -> Maybe WorkerInfo -> Fold m a ()

36−write svar winfo = Fold step initial extract

36+write svar winfo = Fold step initial return final

3737

3838 where

3939

@@ -47,14 +47,14 @@ write svar winfo = Fold step initial extract

4747 void $ send svar (ChildYield x)

4848 return $ FL.Partial ()

4949

50− extract () = liftIO $ sendStop svar winfo

50+ final () = liftIO $ sendStop svar winfo

5151

5252-- | Like write, but applies a yield limit.

5353--

5454{-# INLINE writeLimited #-}

5555writeLimited :: MonadIO m

5656 => SVar t m a -> Maybe WorkerInfo -> Fold m a ()

57−writeLimited svar winfo = Fold step initial extract

57+writeLimited svar winfo = Fold step initial (const (return ())) final

5858

5959 where

6060

@@ -74,5 +74,5 @@ writeLimited svar winfo = Fold step initial extract

7474 return $ FL.Done ()

7575 step False _ = return $ FL.Done ()

7676

77− extract True = liftIO $ sendStop svar winfo

78− extract False = return ()

77+ final True = liftIO $ sendStop svar winfo

78+ final False = return ()

src/Streamly/Internal/Data/IsMap/HashMap.hs+1

@@ -34,3 +34,4 @@ instance (Hashable k, Eq k) => IsMap (HashMap.HashMap k) where

3434 mapDelete = HashMap.delete

3535 mapUnion = HashMap.union

3636 mapNull = HashMap.null

37+ mapTraverseWithKey = HashMap.traverseWithKey

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

@@ -1321,10 +1321,10 @@ classifySessionsByGeneric

13211321 -> t m (AbsTime, (Key f, a)) -- ^ timestamp, (session key, session data)

13221322 -> t m (Key f, b) -- ^ session key, fold result

13231323classifySessionsByGeneric _ tick reset ejectPred tmout

1324− (Fold step initial extract) input =

1324+ (Fold step initial extract final) input =

13251325 Expand.unfoldMany

13261326 (Unfold.lmap (toStreamK . sessionOutputStream) Unfold.fromStreamK)

1327− $ scanlMAfter' sstep (return szero) (flush extract)

1327+ $ scanlMAfter' sstep (return szero) (flush final)

13281328 $ interjectSuffix tick (return Nothing)

13291329 $ map Just input

13301330

src/Streamly/Internal/Data/Stream/Time.hs+2−2

@@ -536,9 +536,9 @@ classifySessionsByGeneric

536536 -- data)

537537 -> Stream m (Key f, b) -- ^ session key, fold result

538538classifySessionsByGeneric _ tick reset ejectPred tmout

539− (Fold step initial extract) input =

539+ (Fold step initial extract final) input =

540540 Stream.unfoldMany (Unfold.lmap sessionOutputStream Unfold.fromStream)

541− $ Stream.scanlMAfter' sstep (return szero) (flush extract)

541+ $ Stream.scanlMAfter' sstep (return szero) (flush final)

542542 $ interject (return Nothing) tick

543543 $ fmap Just input

544544

src/Streamly/Internal/Network/Inet/TCP.hs+7−4

@@ -358,7 +358,7 @@ writeChunks

358358 => (Word8, Word8, Word8, Word8)

359359 -> PortNumber

360360 -> Fold m (Array Word8) ()

361−writeChunks addr port = Fold step initial extract

361+writeChunks addr port = Fold step initial extract final

362362 where

363363 initial = do

364364 skt <- liftIO (connect addr port)

@@ -368,12 +368,15 @@ writeChunks addr port = Fold step initial extract

368368 step (Tuple' fld skt) x = do

369369 r <- FL.addOne x fld `MC.onException` liftIO (Net.close skt)

370370 return $ FL.Partial (Tuple' r skt)

371− extract (Tuple' (Fold _ initial1 extract1) skt) = do

371+

372+ extract _ = return ()

373+

374+ final (Tuple' (Fold _ initial1 _ final1) skt) = do

372375 liftIO $ Net.close skt

373376 res <- initial1

374377 case res of

375− FL.Partial fs -> extract1 fs

376− FL.Done fb -> return fb

378+ FL.Partial fs -> final1 fs

379+ FL.Done () -> return ()

377380

378381-- | Like 'write' but provides control over the write buffer. Output will

379382-- be written to the IO device as soon as we collect the specified number of

test/Streamly/Test/Data/Parser.hs+2−2

@@ -719,7 +719,7 @@ many :: Property

719719many =

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

721721 let fldstp conL currL = return $ FL.Partial (conL ++ currL)

722− concatFold = FL.Fold fldstp (return (FL.Partial [])) return

722+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return return

723723 prsr =

724724 flip P.many concatFold

725725 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

@@ -740,7 +740,7 @@ some =

740740 let

741741 ls = 0 : genLs

742742 fldstp conL currL = return $ FL.Partial $ conL ++ currL

743− concatFold = FL.Fold fldstp (return (FL.Partial [])) return

743+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return return

744744 prsr =

745745 flip P.some concatFold

746746 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

test/Streamly/Test/Data/ParserK.hs+2−2

@@ -532,7 +532,7 @@ many =

532532 $ \ls ->

533533 let fldstp conL currL = return $ FL.Partial (conL ++ currL)

534534 concatFold =

535− FL.Fold fldstp (return (FL.Partial [])) return

535+ FL.Fold fldstp (return (FL.Partial [])) return return

536536 prsr =

537537 flip P.many concatFold

538538 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

@@ -552,7 +552,7 @@ some =

552552 forAll (listOf (chooseInt (0, 1)))

553553 $ \ls ->

554554 let fldstp conL currL = return $ FL.Partial $ conL ++ currL

555− concatFold = FL.Fold fldstp (return (FL.Partial [])) return

555+ concatFold = FL.Fold fldstp (return (FL.Partial [])) return return

556556 prsr =

557557 flip P.some concatFold

558558 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList