32390c5 · streamly · git.iko.soy

git.iko.soy/streamly

on master help sign in

Add a finalizer action in Fold type

32390c5Harendra Kumar3 years ago

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

compare with master

unifiedsplit

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

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

349{-# INLINE takeWhileFail #-}

350takeWhileFail :: 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) =

352 Parser step initial extract

353

354 where

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

369 Fold.Done b -> Done 0 b

370 else return $ Error "fail"

371

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

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

373

374{-# INLINE alt2 #-}

375alt2 :: Monad m

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

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

213

214{-# INLINE takeWhileFailD #-}

215takeWhileFailD :: 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) =

217 Parser step initial extract

218

219 where

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

234 Fold.Done b -> Done 0 b

235 else return $ Error "fail"

236

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

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

238

239{-# INLINE takeWhileFail #-}

240takeWhileFail :: CONSTRAINT =>

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

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

11{-# LANGUAGE CPP #-}

12{-# LANGUAGE ScopedTypeVariables #-}

14+#undef FUSION_CHECK

15+#ifdef FUSION_CHECK

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

17+#endif

18+

14#ifdef __HADDOCK_VERSION__

19#ifdef __HADDOCK_VERSION__

15#undef INSPECTION

20#undef INSPECTION

16#endif

21#endif

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

280_copyStreamUtf8'Fold inh outh =

285_copyStreamUtf8'Fold inh outh =

281 Stream.fold (Handle.write outh)

286 Stream.fold (Handle.write outh)

282 $ Unicode.encodeUtf8

287 $ Unicode.encodeUtf8

288+ $ Stream.catRights

283− $ Stream.foldMany Unicode.writeCharUtf8'

289+ $ Stream.parseMany Unicode.writeCharUtf8'

284 $ Stream.unfold Handle.reader inh

290 $ Stream.unfold Handle.reader inh

285

291

286{-# NOINLINE _copyStreamUtf8Parser #-}

292{-# NOINLINE _copyStreamUtf8Parser #-}

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

317

323

318main :: IO ()

324main :: IO ()

319main = do

325main = do

326+#ifndef FUSION_CHECK

320 env <- mkHandleBenchEnv

327 env <- mkHandleBenchEnv

321 defaultMain (allBenchmarks env)

328 defaultMain (allBenchmarks env)

322

329

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

329 , o_1_space_decode_encode_read env

336 , o_1_space_decode_encode_read env

330 ]

337 ]

331 ]

338 ]

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

30 , isSpace

31 , isSp

32 , mkHandleBenchEnv

33+ , Handles(..)

34+ , getHandles

33 )

35 )

34where

36where

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

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

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

259writeLastN n

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

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

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

262

263 where

264

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

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

596--

597{-# INLINE unsafeMakePure #-}

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

599−unsafeMakePure (Fold step initial extract) =

599+unsafeMakePure (Fold step initial extract final) =

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

601 (return $! unsafePerformIO initial)

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

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

603

604

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

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

605--

606--

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)

103{-# INLINE fromFold #-}

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

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

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

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

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

107+ ChunkFold (ParserD.Parser step initial extract)

108

109 where

110

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

134 Fold.Partial fs1 ->

135 goArray SPEC next fs1

136

137+ extract = fmap (Done 0) . ffinal

138+

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

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

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

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

139--

141--

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

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

443-- /Pre-release/

444{-# INLINE transform #-}

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

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

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

447− Fold step initial extract

447+ Fold step initial extract final

448

449 where

450

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

477

478 extract (Tuple' _ fs) = fextract fs

479

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

481+

480{-# INLINE scanWith #-}

482{-# INLINE scanWith #-}

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

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

484+scanWith isMany

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

485+ (Fold stepL initialL extractL finalL)

486+ (Fold stepR initialR extractR finalR) =

483− Fold step initial extract

487+ Fold step initial extract final

484

488

485 where

489 where

486

490

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

494 Partial sR1 ->

498 Partial sR1 ->

495 if isMany

499 if isMany

496 then runStep initialL sR1

500 then runStep initialL sR1

497− else Done <$> extractR sR1

501+ else Done <$> finalR sR1

498 Done bR -> return $ Done bR

502 Done bR -> return $ Done bR

499 Partial sL -> do

503 Partial sL -> do

500 !b <- extractL sL

504 !b <- extractL sL

501 rR <- stepR sR b

505 rR <- stepR sR b

502− return

503− $ case rR of

506+ case rR of

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

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

505− Done bR -> Done bR

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

506

509

507 initial = do

510 initial = do

508 r <- initialR

511 r <- initialR

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

514

517

515 extract = extractR . snd

518 extract = extractR . snd

516

519

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

521+

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

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

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

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

519--

524--

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

565--

570--

566{-# INLINE slide2 #-}

571{-# INLINE slide2 #-}

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

572slide2 :: 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

569

574

570 where

575 where

571

576

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

577

582

578 extract (Tuple' _ s) = extract1 s

583 extract (Tuple' _ s) = extract1 s

579

584

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

586+

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

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

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

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

582-- otherwise returns 'Just'.

589-- otherwise returns 'Just'.

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

932--

939--

933{-# INLINE rollingMapM #-}

940{-# INLINE rollingMapM #-}

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

941rollingMapM :: 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

936

943

937 where

944 where

938

945

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

1173-- /Pre-release/

1180-- /Pre-release/

1174{-# INLINE findM #-}

1181{-# INLINE findM #-}

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

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

1183+findM predicate =

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

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

1177

1185

1178 where

1186 where

1179

1187

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

1184 else Partial ()

1192 else Partial ()

1185 in f <$> predicate a

1193 in f <$> predicate a

1186

1194

1195+ extract = const $ return Nothing

1196+

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

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

1188--

1198--

1189{-# INLINE find #-}

1199{-# INLINE find #-}

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

1426

1436

1427{-# INLINE takingEndByM #-}

1437{-# INLINE takingEndByM #-}

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

1438takingEndByM :: 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

1430

1440

1431 where

1441 where

1432

1442

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

1439 then Done $ Just a

1449 then Done $ Just a

1440 else Partial $ Just' a

1450 else Partial $ Just' a

1441

1451

1452+ extract = return . toMaybe

1453+

1442-- |

1454-- |

1443--

1455--

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

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

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

1449

1461

1450{-# INLINE takingEndByM_ #-}

1462{-# INLINE takingEndByM_ #-}

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

1463takingEndByM_ :: 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

1453

1465

1454 where

1466 where

1455

1467

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

1462 then Done Nothing

1474 then Done Nothing

1463 else Partial $ Just' a

1475 else Partial $ Just' a

1464

1476

1477+ extract = return . toMaybe

1478+

1465-- |

1479-- |

1466--

1480--

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

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

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

1472

1486

1473{-# INLINE droppingWhileM #-}

1487{-# INLINE droppingWhileM #-}

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

1488droppingWhileM :: 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

1476

1490

1477 where

1491 where

1478

1492

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

1487 else Just' a

1501 else Just' a

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

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

1489

1503

1504+ extract = return . toMaybe

1505+

1490-- |

1506-- |

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

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

1492--

1508--

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

1515{-# INLINE takeEndBy_ #-}

1531{-# INLINE takeEndBy_ #-}

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

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

1517-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)

1533-- takeEndBy_ predicate = scanMaybe (takingEndBy_ predicate)

1518−takeEndBy_ predicate (Fold fstep finitial fextract) =

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

1519− Fold step finitial fextract

1535+ Fold step finitial fextract ffinal

1520

1536

1521 where

1537 where

1522

1538

1523 step s a =

1539 step s a =

1524 if not (predicate a)

1540 if not (predicate a)

1525 then fstep s a

1541 then fstep s a

1526− else Done <$> fextract s

1542+ else Done <$> ffinal s

1527

1543

1528-- Note:

1544-- Note:

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

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

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

1544{-# INLINE takeEndBy #-}

1560{-# INLINE takeEndBy #-}

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

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

1546-- takeEndBy predicate = scanMaybe (takingEndBy predicate)

1562-- takeEndBy predicate = scanMaybe (takingEndBy predicate)

1547−takeEndBy predicate (Fold fstep finitial fextract) =

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

1548− Fold step finitial fextract

1564+ Fold step finitial fextract ffinal

1549

1565

1550 where

1566 where

1551

1567

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

1555 then return res

1571 then return res

1556 else do

1572 else do

1557 case res of

1573 case res of

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

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

1559 Done b -> return $ Done b

1575 Done b -> return $ Done b

1560

1576

1561------------------------------------------------------------------------------

1577------------------------------------------------------------------------------

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

1590 Array.Array a

1606 Array.Array a

1591 -> Fold m a b

1607 -> Fold m a b

1592 -> Fold m a b

1608 -> Fold m a b

1593−takeEndBySeq patArr (Fold fstep finitial fextract) =

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

1594− Fold step initial extract

1610+ Fold step initial extract final

1595

1611

1596 where

1612 where

1597

1613

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

1604 | patLen == 0 ->

1620 | patLen == 0 ->

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

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

1606 -- pattern?

1622 -- pattern?

1607− -- Done <$> fextract acc

1623+ -- Done <$> ffinal acc

1608 return $ Partial $ SplitOnSeqEmpty acc

1624 return $ Partial $ SplitOnSeqEmpty acc

1609 | patLen == 1 -> do

1625 | patLen == 1 -> do

1610 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

1626 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

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

1655 case res of

1671 case res of

1656 Partial s1

1672 Partial s1

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

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

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

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

1659 Done b -> return $ Done b

1675 Done b -> return $ Done b

1660 step (SplitOnSeqWord s idx wrd) x = do

1676 step (SplitOnSeqWord s idx wrd) x = do

1661 res <- fstep s x

1677 res <- fstep s x

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

1664 Partial s1

1680 Partial s1

1665 | idx == maxIndex -> do

1681 | idx == maxIndex -> do

1666 if wrd1 .&. wordMask == wordPat

1682 if wrd1 .&. wordMask == wordPat

1667− then Done <$> fextract s1

1683+ then Done <$> ffinal s1

1668 else return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1684 else return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1669 | otherwise ->

1685 | otherwise ->

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

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

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

1675 case res of

1691 case res of

1676 Partial s1

1692 Partial s1

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

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

1678− Done <$> fextract s1

1694+ Done <$> ffinal s1

1679 | otherwise ->

1695 | otherwise ->

1680 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1696 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1681 Done b -> return $ Done b

1697 Done b -> return $ Done b

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

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

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

1690 let !ringHash = fld addCksum 0 rb

1706 let !ringHash = fld addCksum 0 rb

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

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

1692− then Done <$> fextract s1

1708+ then Done <$> ffinal s1

1693 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1709 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1694 else

1710 else

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

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

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

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

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

1703 let ringHash = deltaCksum cksum old x

1719 let ringHash = deltaCksum cksum old x

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

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

1705− then Done <$> fextract s1

1721+ then Done <$> ffinal s1

1706 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1722 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1707 Done b -> return $ Done b

1723 Done b -> return $ Done b

1708

1724

1709− extract state =

1725+ extractFunc fex state =

1710 let st =

1726 let st =

1711 case state of

1727 case state of

1712 SplitOnSeqEmpty s -> s

1728 SplitOnSeqEmpty s -> s

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

1715 SplitOnSeqWordLoop s _ -> s

1731 SplitOnSeqWordLoop s _ -> s

1716 SplitOnSeqKR s _ _ _ -> s

1732 SplitOnSeqKR s _ _ _ -> s

1717 SplitOnSeqKRLoop s _ _ _ -> s

1733 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

1719

1739

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

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

1721--

1741--

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

1726 Array.Array a

1746 Array.Array a

1727 -> Fold m a b

1747 -> Fold m a b

1728 -> Fold m a b

1748 -> Fold m a b

1729−takeEndBySeq_ patArr (Fold fstep finitial fextract) =

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

1730− Fold step initial extract

1750+ Fold step initial extract final

1731

1751

1732 where

1752 where

1733

1753

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

1740 | patLen == 0 ->

1760 | patLen == 0 ->

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

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

1742 -- pattern?

1762 -- pattern?

1743− -- Done <$> fextract acc

1763+ -- Done <$> ffinal acc

1744 return $ Partial $ SplitOnSeqEmpty acc

1764 return $ Partial $ SplitOnSeqEmpty acc

1745 | patLen == 1 -> do

1765 | patLen == 1 -> do

1746 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

1766 pat <- liftIO $ Array.unsafeIndexIO 0 patArr

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

1797 case res of

1817 case res of

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

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

1799 Done b -> return $ Done b

1819 Done b -> return $ Done b

1800− else Done <$> fextract s

1820+ else Done <$> ffinal s

1801 step (SplitOnSeqWord s idx wrd) x = do

1821 step (SplitOnSeqWord s idx wrd) x = do

1802 let wrd1 = addToWord wrd x

1822 let wrd1 = addToWord wrd x

1803 if idx == maxIndex

1823 if idx == maxIndex

1804 then do

1824 then do

1805 if wrd1 .&. wordMask == wordPat

1825 if wrd1 .&. wordMask == wordPat

1806− then Done <$> fextract s

1826+ then Done <$> ffinal s

1807 else return $ Partial $ SplitOnSeqWordLoop s wrd1

1827 else return $ Partial $ SplitOnSeqWordLoop s wrd1

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

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

1809 step (SplitOnSeqWordLoop s wrd) x = do

1829 step (SplitOnSeqWordLoop s wrd) x = do

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

1814 case res of

1834 case res of

1815 Partial s1

1835 Partial s1

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

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

1817− Done <$> fextract s1

1837+ Done <$> ffinal s1

1818 | otherwise ->

1838 | otherwise ->

1819 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1839 return $ Partial $ SplitOnSeqWordLoop s1 wrd1

1820 Done b -> return $ Done b

1840 Done b -> return $ Done b

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

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

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

1826 let !ringHash = fld addCksum 0 rb

1846 let !ringHash = fld addCksum 0 rb

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

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

1828− then Done <$> fextract s

1848+ then Done <$> ffinal s

1829 else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1

1849 else return $ Partial $ SplitOnSeqKRLoop s ringHash rb rh1

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

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

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

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

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

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

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

1837 let ringHash = deltaCksum cksum old x

1857 let ringHash = deltaCksum cksum old x

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

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

1839− then Done <$> fextract s1

1859+ then Done <$> ffinal s1

1840 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1860 else return $ Partial $ SplitOnSeqKRLoop s1 ringHash rb rh1

1841 Done b -> return $ Done b

1861 Done b -> return $ Done b

1842

1862

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

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

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

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

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

1846 -- driver.

1866 -- driver.

1847− extract state = do

1867+ extractFunc fex state = do

1848 let consumeWord s n wrd = do

1868 let consumeWord s n wrd = do

1849 if n == 0

1869 if n == 0

1850− then fextract s

1870+ then fex s

1851 else do

1871 else do

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

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

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

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

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

1857

1877

1858 let consumeRing s n rb rh =

1878 let consumeRing s n rb rh =

1859 if n == 0

1879 if n == 0

1860− then fextract s

1880+ then fex s

1861 else do

1881 else do

1862 old <- liftIO $ peek rh

1882 old <- liftIO $ peek rh

1863 let rh1 = Ring.advance rb rh

1883 let rh1 = Ring.advance rb rh

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

1867 Done b -> return b

1887 Done b -> return b

1868

1888

1869 case state of

1889 case state of

1870− SplitOnSeqEmpty s -> fextract s

1890+ SplitOnSeqEmpty s -> fex s

1871− SplitOnSeqSingle s _ -> fextract s

1891+ SplitOnSeqSingle s _ -> fex s

1872 SplitOnSeqWord s idx wrd -> consumeWord s idx wrd

1892 SplitOnSeqWord s idx wrd -> consumeWord s idx wrd

1873 SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd

1893 SplitOnSeqWordLoop s wrd -> consumeWord s patLen wrd

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

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

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

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

1876

1896

1897+ extract state = extractFunc fextract state

1898+

1899+ final state = extractFunc ffinal state

1900+

1877------------------------------------------------------------------------------

1901------------------------------------------------------------------------------

1878-- Distributing

1902-- Distributing

1879------------------------------------------------------------------------------

1903------------------------------------------------------------------------------

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

2317-- /Pre-release/

2341-- /Pre-release/

2318{-# INLINE unfoldMany #-}

2342{-# INLINE unfoldMany #-}

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

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

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

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

2321− Fold consume initial extract

2345+ Fold consume initial extract final

2322

2346

2323 where

2347 where

2324

2348

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

2345 (a -> a -> Ordering)

2369 (a -> a -> Ordering)

2346 -> Int

2370 -> Int

2347 -> Fold m a (MutArray a)

2371 -> Fold m a (MutArray a)

2348−bottomBy cmp n = Fold step initial extract

2372+bottomBy cmp n = Fold step initial extract extract

2349

2373

2350 where

2374 where

2351

2375

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

2440 quote

2464 quote

2441 esc

2465 esc

2442 separator

2466 separator

2443− (Fold stepL initialL extractL)

2467+ (Fold stepL initialL _ finalL)

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

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

2445

2469

2446 where

2470 where

2447

2471

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

2484 r <- stepL sL a

2508 r <- stepL sL a

2485 case r of

2509 case r of

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

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

2511+ Done _ -> do

2512+ _ <- finalR sR

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

2513+ error "Collecting fold finished inside quote"

2488

2514

2489 step (IntersperseQUnquoted sR sL) a

2515 step (IntersperseQUnquoted sR sL) a

2490 | a == separator = do

2516 | a == separator = do

2491− b <- extractL sL

2517+ b <- finalL sL

2492 collect IntersperseQUnquoted sR b

2518 collect IntersperseQUnquoted sR b

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

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

2494 | otherwise = process a sL sR IntersperseQUnquoted

2520 | otherwise = process a sL sR IntersperseQUnquoted

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

2506 error "intersperseWithQuotes: finished inside quote"

2532 error "intersperseWithQuotes: finished inside quote"

2507 extract (IntersperseQQuotedEsc _ _) =

2533 extract (IntersperseQQuotedEsc _ _) =

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

2534 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) =>

270 (a -> Key f)

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

272 -> 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

274

275

275 where

276 where

276

277

277 initial = return $ Tuple' IsMap.mapEmpty Nothing

278 initial = return $ Tuple' IsMap.mapEmpty Nothing

278

279

279 {-# INLINE runFold #-}

280 {-# INLINE runFold #-}

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

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

281 res <- initial1

282 res <- initial1

282 case res of

283 case res of

283 Partial s -> do

284 Partial s -> do

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

285 return

286 return

286 $ case res1 of

287 $ case res1 of

287 Partial _ ->

288 Partial _ ->

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

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

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

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

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

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

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

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

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

298 runFold kv fld (k, a)

299 runFold kv fld (k, a)

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

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

300

301

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

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

302

303

303 where

304 where

304

305

305− f (Fold _ i e) = do

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

306 r <- i

307 r <- i

307 case r of

308 case r of

308 Partial s -> e s

309 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"

310

321

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

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

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

323-- 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) =>

348 (a -> Key f)

359 (a -> Key f)

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

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

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

361 -> 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

352

364

353 where

365 where

354

366

355 initial = return $ Tuple' IsMap.mapEmpty Nothing

367 initial = return $ Tuple' IsMap.mapEmpty Nothing

356

368

357 {-# INLINE initFold #-}

369 {-# INLINE initFold #-}

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

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

359 res <- initial1

371 res <- initial1

360 case res of

372 case res of

361 Partial s -> do

373 Partial s -> do

362 res1 <- step1 s a

374 res1 <- step1 s a

363 case res1 of

375 case res1 of

364 Partial _ -> do

376 Partial _ -> do

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

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

366 ref <- liftIO $ newIORef fld

378 ref <- liftIO $ newIORef fld

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

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

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

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

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

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

370

382

371 {-# INLINE runFold #-}

383 {-# 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

373 res <- initial1

385 res <- initial1

374 case res of

386 case res of

375 Partial s -> do

387 Partial s -> do

376 res1 <- step1 s a

388 res1 <- step1 s a

377 case res1 of

389 case res1 of

378 Partial _ -> do

390 Partial _ -> do

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

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

380 liftIO $ writeIORef ref fld

392 liftIO $ writeIORef ref fld

381 return $ Tuple' kv Nothing

393 return $ Tuple' kv Nothing

382 Done b ->

394 Done b ->

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

394 f <- liftIO $ readIORef ref

406 f <- liftIO $ readIORef ref

395 runFold kv ref f (k, a)

407 runFold kv ref f (k, a)

396

408

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

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

398

410

399 where

411 where

400

412

401 f ref = do

413 f ref = do

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

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

403 r <- i

415 r <- i

404 case r of

416 case r of

405 Partial s -> e s

417 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"

407

430

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

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

409-- fold accumulators for better performance.

432-- fold accumulators for better performance.

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

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

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

419demuxIO = demuxGenericIO

442demuxIO = demuxGenericIO

420

443

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+

421{-# INLINE demuxToContainer #-}

451{-# INLINE demuxToContainer #-}

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

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

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

453 (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)) =>

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

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

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

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

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

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

508−classifyGeneric f (Fold step1 initial1 extract1) =

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

509− fmap extract $ foldlM' step initial

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

510

540

511 where

541 where

512

542

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

543 let kv1 = IsMap.mapDelete k kv

573 let kv1 = IsMap.mapDelete k kv

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

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

545

575

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

547

586

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

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

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

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

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

568{-# INLINE classifyGenericIO #-}

607{-# INLINE classifyGenericIO #-}

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

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

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

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

571−classifyGenericIO f (Fold step1 initial1 extract1) =

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

572− fmap extract $ foldlM' step initial

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

573

612

574 where

613 where

575

614

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

608 in return

647 in return

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

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

610

649

611− extract (Tuple3' kv _ x) =

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

651+

652+ where

653+

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

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

613

665

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

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

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

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

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

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

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

625classifyIO = classifyGenericIO

677classifyIO = classifyGenericIO

626

678

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−

634{-# INLINE toContainer #-}

679{-# INLINE toContainer #-}

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

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

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

681 (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

40 = Partial !s

41 | Done !b

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

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

44--

45instance Bifunctor Step where

46 {-# INLINE bimap #-}

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

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

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

446import Control.Applicative (liftA2)

447#endif

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

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

449import Data.Bifunctor (Bifunctor(..))

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

451import Data.Functor.Identity (Identity(..))

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

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

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

473

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+

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

496+-- | 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

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

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

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

477--

499--

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

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

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

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

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

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

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

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

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

504-- 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.

484--

510--

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

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

486-- to create folds.

512-- to create folds.

487--

513--

488data Fold m a b =

514data Fold m a b =

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

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

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

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

491

517

492------------------------------------------------------------------------------

518------------------------------------------------------------------------------

493-- Mapping on the output

519-- Mapping on the output

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

497--

523--

498{-# INLINE rmapM #-}

524{-# INLINE rmapM #-}

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

525rmapM :: 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)

501

528

502 where

529 where

503

530

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

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

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

529 (return (Partial initial))

556 (return (Partial initial))

530 return

557 return

558+ return

531

559

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

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

533-- of the accumulator.

561-- of the accumulator.

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

542{-# INLINE foldlM' #-}

570{-# INLINE foldlM' #-}

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

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

544foldlM' step initial =

572foldlM' 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

546

574

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

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

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

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

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

640{-# INLINE foldt' #-}

668{-# INLINE foldt' #-}

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

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

642foldt' step initial extract =

670foldt' step initial extract =

671+ Fold

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

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

673+ (return initial)

674+ (return . extract)

675+ (return . extract)

644

676

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

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

646-- and a state extraction function.

678-- and a state extraction function.

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

653--

685--

654{-# INLINE foldtM' #-}

686{-# INLINE foldtM' #-}

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

687foldtM' :: (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

657

689

658------------------------------------------------------------------------------

690------------------------------------------------------------------------------

659-- Refold

691-- Refold

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

667-- /Internal/

699-- /Internal/

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

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

669fromRefold (Refold step inject extract) c =

701fromRefold (Refold step inject extract) c =

670− Fold step (inject c) extract

702+ Fold step (inject c) extract extract

671

703

672------------------------------------------------------------------------------

704------------------------------------------------------------------------------

673-- Basic Folds

705-- Basic Folds

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

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

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

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

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

729 {-# INLINE fmap #-}

761 {-# 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)

731

764

732 where

765 where

733

766

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

762--

795--

763{-# INLINE fromPure #-}

796{-# INLINE fromPure #-}

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

797fromPure :: 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

766

799

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

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

768-- without consuming any further input.

801-- without consuming any further input.

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

771--

804--

772{-# INLINE fromEffect #-}

805{-# INLINE fromEffect #-}

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

806fromEffect :: 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

775

808

776{-# ANN type SeqFoldState Fuse #-}

809{-# ANN type SeqFoldState Fuse #-}

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

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

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

804{-# INLINE splitWith #-}

837{-# INLINE splitWith #-}

805splitWith :: Monad m =>

838splitWith :: Monad m =>

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

839 (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) =

840+splitWith func

841+ (Fold stepL initialL _ finalL)

842+ (Fold stepR initialR _ finalR) =

808− Fold step initial extract

843+ Fold step initial extract final

809

844

810 where

845 where

811

846

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

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

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

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

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

824

859

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+

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

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

826− extract (SeqFoldL sL) = do

866+ final (SeqFoldL sL) = do

827− rL <- extractL sL

867+ rL <- finalL sL

828 res <- initialR

868 res <- initialR

829 fmap (func rL)

869 fmap (func rL)

830 $ case res of

870 $ case res of

831− Partial sR -> extractR sR

871+ Partial sR -> finalR sR

832 Done rR -> return rR

872 Done rR -> return rR

833

873

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

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

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

848--

888--

849{-# INLINE split_ #-}

889{-# INLINE split_ #-}

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

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

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

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

852− Fold step initial extract

892+ Fold step initial extract final

853

893

854 where

894 where

855

895

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

872 resR <- stepR st a

912 resR <- stepR st a

873 return $ first SeqFoldR_ resR

913 return $ first SeqFoldR_ resR

874

914

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+

875− extract (SeqFoldR_ sR) = extractR sR

919+ final (SeqFoldR_ sR) = finalR sR

876− extract (SeqFoldL_ _) = do

920+ final (SeqFoldL_ sL) = do

921+ _ <- finalL sL

877 res <- initialR

922 res <- initialR

878 case res of

923 case res of

879− Partial sR -> extractR sR

924+ Partial sR -> finalR sR

880 Done rR -> return rR

925 Done rR -> return rR

881

926

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

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

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

924--

969--

925{-# INLINE teeWith #-}

970{-# INLINE teeWith #-}

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

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

972+teeWith f

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

973+ (Fold stepL initialL extractL finalL)

974+ (Fold stepR initialR extractR finalR) =

928− Fold step initial extract

975+ Fold step initial extract final

929

976

930 where

977 where

931

978

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

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

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

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

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

954

1001

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+

955{-# ANN type TeeFstState Fuse #-}

1006{-# ANN type TeeFstState Fuse #-}

956data TeeFstState sL sR b

1007data TeeFstState sL sR b

957 = TeeFstBoth !sL !sR

1008 = TeeFstBoth !sL !sR

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

964{-# INLINE teeWithFst #-}

1015{-# INLINE teeWithFst #-}

965teeWithFst :: Monad m =>

1016teeWithFst :: Monad m =>

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

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

1018+teeWithFst f

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

1019+ (Fold stepL initialL extractL finalL)

1020+ (Fold stepR initialR extractR finalR) =

968− Fold step initial extract

1021+ Fold step initial extract final

969

1022

970 where

1023 where

971

1024

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

984 Done bl -> do

1037 Done bl -> do

985 Done . f bl <$>

1038 Done . f bl <$>

986 case resR of

1039 case resR of

987− Partial sr -> extractR sr

1040+ Partial sr -> finalR sr

988 Done br -> return br

1041 Done br -> return br

989

1042

990 initial = runBoth initialL initialR

1043 initial = runBoth initialL initialR

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

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

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

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

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

997

1050

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

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

1053+

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

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

999-- terminates.

1055-- terminates.

1000--

1056--

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

1003{-# INLINE teeWithMin #-}

1059{-# INLINE teeWithMin #-}

1004teeWithMin :: Monad m =>

1060teeWithMin :: Monad m =>

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

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

1062+teeWithMin f

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

1063+ (Fold stepL initialL extractL finalL)

1064+ (Fold stepR initialR extractR finalR) =

1007− Fold step initial extract

1065+ Fold step initial extract final

1008

1066

1009 where

1067 where

1010

1068

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

1016 Partial sl -> do

1074 Partial sl -> do

1017 case resR of

1075 case resR of

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

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

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

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

1020

1078

1021 Done bl -> do

1079 Done bl -> do

1022 Done . f bl <$>

1080 Done . f bl <$>

1023 case resR of

1081 case resR of

1024− Partial sr -> extractR sr

1082+ Partial sr -> finalR sr

1025 Done br -> return br

1083 Done br -> return br

1026

1084

1027 initial = runBoth initialL initialR

1085 initial = runBoth initialL initialR

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

1030

1088

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

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

1032

1090

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

1092+

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

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

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

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

1035-- fold.

1095-- fold.

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

1041--

1101--

1042{-# INLINE shortest #-}

1102{-# INLINE shortest #-}

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

1103shortest :: 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 _) =

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

1045− Fold step initial extract

1105+ Fold step initial extract final

1046

1106

1047 where

1107 where

1048

1108

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

1050 runBoth actionL actionR = do

1110 runBoth actionL actionR = do

1051 resL <- actionL

1111 resL <- actionL

1052 resR <- actionR

1112 resR <- actionR

1053− return $

1054− case resL of

1113+ case resL of

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

1114+ Partial sL ->

1115+ case resR of

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

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

1056− Done bL -> Done $ Left bL

1118+ Done bL -> do

1119+ case resR of

1120+ Partial sR -> void (finalR sR)

1121+ Done _ -> return ()

1122+ return (Done (Left bL))

1057

1123

1058 initial = runBoth initialL initialR

1124 initial = runBoth initialL initialR

1059

1125

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

1061

1127

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

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

1063

1129

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

1131+

1064{-# ANN type LongestState Fuse #-}

1132{-# ANN type LongestState Fuse #-}

1065data LongestState sL sR

1133data LongestState sL sR

1066 = LongestBoth !sL !sR

1134 = LongestBoth !sL !sR

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

1078--

1146--

1079{-# INLINE longest #-}

1147{-# INLINE longest #-}

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

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

1149+longest

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

1150+ (Fold stepL initialL _ finalL)

1151+ (Fold stepR initialR _ finalR) =

1082− Fold step initial extract

1152+ Fold step initial extract final

1083

1153

1084 where

1154 where

1085

1155

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

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

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

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

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

1104

1174

1105− left sL = Left <$> extractL 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+

1106− extract (LongestLeft sL) = left sL

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

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

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

1108− extract (LongestBoth sL _) = left sL

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

1109

1183

1110−data ConcatMapState m sa a c

1184+data ConcatMapState m sa a b c

1111− = B !sa

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

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

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

1113

1187

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

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

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

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

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

1132--

1206--

1133{-# INLINE concatMap #-}

1207{-# INLINE concatMap #-}

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

1208concatMap :: 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

1136 where

1211 where

1137 initialc = do

1212 initialc = do

1138 r <- initiala

1213 r <- initiala

1139 case r of

1214 case r of

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

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

1141 Done b -> initInnerFold (f b)

1216 Done b -> initInnerFold (f b)

1142

1217

1143− stepc (B s) a = do

1218+ stepc (B s fin) a = do

1144 r <- stepa s a

1219 r <- stepa s a

1145 case r of

1220 case r of

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

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

1147 Done b -> initInnerFold (f b)

1222 Done b -> initInnerFold (f b)

1148

1223

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

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

1150 r <- stepInner s a

1225 r <- stepInner s a

1151 return $ case r of

1226 return $ case r of

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

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

1153 Done c -> Done c

1228 Done c -> Done c

1154

1229

1155− extractc (B s) = do

1230+ -- XXX Cannot use for scanning

1156− r <- extracta s

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

1157− initExtract (f r)

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

1159

1232

1160− initInnerFold (Fold step i e) = do

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

1161 r <- i

1234 r <- i

1162 return $ case r of

1235 return $ case r of

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

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

1164 Done c -> Done c

1237 Done c -> Done c

1165

1238

1166− initExtract (Fold _ i e) = do

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

1167 r <- i

1240 r <- i

1168 case r of

1241 case r of

1169− Partial s -> e s

1242+ Partial s -> fin s

1170 Done c -> return c

1243 Done c -> return c

1171

1244

1245+ finalc (B s fin) = do

1246+ r <- fin s

1247+ initFinalize (f r)

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

1249+

1172------------------------------------------------------------------------------

1250------------------------------------------------------------------------------

1173-- Mapping on input

1251-- Mapping on input

1174------------------------------------------------------------------------------

1252------------------------------------------------------------------------------

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

1187--

1265--

1188{-# INLINE lmap #-}

1266{-# INLINE lmap #-}

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

1267lmap :: (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

1191 where

1269 where

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

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

1193

1271

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

1195--

1273--

1196{-# INLINE lmapM #-}

1274{-# INLINE lmapM #-}

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

1275lmapM :: 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

1199 where

1277 where

1200 step' x a = f a >>= step x

1278 step' x a = f a >>= step x

1201

1279

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

1207-- /Pre-release/

1285-- /Pre-release/

1208{-# INLINE postscan #-}

1286{-# INLINE postscan #-}

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

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

1288+postscan

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

1289+ (Fold stepL initialL extractL finalL)

1290+ (Fold stepR initialR extractR finalR) =

1211− Fold step initial extract

1291+ Fold step initial extract final

1212

1292

1213 where

1293 where

1214

1294

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

1219 Done bL -> do

1299 Done bL -> do

1220 rR <- stepR sR bL

1300 rR <- stepR sR bL

1221 case rR of

1301 case rR of

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

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

1223 Done bR -> return $ Done bR

1303 Done bR -> return $ Done bR

1224 Partial sL -> do

1304 Partial sL -> do

1225 !b <- extractL sL

1305 !b <- extractL sL

1226 rR <- stepR sR b

1306 rR <- stepR sR b

1227− return

1228− $ case rR of

1307+ case rR of

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

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

1230− Done bR -> Done bR

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

1231

1310

1232 initial = do

1311 initial = do

1233− r <- initialR

1312+ rR <- initialR

1234− rL <- initialL

1235− case r of

1313+ case rR of

1236− Partial sR ->

1314+ Partial sR -> do

1315+ rL <- initialL

1237 case rL of

1316 case rL of

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

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

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

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

1240 Done b -> return $ Done b

1319 Done b -> return $ Done b

1241

1320

1321+ -- XXX should use Tuple'

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

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

1243

1323

1244 extract = extractR . snd

1324 extract = extractR . snd

1245

1325

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

1327+

1246------------------------------------------------------------------------------

1328------------------------------------------------------------------------------

1247-- Filtering

1329-- Filtering

1248------------------------------------------------------------------------------

1330------------------------------------------------------------------------------

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

1255--

1337--

1256{-# INLINE_NORMAL catMaybes #-}

1338{-# INLINE_NORMAL catMaybes #-}

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

1339catMaybes :: 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

1259

1341

1260 where

1342 where

1261

1343

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

1295{-# INLINE filter #-}

1377{-# INLINE filter #-}

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

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

1297-- filter p = scanMaybe (filtering p)

1379-- 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

1299 where

1381 where

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

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

1301

1383

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

1306--

1388--

1307{-# INLINE filterM #-}

1389{-# INLINE filterM #-}

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

1390filterM :: 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

1310 where

1392 where

1311 step' x a = do

1393 step' x a = do

1312 use <- f a

1394 use <- f a

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

1395{-# INLINE take #-}

1477{-# INLINE take #-}

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

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

1397-- take n = scanMaybe (taking n)

1479-- 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

1399

1481

1400 where

1482 where

1401

1483

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

1407 s1 = Tuple'Fused i1 s

1489 s1 = Tuple'Fused i1 s

1408 if i1 < n

1490 if i1 < n

1409 then return $ Partial s1

1491 then return $ Partial s1

1410− else Done <$> fextract s

1492+ else Done <$> ffinal s

1411 Done b -> return $ Done b

1493 Done b -> return $ Done b

1412

1494

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

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

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

1416

1498

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

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

1418

1500

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

1502+

1419------------------------------------------------------------------------------

1503------------------------------------------------------------------------------

1420-- Nesting

1504-- Nesting

1421------------------------------------------------------------------------------

1505------------------------------------------------------------------------------

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

1433-- /Pre-release/

1517-- /Pre-release/

1434{-# INLINE duplicate #-}

1518{-# INLINE duplicate #-}

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

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

1436−duplicate (Fold step1 initial1 extract1) =

1520+duplicate (Fold step1 initial1 extract1 final1) =

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

1521+ Fold step initial extract final

1438

1522

1439 where

1523 where

1440

1524

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

1442

1526

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

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

1444

1528

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+

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

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

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

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

1447-- action in streams.

1536-- action in streams.

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

1453-- /Pre-release/

1542-- /Pre-release/

1454{-# INLINE reduce #-}

1543{-# INLINE reduce #-}

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

1544reduce :: 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

1457 i <- initial

1546 i <- initial

1458− return $ Fold step (return i) extract

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

1459

1548

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

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

1461

1550

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

1465-- /Pre-release/

1554-- /Pre-release/

1466{-# INLINE snoclM #-}

1555{-# INLINE snoclM #-}

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

1556snoclM :: 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

1469

1559

1470 where

1560 where

1471

1561

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

1492{-# INLINE snocl #-}

1582{-# INLINE snocl #-}

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

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

1494-- snocl f = snoclM f . return

1584-- 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

1496

1587

1497 where

1588 where

1498

1589

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

1512-- /Pre-release/

1603-- /Pre-release/

1513{-# INLINE snocM #-}

1604{-# INLINE snocM #-}

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

1605snocM :: 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

1516 res <- initial

1607 res <- initial

1517 r <- case res of

1608 r <- case res of

1518 Partial fs -> action >>= step fs

1609 Partial fs -> action >>= step fs

1519 Done _ -> return res

1610 Done _ -> return res

1520− return $ Fold step (return r) extract

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

1521

1612

1522-- Definitions:

1613-- Definitions:

1523--

1614--

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

1536-- /Pre-release/

1627-- /Pre-release/

1537{-# INLINE snoc #-}

1628{-# INLINE snoc #-}

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

1629snoc :: 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

1540 res <- initial

1631 res <- initial

1541 r <- case res of

1632 r <- case res of

1542 Partial fs -> step fs a

1633 Partial fs -> step fs a

1543 Done _ -> return res

1634 Done _ -> return res

1544− return $ Fold step (return r) extract

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

1545

1636

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

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

1547--

1638--

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

1569-- /Pre-release/

1660-- /Pre-release/

1570{-# INLINE extractM #-}

1661{-# INLINE extractM #-}

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

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

1572−extractM (Fold _ initial extract) = do

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

1573 res <- initial

1664 res <- initial

1574 case res of

1665 case res of

1575 Partial fs -> extract fs

1666 Partial fs -> extract fs

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

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

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

1579{-# INLINE close #-}

1670{-# INLINE close #-}

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

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

1672+close (Fold _ initial1 _ final1) =

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

1673+ Fold undefined initial undefined undefined

1582

1674

1583 where

1675 where

1584

1676

1585 initial = do

1677 initial = do

1586 res <- initial1

1678 res <- initial1

1587 case res of

1679 case res of

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

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

1589 Done b -> return $ Done b

1681 Done b -> return $ Done b

1590

1682

1591-- Corresponds to the null check for streams.

1683-- Corresponds to the null check for streams.

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

1595-- /Pre-release/

1687-- /Pre-release/

1596{-# INLINE isClosed #-}

1688{-# INLINE isClosed #-}

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

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

1598−isClosed (Fold _ initial _) = do

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

1599 res <- initial

1691 res <- initial

1600 return $ case res of

1692 return $ case res of

1601 Partial _ -> False

1693 Partial _ -> False

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

1629--

1721--

1630{-# INLINE many #-}

1722{-# INLINE many #-}

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

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

1724+many

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

1725+ (Fold sstep sinitial sextract sfinal)

1726+ (Fold cstep cinitial cextract cfinal) =

1633− Fold step initial extract

1727+ Fold step initial extract final

1634

1728

1635 where

1729 where

1636

1730

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

1679 Partial s -> cextract s

1773 Partial s -> cextract s

1680 Done b -> return b

1774 Done b -> return b

1681

1775

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+

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

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

1683-- input is received.

1784-- input is received.

1684--

1785--

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

1688--

1789--

1689{-# INLINE manyPost #-}

1790{-# INLINE manyPost #-}

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

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

1792+manyPost

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

1793+ (Fold sstep sinitial sextract sfinal)

1794+ (Fold cstep cinitial cextract cfinal) =

1692− Fold step initial extract

1795+ Fold step initial extract final

1693

1796

1694 where

1797 where

1695

1798

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

1725 Partial s -> cextract s

1828 Partial s -> cextract s

1726 Done b -> return b

1829 Done b -> return b

1727

1830

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+

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

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

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

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

1730-- fold.

1839-- fold.

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

1753--

1862--

1754{-# INLINE refoldMany #-}

1863{-# INLINE refoldMany #-}

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

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

1865+refoldMany

1866+ (Fold sstep sinitial sextract _sfinal)

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

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

1868+ (Refold cstep cinject cextract) =

1757 Refold step inject extract

1869 Refold step inject extract

1758

1870

1759 where

1871 where

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

1804-- /Internal/

1916-- /Internal/

1805{-# INLINE refoldMany1 #-}

1917{-# INLINE refoldMany1 #-}

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

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

1919+refoldMany1

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

1920+ (Refold sstep sinject sextract)

1921+ (Fold cstep cinitial cextract _cfinal) =

1808 Refold step inject extract

1922 Refold step inject extract

1809

1923

1810 where

1924 where

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

1855{-# INLINE refold #-}

1969{-# INLINE refold #-}

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

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

1857refold (Refold step inject extract) f =

1971refold (Refold step inject extract) f =

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

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

1859

1973

1860------------------------------------------------------------------------------

1974------------------------------------------------------------------------------

1861-- morphInner

1975-- morphInner

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

1865--

1979--

1866-- /Pre-release/

1980-- /Pre-release/

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

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

1868−morphInner f (Fold step initial extract) =

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

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

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

1870

1984

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

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

1872--

1986--

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

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

148--

149{-# INLINE windowSumInt #-}

150windowSumInt :: 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

152

153 where

154

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

182--

183{-# INLINE windowSum #-}

184windowSum :: 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

186

187 where

188

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

267--

268{-# INLINE windowRange #-}

269windowRange :: (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

271

272 where

273

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

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

28 mapDelete :: Key f -> f a -> f a

29 mapUnion :: f a -> f a -> f a

30 mapNull :: f a -> Bool

31+ mapTraverseWithKey ::

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

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

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

33 type Key (Map k) = k

35 type Key (Map k) = k

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

39 mapDelete = Map.delete

41 mapDelete = Map.delete

40 mapUnion = Map.union

42 mapUnion = Map.union

41 mapNull = Map.null

43 mapNull = Map.null

44+ mapTraverseWithKey = Map.traverseWithKey

43instance IsMap IntMap.IntMap where

46instance IsMap IntMap.IntMap where

44 type Key IntMap.IntMap = Int

47 type Key IntMap.IntMap = Int

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

50 mapDelete = IntMap.delete

53 mapDelete = IntMap.delete

51 mapUnion = IntMap.union

54 mapUnion = IntMap.union

52 mapNull = IntMap.null

55 mapNull = IntMap.null

56+ mapTraverseWithKey = IntMap.traverseWithKey

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

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

598-- /Pre-release/

599{-# INLINE_NORMAL writeNUnsafe #-}

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

601−writeNUnsafe n = Fold step initial return

601+writeNUnsafe n = Fold step initial return return

602

603 where

604

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

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

21 , Step (..)

22 , Initial (..)

24− -- * Downgrade to Fold

24+ -- -- * Downgrade to Fold

25− , toFold

25+ -- , toFold

27 -- First order parsers

28 -- * Accumulators

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

270-- Downgrade a parser to a Fold

271-------------------------------------------------------------------------------

272

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+{-

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

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

274-- parser fails or tries to backtrack.

278-- parser fails or tries to backtrack.

275--

279--

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

281--

285--

282{-# INLINE toFold #-}

286{-# INLINE toFold #-}

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

287toFold :: 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

285

289

286 where

290 where

287

291

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

317 Continue n _ -> cerror n

321 Continue n _ -> cerror n

318 Done n _ -> derror n

322 Done n _ -> derror n

319 Error err -> eerror err

323 Error err -> eerror err

324+-}

320

325

321-------------------------------------------------------------------------------

326-------------------------------------------------------------------------------

322-- Upgrade folds to parses

327-- Upgrade folds to parses

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

327--

332--

328{-# INLINE fromFold #-}

333{-# INLINE fromFold #-}

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

334fromFold :: 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

331

336

332 where

337 where

333

338

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

345 FL.Partial s1 -> Partial 0 s1

350 FL.Partial s1 -> Partial 0 s1

346 FL.Done b -> Done 0 b

351 FL.Done b -> Done 0 b

347

352

348− extract = fmap (Done 0) . fextract

353+ extract = fmap (Done 0) . ffinal

349

354

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

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

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

356-- 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

355--

360--

356{-# INLINE fromFoldMaybe #-}

361{-# INLINE fromFoldMaybe #-}

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

362fromFoldMaybe :: 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) =

359 Parser step initial extract

364 Parser step initial extract

360

365

361 where

366 where

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

381 Nothing -> Error errMsg

386 Nothing -> Error errMsg

382

387

383 extract s = do

388 extract s = do

384− res <- fextract s

389+ res <- ffinal s

385 case res of

390 case res of

386 Just x -> return $ Done 0 x

391 Just x -> return $ Done 0 x

387 Nothing -> return $ Error errMsg

392 Nothing -> return $ Error errMsg

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

630--

635--

631{-# INLINE takeBetween #-}

636{-# INLINE takeBetween #-}

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

637takeBetween :: 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) =

634

639

635 Parser step initial (extract streamErr)

640 Parser step initial (extract streamErr)

636

641

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

685 then return $ Continue 0 s1

690 then return $ Continue 0 s1

686 else if i1 < high

691 else if i1 < high

687 then return $ Partial 0 s1

692 then return $ Partial 0 s1

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

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

689 FL.Done b ->

694 FL.Done b ->

690 return

695 return

691 $ if i1 >= low

696 $ if i1 >= low

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

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

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

696

701

697 extract f (Tuple'Fused i s)

702 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)

699 | otherwise = return $ Error (f i)

704 | otherwise = return $ Error (f i)

700

705

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

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

702 iextract f (Tuple'Fused i s)

707 iextract f (Tuple'Fused i s)

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

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

704 | otherwise = return $ IError (f i)

709 | otherwise = return $ IError (f i)

705

710

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

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

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

717--

722--

718{-# INLINE takeEQ #-}

723{-# INLINE takeEQ #-}

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

724takeEQ :: 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

721

726

722 where

727 where

723

728

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

727 FL.Partial s ->

732 FL.Partial s ->

728 if n > 0

733 if n > 0

729 then return $ IPartial $ Tuple'Fused 1 s

734 then return $ IPartial $ Tuple'Fused 1 s

730− else fmap IDone (fextract s)

735+ else fmap IDone (ffinal s)

731 FL.Done b -> return $

736 FL.Done b -> return $

732 if n > 0

737 if n > 0

733 then IError

738 then IError

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

751 -- assert (n == i1)

756 -- assert (n == i1)

752 Done 0

757 Done 0

753 <$> case res of

758 <$> case res of

754− FL.Partial s -> fextract s

759+ FL.Partial s -> ffinal s

755 FL.Done b -> return b

760 FL.Done b -> return b

756

761

757 extract (Tuple'Fused i _) =

762 extract (Tuple'Fused i _) =

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

783--

788--

784{-# INLINE takeGE #-}

789{-# INLINE takeGE #-}

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

790takeGE :: 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

787

792

788 where

793 where

789

794

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

831 $ Error

836 $ Error

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

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

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

838 ++ " 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

835

840

836-------------------------------------------------------------------------------

841-------------------------------------------------------------------------------

837-- Conditional splitting

842-- Conditional splitting

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

892{-# INLINE takeWhile #-}

897{-# INLINE takeWhile #-}

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

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

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

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

895−takeWhile predicate (Fold fstep finitial fextract) =

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

896 Parser step initial extract

901 Parser step initial extract

897

902

898 where

903 where

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

911 $ case fres of

916 $ case fres of

912 FL.Partial s1 -> Partial 0 s1

917 FL.Partial s1 -> Partial 0 s1

913 FL.Done b -> Done 0 b

918 FL.Done b -> Done 0 b

914− else Done 1 <$> fextract s

919+ else Done 1 <$> ffinal s

915

920

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

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

917

922

918{-

923{-

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

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

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

933{-# INLINE takeWhile1 #-}

938{-# INLINE takeWhile1 #-}

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

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

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

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

936−takeWhile1 predicate (Fold fstep finitial fextract) =

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

937 Parser step initial extract

942 Parser step initial extract

938

943

939 where

944 where

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

963 if predicate a

968 if predicate a

964 then process s a

969 then process s a

965 else do

970 else do

966− b <- fextract s

971+ b <- ffinal s

967 return $ Done 1 b

972 return $ Done 1 b

968

973

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

974 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)

971

976

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

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

973-- discarding the results.

978-- discarding the results.

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

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

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

997 -> Fold m a b

1002 -> Fold m a b

998 -> Parser a m b

1003 -> Parser a m b

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

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

1000

1005

1001 Parser step initial extract

1006 Parser step initial extract

1002

1007

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

1028 if isEnd a

1033 if isEnd a

1029 then

1034 then

1030 if n == 0

1035 if n == 0

1031− then Done 0 <$> fextract s

1036+ then Done 0 <$> ffinal s

1032 else process s a (n - 1)

1037 else process s a (n - 1)

1033 else

1038 else

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

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

1035 in process s a n1

1040 in process s a n1

1036 Nothing -> -- takeEndBy case

1041 Nothing -> -- takeEndBy case

1037 if isEnd a

1042 if isEnd a

1038− then Done 0 <$> fextract s

1043+ then Done 0 <$> ffinal s

1039 else process s a n

1044 else process s a n

1040 Nothing -> -- takeStartBy case

1045 Nothing -> -- takeStartBy case

1041 case begin of

1046 case begin of

1042 Just isBegin ->

1047 Just isBegin ->

1043 if isBegin a

1048 if isBegin a

1044− then Done 0 <$> fextract s

1049+ then Done 0 <$> ffinal s

1045 else process s a n

1050 else process s a n

1046 Nothing ->

1051 Nothing ->

1047 error $ "takeFramedByGeneric: "

1052 error $ "takeFramedByGeneric: "

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

1066 case end of

1071 case end of

1067 Just isEnd ->

1072 Just isEnd ->

1068 if isEnd a

1073 if isEnd a

1069− then Done 0 <$> fextract s

1074+ then Done 0 <$> ffinal s

1070 else processCheckEsc s a 0

1075 else processCheckEsc s a 0

1071 Nothing ->

1076 Nothing ->

1072 error "Both begin and end frame predicate missing"

1077 error "Both begin and end frame predicate missing"

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

1081 case begin of

1086 case begin of

1082 Just _ ->

1087 Just _ ->

1083 case end of

1088 case end of

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

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

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

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

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

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

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

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

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

1120 -> Fold m a b

1125 -> Fold m a b

1121 -> Parser a m b

1126 -> Parser a m b

1122blockWithQuotes isEsc isQuote bopen bclose

1127blockWithQuotes isEsc isQuote bopen bclose

1123− (Fold fstep finitial fextract) =

1128+ (Fold fstep finitial _ ffinal) =

1124 Parser step initial extract

1129 Parser step initial extract

1125

1130

1126 where

1131 where

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

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

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

1151 | a == bclose =

1156 | a == bclose =

1152 if level == 1

1157 if level == 1

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

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

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

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

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

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

1156 | otherwise = process s a (BlockUnquoted level)

1161 | otherwise = process s a (BlockUnquoted level)

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

1164

1169

1165 err = return . Error

1170 err = return . Error

1166

1171

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

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

1168 extract (BlockUnquoted level _) =

1173 extract (BlockUnquoted level _) =

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

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

1170 extract (BlockQuoted level _) =

1175 extract (BlockQuoted level _) =

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

1299--

1304--

1300{-# INLINE takeStartBy #-}

1305{-# INLINE takeStartBy #-}

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

1306takeStartBy :: 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) =

1303

1308

1304 Parser step initial extract

1309 Parser step initial extract

1305

1310

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

1327 step (Right' s) a =

1332 step (Right' s) a =

1328 if not (cond a)

1333 if not (cond a)

1329 then process s a

1334 then process s a

1330− else Done 1 <$> fextract s

1335+ else Done 1 <$> ffinal s

1331

1336

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

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

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

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

1334

1339

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

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

1336--

1341--

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

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

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

1367-- takeFramedByEsc_ isEsc isEnd p =

1372-- takeFramedByEsc_ isEsc isEnd p =

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

1373-- 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 ) =

1370

1375

1371 Parser step initial extract

1376 Parser step initial extract

1372

1377

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

1402 in process s a n1

1407 in process s a n1

1403 else

1408 else

1404 if n == 0

1409 if n == 0

1405− then Done 0 <$> fextract s

1410+ then Done 0 <$> ffinal s

1406 else process s a (n - 1)

1411 else process s a (n - 1)

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

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

1408

1413

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

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

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

1425-- takeFramedBy_ isBegin isEnd =

1430-- takeFramedBy_ isBegin isEnd =

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

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

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

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

1428

1433

1429 Parser step initial extract

1434 Parser step initial extract

1430

1435

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

1454 | not (isEnd a) =

1459 | not (isEnd a) =

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

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

1456 in process s a n1

1461 in process s a n1

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

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

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

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

1459

1464

1460 err = return . Error

1465 err = return . Error

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

1489--

1494--

1490{-# INLINE wordBy #-}

1495{-# INLINE wordBy #-}

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

1496wordBy :: 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

1493

1498

1494 where

1499 where

1495

1500

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

1516 if not (predicate a)

1521 if not (predicate a)

1517 then worder s a

1522 then worder s a

1518 else do

1523 else do

1519− b <- fextract s

1524+ b <- ffinal s

1520 return $ Partial 0 $ WBRight b

1525 return $ Partial 0 $ WBRight b

1521 step (WBRight b) a =

1526 step (WBRight b) a =

1522 return

1527 return

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

1524 then Done 1 b

1529 then Done 1 b

1525 else Partial 0 $ WBRight b

1530 else Partial 0 $ WBRight b

1526

1531

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

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

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

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

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

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

1530

1535

1531data WordFramedState s b =

1536data WordFramedState s b =

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

1562 -> Fold m a b

1567 -> Fold m a b

1563 -> Parser a m b

1568 -> Parser a m b

1564wordFramedBy isEsc isBegin isEnd isSep

1569wordFramedBy isEsc isBegin isEnd isSep

1565− (Fold fstep finitial fextract) =

1570+ (Fold fstep finitial _ ffinal) =

1566 Parser step initial extract

1571 Parser step initial extract

1567

1572

1568 where

1573 where

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

1593 step (WordFramedWord s n) a

1598 step (WordFramedWord s n) a

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

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

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

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

1596− b <- fextract s

1601+ b <- ffinal s

1597 return $ Partial 0 $ WordFramedSkipPost b

1602 return $ Partial 0 $ WordFramedSkipPost b

1598 | otherwise = do

1603 | otherwise = do

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

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

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

1626

1631

1627 err = return . Error

1632 err = return . Error

1628

1633

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

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

1630 extract (WordFramedWord s n) =

1635 extract (WordFramedWord s n) =

1631 if n == 0

1636 if n == 0

1632− then fmap (Done 0) $ fextract s

1637+ then fmap (Done 0) $ ffinal s

1633 else err "wordFramedBy: missing frame end"

1638 else err "wordFramedBy: missing frame end"

1634 extract (WordFramedEsc _ _) =

1639 extract (WordFramedEsc _ _) =

1635 err "wordFramedBy: trailing escape"

1640 err "wordFramedBy: trailing escape"

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

1716 -> Fold m a b

1721 -> Fold m a b

1717 -> Parser a m b

1722 -> Parser a m b

1718wordWithQuotes keepQuotes tr escChar toRight isSep

1723wordWithQuotes keepQuotes tr escChar toRight isSep

1719− (Fold fstep finitial fextract) =

1724+ (Fold fstep finitial _ ffinal) =

1720 Parser step initial extract

1725 Parser step initial extract

1721

1726

1722 where

1727 where

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

1767 step (WordUnquotedWord s) a

1772 step (WordUnquotedWord s) a

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

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

1769 | isSep a = do

1774 | isSep a = do

1770− b <- fextract s

1775+ b <- ffinal s

1771 return $ Partial 0 $ WordQuotedSkipPost b

1776 return $ Partial 0 $ WordQuotedSkipPost b

1772 | otherwise = do

1777 | otherwise = do

1773 case toRight a of

1778 case toRight a of

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

1815

1820

1816 err = return . Error

1821 err = return . Error

1817

1822

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

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

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

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

1820 extract (WordQuotedWord s n _ _) =

1825 extract (WordQuotedWord s n _ _) =

1821 if n == 0

1826 if n == 0

1822− then fmap (Done 0) $ fextract s

1827+ then fmap (Done 0) $ ffinal s

1823 else err "wordWithQuotes: missing frame end"

1828 else err "wordWithQuotes: missing frame end"

1824 extract WordQuotedEsc {} =

1829 extract WordQuotedEsc {} =

1825 err "wordWithQuotes: trailing escape"

1830 err "wordWithQuotes: trailing escape"

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

1897--

1902--

1898{-# INLINE groupBy #-}

1903{-# INLINE groupBy #-}

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

1904groupBy :: 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

1901

1906

1902 where

1907 where

1903

1908

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

1920 step (GroupByGrouping a0 s) a =

1925 step (GroupByGrouping a0 s) a =

1921 if eq a0 a

1926 if eq a0 a

1922 then grouper s a0 a

1927 then grouper s a0 a

1923− else Done 1 <$> fextract s

1928+ else Done 1 <$> ffinal s

1924

1929

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

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

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

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

1927

1932

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

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

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

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

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

1957--

1962--

1958{-# INLINE groupByRolling #-}

1963{-# INLINE groupByRolling #-}

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

1964groupByRolling :: 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

1961

1966

1962 where

1967 where

1963

1968

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

1980 step (GroupByGrouping a0 s) a =

1985 step (GroupByGrouping a0 s) a =

1981 if eq a0 a

1986 if eq a0 a

1982 then grouper s a

1987 then grouper s a

1983− else Done 1 <$> fextract s

1988+ else Done 1 <$> ffinal s

1984

1989

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

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

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

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

1987

1992

1988{-# ANN type GroupByStatePair Fuse #-}

1993{-# ANN type GroupByStatePair Fuse #-}

1989data GroupByStatePair a s1 s2

1994data GroupByStatePair a s1 s2

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

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

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

2008groupByRollingEither

2013groupByRollingEither

2009 eq

2014 eq

2010− (Fold fstep1 finitial1 fextract1)

2015+ (Fold fstep1 finitial1 _ ffinal1)

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

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

2012

2017

2013 where

2018 where

2014

2019

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

2067 step (GroupByGroupingPairL a0 s1 s2) a =

2072 step (GroupByGroupingPairL a0 s1 s2) a =

2068 if not (eq a0 a)

2073 if not (eq a0 a)

2069 then grouperL2 s1 s2 a

2074 then grouperL2 s1 s2 a

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

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

2071

2076

2072 step (GroupByGroupingPairR a0 s1 s2) a =

2077 step (GroupByGroupingPairR a0 s1 s2) a =

2073 if eq a0 a

2078 if eq a0 a

2074 then grouperR2 s1 s2 a

2079 then grouperR2 s1 s2 a

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

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

2076

2081

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

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

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

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

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

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

2080 extract (GroupByGroupingPair a s1 _) = do

2085 extract (GroupByGroupingPair a s1 _) = do

2081 res <- fstep1 s1 a

2086 res <- fstep1 s1 a

2082 case res of

2087 case res of

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

2088 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

2085

2090

2086-- XXX use an Unfold instead of a list?

2091-- XXX use an Unfold instead of a list?

2087-- XXX custom combinators for matching list, array and stream?

2092-- XXX custom combinators for matching list, array and stream?

@@ -2234,7 +2239,7 @@ postscan = undefined

2234{-# INLINE zipWithM #-}

2239{-# INLINE zipWithM #-}

2235zipWithM :: Monad m =>

2240zipWithM :: Monad m =>

2236 (a -> b -> m c) -> D.Stream m a -> Fold m c x -> Parser b m x

2241 (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) =

2238 Parser step initial extract

2243 Parser step initial extract

2239

2244

2240 where

2245 where

@@ -2247,7 +2252,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

2247 case r of

2252 case r of

2248 D.Yield x s -> return $ IPartial (Just' x, s, fs)

2253 D.Yield x s -> return $ IPartial (Just' x, s, fs)

2249 D.Stop -> do

2254 D.Stop -> do

2250− x <- fextract fs

2255+ x <- ffinal fs

2251 return $ IDone x

2256 return $ IDone x

2252 -- Need Skip/Continue in initial to loop right here

2257 -- Need Skip/Continue in initial to loop right here

2253 D.Skip s -> return $ IPartial (Nothing', s, fs)

2258 D.Skip s -> return $ IPartial (Nothing', s, fs)

@@ -2262,7 +2267,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

2262 case r of

2267 case r of

2263 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)

2268 D.Yield x1 s -> return $ Continue 0 (Just' x1, s, fs1)

2264 D.Stop -> do

2269 D.Stop -> do

2265− x <- fextract fs1

2270+ x <- ffinal fs1

2266 return $ Done 0 x

2271 return $ Done 0 x

2267 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)

2272 D.Skip s -> return $ Continue 1 (Nothing', s, fs1)

2268 FL.Done x -> return $ Done 0 x

2273 FL.Done x -> return $ Done 0 x

@@ -2277,7 +2282,7 @@ zipWithM zf (D.Stream sstep state) (Fold fstep finitial fextract) =

2277 return $ Continue 0 (Nothing', s, fs1)

2282 return $ Continue 0 (Nothing', s, fs1)

2278 FL.Done x -> return $ Done 0 x

2283 FL.Done x -> return $ Done 0 x

2279 D.Stop -> do

2284 D.Stop -> do

2280− x <- fextract fs

2285+ x <- ffinal fs

2281 return $ Done 1 x

2286 return $ Done 1 x

2282 D.Skip s -> return $ Continue 1 (Nothing', s, fs)

2287 D.Skip s -> return $ Continue 1 (Nothing', s, fs)

2283

2288

@@ -2561,7 +2566,7 @@ deintercalateAll :: Monad m =>

2561deintercalateAll

2566deintercalateAll

2562 (Parser stepL initialL extractL)

2567 (Parser stepL initialL extractL)

2563 (Parser stepR initialR _)

2568 (Parser stepR initialR _)

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

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

2565

2570

2566 where

2571 where

2567

2572

@@ -2632,9 +2637,9 @@ deintercalateAll

2632 extractResult n fs r = do

2637 extractResult n fs r = do

2633 res <- fstep fs r

2638 res <- fstep fs r

2634 case res of

2639 case res of

2635− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2640+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

2636 FL.Done c -> return (Done n c)

2641 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

2638 extract (DeintercalateAllL fs sL) = do

2643 extract (DeintercalateAllL fs sL) = do

2639 r <- extractL sL

2644 r <- extractL sL

2640 case r of

2645 case r of

@@ -2642,7 +2647,7 @@ deintercalateAll

2642 Error err -> return $ Error err

2647 Error err -> return $ Error err

2643 Continue n s -> return $ Continue n (DeintercalateAllL fs s)

2648 Continue n s -> return $ Continue n (DeintercalateAllL fs s)

2644 Partial _ _ -> error "Partial in extract"

2649 Partial _ _ -> error "Partial in extract"

2645− extract (DeintercalateAllInitR fs) = fmap (Done 0) $ fextract fs

2650+ extract (DeintercalateAllInitR fs) = fmap (Done 0) $ ffinal fs

2646 extract (DeintercalateAllR _ _) =

2651 extract (DeintercalateAllR _ _) =

2647 return $ Error "deintercalateAll: input ended at 'Right' value"

2652 return $ Error "deintercalateAll: input ended at 'Right' value"

2648

2653

@@ -2685,7 +2690,7 @@ deintercalate :: Monad m =>

2685deintercalate

2690deintercalate

2686 (Parser stepL initialL extractL)

2691 (Parser stepL initialL extractL)

2687 (Parser stepR initialR _)

2692 (Parser stepR initialR _)

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

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

2689

2694

2690 where

2695 where

2691

2696

@@ -2716,7 +2721,7 @@ deintercalate

2716 Done n b ->

2721 Done n b ->

2717 processL (fstep fs (Left b)) n DeintercalateInitR

2722 processL (fstep fs (Left b)) n DeintercalateInitR

2718 Error _ -> do

2723 Error _ -> do

2719− xs <- fextract fs

2724+ xs <- ffinal fs

2720 return $ Done cnt1 xs

2725 return $ Done cnt1 xs

2721

2726

2722 {-# INLINE processR #-}

2727 {-# INLINE processR #-}

@@ -2736,7 +2741,7 @@ deintercalate

2736 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)

2741 Continue n s -> return $ Continue n (DeintercalateR (cnt1 - n) fs s)

2737 Done n b -> processR (cnt1 - n) b fs n

2742 Done n b -> processR (cnt1 - n) b fs n

2738 Error _ -> do

2743 Error _ -> do

2739− xs <- fextract fs

2744+ xs <- ffinal fs

2740 return $ Done cnt1 xs

2745 return $ Done cnt1 xs

2741

2746

2742 step (DeintercalateInitL fs) a = do

2747 step (DeintercalateInitL fs) a = do

@@ -2771,17 +2776,17 @@ deintercalate

2771 -- XXX We could have the fold accept pairs of (bR, bL)

2776 -- XXX We could have the fold accept pairs of (bR, bL)

2772 FL.Done _ -> error "Fold terminated consuming partial input"

2777 FL.Done _ -> error "Fold terminated consuming partial input"

2773 Error _ -> do

2778 Error _ -> do

2774− xs <- fextract fs

2779+ xs <- ffinal fs

2775 return $ Done cnt1 xs

2780 return $ Done cnt1 xs

2776

2781

2777 {-# INLINE extractResult #-}

2782 {-# INLINE extractResult #-}

2778 extractResult n fs r = do

2783 extractResult n fs r = do

2779 res <- fstep fs r

2784 res <- fstep fs r

2780 case res of

2785 case res of

2781− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2786+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

2782 FL.Done c -> return (Done n c)

2787 FL.Done c -> return (Done n c)

2783

2788

2784− extract (DeintercalateInitL fs) = fmap (Done 0) $ fextract fs

2789+ extract (DeintercalateInitL fs) = fmap (Done 0) $ ffinal fs

2785 extract (DeintercalateL cnt fs sL) = do

2790 extract (DeintercalateL cnt fs sL) = do

2786 r <- extractL sL

2791 r <- extractL sL

2787 case r of

2792 case r of

@@ -2789,10 +2794,10 @@ deintercalate

2789 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)

2794 Continue n s -> return $ Continue n (DeintercalateL (cnt - n) fs s)

2790 Partial _ _ -> error "Partial in extract"

2795 Partial _ _ -> error "Partial in extract"

2791 Error _ -> do

2796 Error _ -> do

2792− xs <- fextract fs

2797+ xs <- ffinal fs

2793 return $ Done cnt xs

2798 return $ Done cnt xs

2794− extract (DeintercalateInitR fs) = fmap (Done 0) $ fextract fs

2799+ extract (DeintercalateInitR fs) = fmap (Done 0) $ ffinal fs

2795− extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ fextract fs

2800+ extract (DeintercalateR cnt fs _) = fmap (Done cnt) $ ffinal fs

2796 extract (DeintercalateRL cnt bR fs sL) = do

2801 extract (DeintercalateRL cnt bR fs sL) = do

2797 r <- extractL sL

2802 r <- extractL sL

2798 case r of

2803 case r of

@@ -2804,7 +2809,7 @@ deintercalate

2804 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)

2809 Continue n s -> return $ Continue n (DeintercalateRL (cnt - n) bR fs s)

2805 Partial _ _ -> error "Partial in extract"

2810 Partial _ _ -> error "Partial in extract"

2806 Error _ -> do

2811 Error _ -> do

2807− xs <- fextract fs

2812+ xs <- ffinal fs

2808 return $ Done cnt xs

2813 return $ Done cnt xs

2809

2814

2810{-# ANN type Deintercalate1State Fuse #-}

2815{-# ANN type Deintercalate1State Fuse #-}

@@ -2841,7 +2846,7 @@ deintercalate1 :: Monad m =>

2841deintercalate1

2846deintercalate1

2842 (Parser stepL initialL extractL)

2847 (Parser stepL initialL extractL)

2843 (Parser stepR initialR _)

2848 (Parser stepR initialR _)

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

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

2845

2850

2846 where

2851 where

2847

2852

@@ -2895,7 +2900,7 @@ deintercalate1

2895 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)

2900 Continue n s -> return $ Continue n (Deintercalate1R (cnt1 - n) fs s)

2896 Done n b -> processR (cnt1 - n) b fs n

2901 Done n b -> processR (cnt1 - n) b fs n

2897 Error _ -> do

2902 Error _ -> do

2898− xs <- fextract fs

2903+ xs <- ffinal fs

2899 return $ Done cnt1 xs

2904 return $ Done cnt1 xs

2900

2905

2901 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a

2906 step (Deintercalate1InitL cnt fs sL) a = runStepInitL cnt fs sL a

@@ -2924,14 +2929,14 @@ deintercalate1

2924 -- XXX We could have the fold accept pairs of (bR, bL)

2929 -- XXX We could have the fold accept pairs of (bR, bL)

2925 FL.Done _ -> error "Fold terminated consuming partial input"

2930 FL.Done _ -> error "Fold terminated consuming partial input"

2926 Error _ -> do

2931 Error _ -> do

2927− xs <- fextract fs

2932+ xs <- ffinal fs

2928 return $ Done cnt1 xs

2933 return $ Done cnt1 xs

2929

2934

2930 {-# INLINE extractResult #-}

2935 {-# INLINE extractResult #-}

2931 extractResult n fs r = do

2936 extractResult n fs r = do

2932 res <- fstep fs r

2937 res <- fstep fs r

2933 case res of

2938 case res of

2934− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

2939+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

2935 FL.Done c -> return (Done n c)

2940 FL.Done c -> return (Done n c)

2936

2941

2937 extract (Deintercalate1InitL cnt fs sL) = do

2942 extract (Deintercalate1InitL cnt fs sL) = do

@@ -2941,8 +2946,8 @@ deintercalate1

2941 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)

2946 Continue n s -> return $ Continue n (Deintercalate1InitL (cnt - n) fs s)

2942 Partial _ _ -> error "Partial in extract"

2947 Partial _ _ -> error "Partial in extract"

2943 Error err -> return $ Error err

2948 Error err -> return $ Error err

2944− extract (Deintercalate1InitR fs) = fmap (Done 0) $ fextract fs

2949+ extract (Deintercalate1InitR fs) = fmap (Done 0) $ ffinal fs

2945− extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ fextract fs

2950+ extract (Deintercalate1R cnt fs _) = fmap (Done cnt) $ ffinal fs

2946 extract (Deintercalate1RL cnt bR fs sL) = do

2951 extract (Deintercalate1RL cnt bR fs sL) = do

2947 r <- extractL sL

2952 r <- extractL sL

2948 case r of

2953 case r of

@@ -2954,7 +2959,7 @@ deintercalate1

2954 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)

2959 Continue n s -> return $ Continue n (Deintercalate1RL (cnt - n) bR fs s)

2955 Partial _ _ -> error "Partial in extract"

2960 Partial _ _ -> error "Partial in extract"

2956 Error _ -> do

2961 Error _ -> do

2957− xs <- fextract fs

2962+ xs <- ffinal fs

2958 return $ Done cnt xs

2963 return $ Done cnt xs

2959

2964

2960{-# ANN type SepByState Fuse #-}

2965{-# ANN type SepByState Fuse #-}

@@ -2997,7 +3002,7 @@ sepBy :: Monad m =>

2997sepBy

3002sepBy

2998 (Parser stepL initialL extractL)

3003 (Parser stepL initialL extractL)

2999 (Parser stepR initialR _)

3004 (Parser stepR initialR _)

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

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

3001

3006

3002 where

3007 where

3003

3008

@@ -3028,7 +3033,7 @@ sepBy

3028 Done n b ->

3033 Done n b ->

3029 processL (fstep fs b) n SepByInitR

3034 processL (fstep fs b) n SepByInitR

3030 Error _ -> do

3035 Error _ -> do

3031− xs <- fextract fs

3036+ xs <- ffinal fs

3032 return $ Done cnt1 xs

3037 return $ Done cnt1 xs

3033

3038

3034 {-# INLINE processR #-}

3039 {-# INLINE processR #-}

@@ -3048,7 +3053,7 @@ sepBy

3048 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)

3053 Continue n s -> return $ Continue n (SepByR (cnt1 - n) fs s)

3049 Done n _ -> processR (cnt1 - n) fs n

3054 Done n _ -> processR (cnt1 - n) fs n

3050 Error _ -> do

3055 Error _ -> do

3051− xs <- fextract fs

3056+ xs <- ffinal fs

3052 return $ Done cnt1 xs

3057 return $ Done cnt1 xs

3053

3058

3054 step (SepByInitL fs) a = do

3059 step (SepByInitL fs) a = do

@@ -3070,10 +3075,10 @@ sepBy

3070 extractResult n fs r = do

3075 extractResult n fs r = do

3071 res <- fstep fs r

3076 res <- fstep fs r

3072 case res of

3077 case res of

3073− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3078+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

3074 FL.Done c -> return (Done n c)

3079 FL.Done c -> return (Done n c)

3075

3080

3076− extract (SepByInitL fs) = fmap (Done 0) $ fextract fs

3081+ extract (SepByInitL fs) = fmap (Done 0) $ ffinal fs

3077 extract (SepByL cnt fs sL) = do

3082 extract (SepByL cnt fs sL) = do

3078 r <- extractL sL

3083 r <- extractL sL

3079 case r of

3084 case r of

@@ -3081,10 +3086,10 @@ sepBy

3081 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)

3086 Continue n s -> return $ Continue n (SepByL (cnt - n) fs s)

3082 Partial _ _ -> error "Partial in extract"

3087 Partial _ _ -> error "Partial in extract"

3083 Error _ -> do

3088 Error _ -> do

3084− xs <- fextract fs

3089+ xs <- ffinal fs

3085 return $ Done cnt xs

3090 return $ Done cnt xs

3086− extract (SepByInitR fs) = fmap (Done 0) $ fextract fs

3091+ extract (SepByInitR fs) = fmap (Done 0) $ ffinal fs

3087− extract (SepByR cnt fs _) = fmap (Done cnt) $ fextract fs

3092+ extract (SepByR cnt fs _) = fmap (Done cnt) $ ffinal fs

3088

3093

3089-- | Non-backtracking version of sepBy. Several times faster.

3094-- | Non-backtracking version of sepBy. Several times faster.

3090{-# INLINE sepByAll #-}

3095{-# INLINE sepByAll #-}

@@ -3139,7 +3144,7 @@ sepBy1 :: Monad m =>

3139sepBy1

3144sepBy1

3140 (Parser stepL initialL extractL)

3145 (Parser stepL initialL extractL)

3141 (Parser stepR initialR _)

3146 (Parser stepR initialR _)

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

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

3143

3148

3144 where

3149 where

3145

3150

@@ -3186,7 +3191,7 @@ sepBy1

3186 Done n b ->

3191 Done n b ->

3187 processL (fstep fs b) n SepBy1InitR

3192 processL (fstep fs b) n SepBy1InitR

3188 Error _ -> do

3193 Error _ -> do

3189− xs <- fextract fs

3194+ xs <- ffinal fs

3190 return $ Done cnt1 xs

3195 return $ Done cnt1 xs

3191

3196

3192 {-# INLINE processR #-}

3197 {-# INLINE processR #-}

@@ -3206,7 +3211,7 @@ sepBy1

3206 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)

3211 Continue n s -> return $ Continue n (SepBy1R (cnt1 - n) fs s)

3207 Done n _ -> processR (cnt1 - n) fs n

3212 Done n _ -> processR (cnt1 - n) fs n

3208 Error _ -> do

3213 Error _ -> do

3209− xs <- fextract fs

3214+ xs <- ffinal fs

3210 return $ Done cnt1 xs

3215 return $ Done cnt1 xs

3211

3216

3212 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a

3217 step (SepBy1InitL cnt fs sL) a = runStepInitL cnt fs sL a

@@ -3223,7 +3228,7 @@ sepBy1

3223 extractResult n fs r = do

3228 extractResult n fs r = do

3224 res <- fstep fs r

3229 res <- fstep fs r

3225 case res of

3230 case res of

3226− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3231+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

3227 FL.Done c -> return (Done n c)

3232 FL.Done c -> return (Done n c)

3228

3233

3229 extract (SepBy1InitL cnt fs sL) = do

3234 extract (SepBy1InitL cnt fs sL) = do

@@ -3240,10 +3245,10 @@ sepBy1

3240 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)

3245 Continue n s -> return $ Continue n (SepBy1L (cnt - n) fs s)

3241 Partial _ _ -> error "Partial in extract"

3246 Partial _ _ -> error "Partial in extract"

3242 Error _ -> do

3247 Error _ -> do

3243− xs <- fextract fs

3248+ xs <- ffinal fs

3244 return $ Done cnt xs

3249 return $ Done cnt xs

3245− extract (SepBy1InitR fs) = fmap (Done 0) $ fextract fs

3250+ extract (SepBy1InitR fs) = fmap (Done 0) $ ffinal fs

3246− extract (SepBy1R cnt fs _) = fmap (Done cnt) $ fextract fs

3251+ extract (SepBy1R cnt fs _) = fmap (Done cnt) $ ffinal fs

3247

3252

3248-------------------------------------------------------------------------------

3253-------------------------------------------------------------------------------

3249-- Interleaving a collection of parsers

3254-- Interleaving a collection of parsers

@@ -3273,7 +3278,7 @@ roundRobin _ps _f = undefined

3273{-# INLINE sequence #-}

3278{-# INLINE sequence #-}

3274sequence :: Monad m =>

3279sequence :: Monad m =>

3275 D.Stream m (Parser a m b) -> Fold m b c -> Parser a m c

3280 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) =

3277 Parser step initial extract

3282 Parser step initial extract

3278

3283

3279 where

3284 where

@@ -3291,7 +3296,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

3291 case sres of

3296 case sres of

3292 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)

3297 D.Yield p ss1 -> return $ Continue 1 (Just' p, ss1, fs)

3293 D.Stop -> do

3298 D.Stop -> do

3294− c <- fextract fs

3299+ c <- ffinal fs

3295 return $ Done 1 c

3300 return $ Done 1 c

3296 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)

3301 D.Skip ss1 -> return $ Continue 1 (Nothing', ss1, fs)

3297

3302

@@ -3327,7 +3332,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

3327 FL.Done c -> return $ Done 1 c

3332 FL.Done c -> return $ Done 1 c

3328 IError err -> return $ Error err

3333 IError err -> return $ Error err

3329

3334

3330− extract (Nothing', _, fs) = fmap (Done 0) $ fextract fs

3335+ extract (Nothing', _, fs) = fmap (Done 0) $ ffinal fs

3331 extract (Just' (Parser pstep pinit pextr), ss, fs) = do

3336 extract (Just' (Parser pstep pinit pextr), ss, fs) = do

3332 ps <- pinit

3337 ps <- pinit

3333 case ps of

3338 case ps of

@@ -3337,7 +3342,7 @@ sequence (D.Stream sstep sstate) (Fold fstep finitial fextract) =

3337 Done n b -> do

3342 Done n b -> do

3338 res <- fstep fs b

3343 res <- fstep fs b

3339 case res of

3344 case res of

3340− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3345+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

3341 FL.Done c -> return (Done n c)

3346 FL.Done c -> return (Done n c)

3342 Error err -> return $ Error err

3347 Error err -> return $ Error err

3343 Continue n s -> return $ Continue n (Just' (Parser pstep (return (IPartial s)) pextr), ss, fs)

3348 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) =

3345 IDone b -> do

3350 IDone b -> do

3346 fres <- fstep fs b

3351 fres <- fstep fs b

3347 case fres of

3352 case fres of

3348− FL.Partial fs1 -> fmap (Done 0) $ fextract fs1

3353+ FL.Partial fs1 -> fmap (Done 0) $ ffinal fs1

3349 FL.Done c -> return (Done 0 c)

3354 FL.Done c -> return (Done 0 c)

3350 IError err -> return $ Error err

3355 IError err -> return $ Error err

3351

3356

@@ -3480,7 +3485,7 @@ manyTill :: Monad m

3480 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c

3485 => Parser a m b -> Parser a m x -> Fold m b c -> Parser a m c

3481manyTill (Parser stepL initialL extractL)

3486manyTill (Parser stepL initialL extractL)

3482 (Parser stepR initialR _)

3487 (Parser stepR initialR _)

3483− (Fold fstep finitial fextract) =

3488+ (Fold fstep finitial _ ffinal) =

3484 Parser step initial extract

3489 Parser step initial extract

3485

3490

3486 where

3491 where

@@ -3502,7 +3507,7 @@ manyTill (Parser stepL initialL extractL)

3502 resR <- initialR

3507 resR <- initialR

3503 case resR of

3508 case resR of

3504 IPartial sr -> return $ p (ManyTillR 0 fs sr)

3509 IPartial sr -> return $ p (ManyTillR 0 fs sr)

3505− IDone _ -> d <$> fextract fs

3510+ IDone _ -> d <$> ffinal fs

3506 IError _ -> scrutL fs p c d e

3511 IError _ -> scrutL fs p c d e

3507

3512

3508 initial = do

3513 initial = do

@@ -3519,7 +3524,7 @@ manyTill (Parser stepL initialL extractL)

3519 assertM(cnt + 1 - n >= 0)

3524 assertM(cnt + 1 - n >= 0)

3520 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)

3525 return $ Continue n (ManyTillR (cnt + 1 - n) fs s)

3521 Done n _ -> do

3526 Done n _ -> do

3522− b <- fextract fs

3527+ b <- ffinal fs

3523 return $ Done n b

3528 return $ Done n b

3524 Error _ -> do

3529 Error _ -> do

3525 resL <- initialL

3530 resL <- initialL

@@ -3558,12 +3563,12 @@ manyTill (Parser stepL initialL extractL)

3558 Done n b -> do

3563 Done n b -> do

3559 r <- fstep fs b

3564 r <- fstep fs b

3560 case r of

3565 case r of

3561− FL.Partial fs1 -> fmap (Done n) $ fextract fs1

3566+ FL.Partial fs1 -> fmap (Done n) $ ffinal fs1

3562 FL.Done c -> return (Done n c)

3567 FL.Done c -> return (Done n c)

3563 Error err -> return $ Error err

3568 Error err -> return $ Error err

3564 Continue n s -> return $ Continue n (ManyTillL fs s)

3569 Continue n s -> return $ Continue n (ManyTillL fs s)

3565 Partial _ _ -> error "Partial in extract"

3570 Partial _ _ -> error "Partial in extract"

3566− extract (ManyTillR _ fs _) = fmap (Done 0) $ fextract fs

3571+ extract (ManyTillR _ fs _) = fmap (Done 0) $ ffinal fs

3567

3572

3568-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and

3573-- | @manyThen f collect recover@ repeats the parser @collect@ on the input and

3569-- collects the output in the supplied fold. If the the parser @collect@ fails,

3574-- 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

927--

928{-# INLINE splitMany #-}

929splitMany :: 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) =

931 Parser step initial extract

932

933 where

@@ -943,7 +943,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

943 IPartial ps -> return $ partial $ Fused3 ps 0 fs

944 IDone pb ->

945 runCollectorWith (handleCollect partial done) fs pb

946− IError _ -> done <$> fextract fs

946+ IError _ -> done <$> ffinal fs

947 FL.Done fb -> return $ done fb

948

949 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -967,19 +967,19 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

967 assertM(cnt1 - n >= 0)

968 fstep fs b >>= handleCollect (Partial n) (Done n)

969 Error _ -> do

970− xs <- fextract fs

970+ xs <- ffinal fs

971 return $ Done cnt xs

972

973− extract (Fused3 _ 0 fs) = fmap (Done 0) (fextract fs)

973+ extract (Fused3 _ 0 fs) = fmap (Done 0) (ffinal fs)

974 extract (Fused3 s cnt fs) = do

975 r <- extract1 s

976 case r of

977− Error _ -> fmap (Done cnt) (fextract fs)

977+ Error _ -> fmap (Done cnt) (ffinal fs)

978 Done n b -> do

979 assertM(n <= cnt)

980 fs1 <- fstep fs b

981 case fs1 of

982− FL.Partial s1 -> fmap (Done n) (fextract s1)

982+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

983 FL.Done b1 -> return (Done n b1)

984 Partial _ _ -> error "splitMany: Partial in extract"

985 Continue n s1 -> do

@@ -993,7 +993,7 @@ splitMany (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

993--

994{-# INLINE splitManyPost #-}

995splitManyPost :: 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) =

997 Parser step initial extract

998

999 where

@@ -1009,7 +1009,7 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1009 IPartial ps -> return $ partial $ Fused3 ps 0 fs

1010 IDone pb ->

1011 runCollectorWith (handleCollect partial done) fs pb

1012− IError _ -> done <$> fextract fs

1012+ IError _ -> done <$> ffinal fs

1013 FL.Done fb -> return $ done fb

1014

1015 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -1031,18 +1031,18 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1031 assertM(cnt1 - n >= 0)

1032 fstep fs b >>= handleCollect (Partial n) (Done n)

1033 Error _ -> do

1034− xs <- fextract fs

1034+ xs <- ffinal fs

1035 return $ Done cnt1 xs

1036

1037 extract (Fused3 s cnt fs) = do

1038 r <- extract1 s

1039 case r of

1040− Error _ -> fmap (Done cnt) (fextract fs)

1040+ Error _ -> fmap (Done cnt) (ffinal fs)

1041 Done n b -> do

1042 assertM(n <= cnt)

1043 fs1 <- fstep fs b

1044 case fs1 of

1045− FL.Partial s1 -> fmap (Done n) (fextract s1)

1045+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

1046 FL.Done b1 -> return (Done n b1)

1047 Partial _ _ -> error "splitMany: Partial in extract"

1048 Continue n s1 -> do

@@ -1055,7 +1055,7 @@ splitManyPost (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1055--

1056{-# INLINE splitSome #-}

1057splitSome :: 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) =

1059 Parser step initial extract

1060

1061 where

@@ -1071,7 +1071,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1071 IPartial ps -> return $ partial $ Fused3 ps 0 $ Right fs

1072 IDone pb ->

1073 runCollectorWith (handleCollect partial done) fs pb

1074− IError _ -> done <$> fextract fs

1074+ IError _ -> done <$> ffinal fs

1075 FL.Done fb -> return $ done fb

1076

1077 runCollectorWith cont fs pb = fstep fs pb >>= cont

@@ -1121,7 +1121,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1121 Done n b -> do

1122 assertM(cnt1 - n >= 0)

1123 fstep fs b >>= handleCollect (Partial n) (Done n)

1124− Error _ -> Done cnt1 <$> fextract fs

1124+ Error _ -> Done cnt1 <$> ffinal fs

1125

1126 extract (Fused3 s cnt (Left fs)) = do

1127 r <- extract1 s

@@ -1131,7 +1131,7 @@ splitSome (Parser step1 initial1 extract1) (Fold fstep finitial fextract) =

1131 assertM(n <= cnt)

1132 fs1 <- fstep fs b

1133 case fs1 of

1134− FL.Partial s1 -> fmap (Done n) (fextract s1)

1134+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

1135 FL.Done b1 -> return (Done n b1)

1136 Partial _ _ -> error "splitSome: Partial in extract"

1137 Continue n s1 -> do

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

1140 extract (Fused3 s cnt (Right fs)) = do

1141 r <- extract1 s

1142 case r of

1143− Error _ -> fmap (Done cnt) (fextract fs)

1143+ Error _ -> fmap (Done cnt) (ffinal fs)

1144 Done n b -> do

1145 assertM(n <= cnt)

1146 fs1 <- fstep fs b

1147 case fs1 of

1148− FL.Partial s1 -> fmap (Done n) (fextract s1)

1148+ FL.Partial s1 -> fmap (Done n) (ffinal s1)

1149 FL.Done b1 -> return (Done n b1)

1150 Partial _ _ -> error "splitSome: Partial in extract"

1151 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

558{-# INLINE slidingWindowWith #-}

559slidingWindowWith :: forall m a b. (MonadIO m, Storable a, Unbox a)

560 => 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

562

563

563 where

564 where

564

565

@@ -601,6 +602,8 @@ slidingWindowWith n (Fold step1 initial1 extract1) = Fold step initial extract

601

602

602 extract (Tuple4' _ _ _ st) = extract1 st

603 extract (Tuple4' _ _ _ st) = extract1 st

603

604

605+ final (Tuple4' _ _ _ st) = final1 st

606+

604-- | @slidingWindow collector@ is an incremental sliding window

607-- | @slidingWindow collector@ is an incremental sliding window

605-- fold that does not require all the intermediate elements in a computation.

608-- fold that does not require all the intermediate elements in a computation.

606-- This maintains @n@ elements in the window, when a new element comes it slides

609-- 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

69-- the Ring.

70{-# INLINE writeLastN #-}

71writeLastN :: MonadIO m => Int -> Fold m a (Ring a)

72−writeLastN n = Fold step initial extract

72+writeLastN n = Fold step initial extract extract

74 where

core/src/Streamly/Internal/Data/Stream/Chunked.hs+4−4

@@ -327,7 +327,7 @@ splitOnSuffix byte = D.splitInnerBySuffix (A.breakOn byte) A.splice

327{-# INLINE_NORMAL foldBreakD #-}

328foldBreakD :: forall m a b. (MonadIO m, Unbox a) =>

329 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

331 res <- initial

332 case res of

333 FL.Partial fs -> go SPEC state fs

@@ -344,7 +344,7 @@ foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do

344 in goArray SPEC s fp start fs

345 D.Skip s -> go SPEC s fs

346 D.Stop -> do

347− b <- extract fs

347+ b <- final fs

348 return (b, D.nil)

349

350 goArray !_ s (Tuple' end _) !cur !fs

@@ -363,7 +363,7 @@ foldBreakD (FL.Fold fstep initial extract) stream@(D.Stream step state) = do

363{-# INLINE_NORMAL foldBreakK #-}

364foldBreakK :: forall m a b. (MonadIO m, Unbox a) =>

365 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

367 res <- initial

368 case res of

369 FL.Partial fs -> go fs stream

@@ -373,7 +373,7 @@ foldBreakK (FL.Fold fstep initial extract) stream = do

373

374 {-# INLINE go #-}

375 go !fs st = do

376− let stop = (, K.nil) <$> extract fs

376+ let stop = (, K.nil) <$> final fs

377 single a = yieldk a K.nil

378 yieldk (Array contents start end) r =

379 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) =

131{-# INLINE_NORMAL lpackArraysChunksOf #-}

132lpackArraysChunksOf :: (MonadIO m, Unbox a)

133 => Int -> Fold m (MutArray a) () -> Fold m (MutArray a) ()

134−lpackArraysChunksOf n (Fold step1 initial1 extract1) =

134+lpackArraysChunksOf n (Fold step1 initial1 _ final1) =

135− Fold step initial extract

135+ Fold step initial extract final

136

137 where

138

@@ -145,13 +145,6 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

145 r <- initial1

146 return $ first (Tuple' Nothing) r

147

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−

155 step (Tuple' Nothing r1) arr =

148 step (Tuple' Nothing r1) arr =

156 let len = MArray.byteLength arr

149 let len = MArray.byteLength arr

157 in if len >= n

150 in if len >= n

@@ -160,7 +153,7 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

160 case r of

153 case r of

161 FL.Done _ -> return $ FL.Done ()

154 FL.Done _ -> return $ FL.Done ()

162 FL.Partial s -> do

155 FL.Partial s -> do

163− extract1 s

156+ _ <- final1 s

164 res <- initial1

157 res <- initial1

165 return $ first (Tuple' Nothing) res

158 return $ first (Tuple' Nothing) res

166 else return $ FL.Partial $ Tuple' (Just arr) r1

159 else return $ FL.Partial $ Tuple' (Just arr) r1

@@ -179,11 +172,26 @@ lpackArraysChunksOf n (Fold step1 initial1 extract1) =

179 case r of

172 case r of

180 FL.Done _ -> return $ FL.Done ()

173 FL.Done _ -> return $ FL.Done ()

181 FL.Partial s -> do

174 FL.Partial s -> do

182− extract1 s

175+ _ <- final1 s

183 res <- initial1

176 res <- initial1

184 return $ first (Tuple' Nothing) res

177 return $ first (Tuple' Nothing) res

185 else return $ FL.Partial $ Tuple' (Just buf'') r1

178 else return $ FL.Partial $ Tuple' (Just buf'') r1

186

179

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+

187-- XXX Same as compactLE, to be removed once that is implemented.

195-- XXX Same as compactLE, to be removed once that is implemented.

188--

196--

189-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a

197-- | Coalesce adjacent arrays in incoming stream to form bigger arrays of a

@@ -256,7 +264,7 @@ compactLEParserD n = ParserD.Parser step initial extract

256compactGEFold ::

264compactGEFold ::

257 forall m a. (MonadIO m, Unbox a)

265 forall m a. (MonadIO m, Unbox a)

258 => Int -> FL.Fold m (MutArray a) (MutArray a)

266 => Int -> FL.Fold m (MutArray a) (MutArray a)

259−compactGEFold n = Fold step initial extract

267+compactGEFold n = Fold step initial extract extract

260

268

261 where

269 where

262

270

core/src/Streamly/Internal/Data/Stream/Nesting.hs+68−57

@@ -1242,6 +1242,7 @@ foldSequence _f _m = undefined

1242data FIterState s f m a b

1243 = FIterInit s f

1244 | forall fs. FIterStream s (fs -> a -> m (FL.Step fs b)) fs (fs -> m b)

1245+ (fs -> m b)

1245 | FIterYield b (FIterState s f m a b)

1246 | FIterYield b (FIterState s f m a b)

1246 | FIterStop

1247 | FIterStop

1247

1248

@@ -1269,26 +1270,26 @@ foldIterateM func seed0 (Stream step state) =

1269 where

1270 where

1270

1271

1271 {-# INLINE iterStep #-}

1272 {-# INLINE iterStep #-}

1272− iterStep from st fstep extract = do

1273+ iterStep from st fstep extract final = do

1273 res <- from

1274 res <- from

1274 return

1275 return

1275 $ Skip

1276 $ Skip

1276 $ case res of

1277 $ case res of

1277− FL.Partial fs -> FIterStream st fstep fs extract

1278+ FL.Partial fs -> FIterStream st fstep fs extract final

1278 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)

1279 FL.Done fb -> FIterYield fb $ FIterInit st (return fb)

1279

1280

1280 {-# INLINE_LATE stepOuter #-}

1281 {-# INLINE_LATE stepOuter #-}

1281 stepOuter _ (FIterInit st seed) = do

1282 stepOuter _ (FIterInit st seed) = do

1282− (FL.Fold fstep initial extract) <- seed >>= func

1283+ (FL.Fold fstep initial extract final) <- seed >>= func

1283− iterStep initial st fstep extract

1284+ iterStep initial st fstep extract final

1284− stepOuter gst (FIterStream st fstep fs extract) = do

1285+ stepOuter gst (FIterStream st fstep fs extract final) = do

1285 r <- step (adaptState gst) st

1286 r <- step (adaptState gst) st

1286 case r of

1287 case r of

1287 Yield x s -> do

1288 Yield x s -> do

1288− iterStep (fstep fs x) s fstep extract

1289+ iterStep (fstep fs x) s fstep extract final

1289− Skip s -> return $ Skip $ FIterStream s fstep fs extract

1290+ Skip s -> return $ Skip $ FIterStream s fstep fs extract final

1290 Stop -> do

1291 Stop -> do

1291− b <- extract fs

1292+ b <- final fs

1292 return $ Skip $ FIterYield b FIterStop

1293 return $ Skip $ FIterYield b FIterStop

1293 stepOuter _ (FIterYield a next) = return $ Yield a next

1294 stepOuter _ (FIterYield a next) = return $ Yield a next

1294 stepOuter _ FIterStop = return Stop

1295 stepOuter _ FIterStop = return Stop

@@ -1338,7 +1339,7 @@ refoldIterateM (Refold fstep finject fextract) initial (Stream step state) =

1338-- "n" elements at the end are dropped by the fold.

1339-- "n" elements at the end are dropped by the fold.

1339{-# INLINE sliceBy #-}

1340{-# INLINE sliceBy #-}

1340sliceBy :: Monad m => Fold m a Int -> Int -> Refold m (Int, Int) a (Int, Int)

1341sliceBy :: 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

1342

1343

1343 where

1344 where

1344

1345

@@ -1916,7 +1917,7 @@ groupsWhile :: Monad m

1916{-

1917{-

1917groupsWhile eq fld = parseMany (PRD.groupBy eq fld)

1918groupsWhile eq fld = parseMany (PRD.groupBy eq fld)

1918-}

1919-}

1919−groupsWhile cmp (Fold fstep initial done) (Stream step state) =

1920+groupsWhile cmp (Fold fstep initial _ final) (Stream step state) =

1920 Stream stepOuter (GroupingInit state)

1921 Stream stepOuter (GroupingInit state)

1921

1922

1922 where

1923 where

@@ -1939,7 +1940,7 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

1939 FL.Partial fs1 -> go SPEC x s fs1

1940 FL.Partial fs1 -> go SPEC x s fs1

1940 FL.Done b -> return $ Yield b (GroupingInit s)

1941 FL.Done b -> return $ Yield b (GroupingInit s)

1941 Skip s -> return $ Skip $ GroupingDo s fs

1942 Skip s -> return $ Skip $ GroupingDo s fs

1942− Stop -> return Stop

1943+ Stop -> final fs >> return Stop

1943

1944

1944 where

1945 where

1945

1946

@@ -1954,10 +1955,12 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

1954 FL.Partial fs1 -> go SPEC prev s fs1

1955 FL.Partial fs1 -> go SPEC prev s fs1

1955 FL.Done b -> return $ Yield b (GroupingInit s)

1956 FL.Done b -> return $ Yield b (GroupingInit s)

1956 else do

1957 else do

1957− r <- done acc

1958+ r <- final acc

1958 return $ Yield r (GroupingInitWith s x)

1959 return $ Yield r (GroupingInitWith s x)

1959 Skip s -> go SPEC prev s acc

1960 Skip s -> go SPEC prev s acc

1961+ Stop -> do

1962+ r <- final acc

1960− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1963+ return $ Yield r GroupingDone

1961 stepOuter _ (GroupingInitWith st x) = do

1964 stepOuter _ (GroupingInitWith st x) = do

1962 res <- initial

1965 res <- initial

1963 return

1966 return

@@ -1984,10 +1987,12 @@ groupsWhile cmp (Fold fstep initial done) (Stream step state) =

1984 FL.Partial fs1 -> go SPEC s fs1

1987 FL.Partial fs1 -> go SPEC s fs1

1985 FL.Done b -> return $ Yield b (GroupingInit s)

1988 FL.Done b -> return $ Yield b (GroupingInit s)

1986 else do

1989 else do

1987− r <- done acc

1990+ r <- final acc

1988 return $ Yield r (GroupingInitWith s x)

1991 return $ Yield r (GroupingInitWith s x)

1989 Skip s -> go SPEC s acc

1992 Skip s -> go SPEC s acc

1993+ Stop -> do

1994+ r <- final acc

1990− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

1995+ return $ Yield r GroupingDone

1991 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"

1996 stepOuter _ (GroupingYield _ _) = error "groupsWhile: Unreachable"

1992 stepOuter _ GroupingDone = return Stop

1997 stepOuter _ GroupingDone = return Stop

1993

1998

@@ -2009,7 +2014,7 @@ groupsRollingBy :: Monad m

2009{-

2014{-

2010groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)

2015groupsRollingBy eq fld = parseMany (PRD.groupByRolling eq fld)

2011-}

2016-}

2012−groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2017+groupsRollingBy cmp (Fold fstep initial _ final) (Stream step state) =

2013 Stream stepOuter (GroupingInit state)

2018 Stream stepOuter (GroupingInit state)

2014

2019

2015 where

2020 where

@@ -2032,7 +2037,7 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2032 FL.Partial fs1 -> go SPEC x s fs1

2037 FL.Partial fs1 -> go SPEC x s fs1

2033 FL.Done fb -> return $ Yield fb (GroupingInit s)

2038 FL.Done fb -> return $ Yield fb (GroupingInit s)

2034 Skip s -> return $ Skip $ GroupingDo s fs

2039 Skip s -> return $ Skip $ GroupingDo s fs

2035− Stop -> return Stop

2040+ Stop -> final fs >> return Stop

2036

2041

2037 where

2042 where

2038

2043

@@ -2047,10 +2052,12 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2047 FL.Partial fs1 -> go SPEC x s fs1

2052 FL.Partial fs1 -> go SPEC x s fs1

2048 FL.Done b -> return $ Yield b (GroupingInit s)

2053 FL.Done b -> return $ Yield b (GroupingInit s)

2049 else do

2054 else do

2050− r <- done acc

2055+ r <- final acc

2051 return $ Yield r (GroupingInitWith s x)

2056 return $ Yield r (GroupingInitWith s x)

2052 Skip s -> go SPEC prev s acc

2057 Skip s -> go SPEC prev s acc

2058+ Stop -> do

2059+ r <- final acc

2053− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

2060+ return $ Yield r GroupingDone

2054 stepOuter _ (GroupingInitWith st x) = do

2061 stepOuter _ (GroupingInitWith st x) = do

2055 res <- initial

2062 res <- initial

2056 return

2063 return

@@ -2081,7 +2088,7 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2081 FL.Done b -> return $ Yield b (GroupingInit st)

2088 FL.Done b -> return $ Yield b (GroupingInit st)

2082 else do

2089 else do

2083 {-

2090 {-

2084− r <- done acc

2091+ r <- final acc

2085 return $ Yield r (GroupingInitWith s x)

2092 return $ Yield r (GroupingInitWith s x)

2086 -}

2093 -}

2087 -- The code above does not let groupBy fuse. We use the

2094 -- The code above does not let groupBy fuse. We use the

@@ -2090,14 +2097,16 @@ groupsRollingBy cmp (Fold fstep initial done) (Stream step state) =

2090 -- GroupingInitWith state here to help GHC with stream

2097 -- GroupingInitWith state here to help GHC with stream

2091 -- fusion.

2098 -- fusion.

2092 result <- initial

2099 result <- initial

2093− r <- done acc

2100+ r <- final acc

2094 return

2101 return

2095 $ Yield r

2102 $ Yield r

2096 $ case result of

2103 $ case result of

2097 FL.Partial fsi -> GroupingDoWith s fsi x

2104 FL.Partial fsi -> GroupingDoWith s fsi x

2098 FL.Done b -> GroupingYield b (GroupingInit s)

2105 FL.Done b -> GroupingYield b (GroupingInit s)

2099 Skip s -> go SPEC prev s acc

2106 Skip s -> go SPEC prev s acc

2107+ Stop -> do

2108+ r <- final acc

2100− Stop -> done acc >>= \r -> return $ Yield r GroupingDone

2109+ return $ Yield r GroupingDone

2101 stepOuter _ (GroupingYield r next) = return $ Yield r next

2110 stepOuter _ (GroupingYield r next) = return $ Yield r next

2102 stepOuter _ GroupingDone = return Stop

2111 stepOuter _ GroupingDone = return Stop

2103

2112

@@ -2119,7 +2128,7 @@ data WordsByState st fs b

2119

2128

2120{-# INLINE_NORMAL wordsBy #-}

2129{-# INLINE_NORMAL wordsBy #-}

2121wordsBy :: Monad m => (a -> Bool) -> Fold m a b -> Stream m a -> Stream m b

2130wordsBy :: 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) =

2123 Stream stepOuter (WordsByInit state)

2132 Stream stepOuter (WordsByInit state)

2124

2133

2125 where

2134 where

@@ -2149,7 +2158,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

2149 FL.Partial fs1 -> go SPEC s fs1

2158 FL.Partial fs1 -> go SPEC s fs1

2150 FL.Done b -> return $ Yield b (WordsByInit s)

2159 FL.Done b -> return $ Yield b (WordsByInit s)

2151 Skip s -> return $ Skip $ WordsByDo s fs

2160 Skip s -> return $ Skip $ WordsByDo s fs

2152− Stop -> return Stop

2161+ Stop -> final fs >> return Stop

2153

2162

2154 where

2163 where

2155

2164

@@ -2160,7 +2169,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

2160 if predicate x

2169 if predicate x

2161 then do

2170 then do

2162 {-

2171 {-

2163− r <- done acc

2172+ r <- final acc

2164 return $ Yield r (WordsByInit s)

2173 return $ Yield r (WordsByInit s)

2165 -}

2174 -}

2166 -- The above code does not fuse well. Need to check why

2175 -- The above code does not fuse well. Need to check why

@@ -2169,7 +2178,7 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

2169 -- state always, we directly go to WordsByDo state in

2178 -- state always, we directly go to WordsByDo state in

2170 -- the common case of Partial.

2179 -- the common case of Partial.

2171 resi <- initial

2180 resi <- initial

2172− r <- done acc

2181+ r <- final acc

2173 return

2182 return

2174 $ Yield r

2183 $ Yield r

2175 $ case resi of

2184 $ case resi of

@@ -2181,7 +2190,9 @@ wordsBy predicate (Fold fstep initial done) (Stream step state) =

2181 FL.Partial fs1 -> go SPEC s fs1

2190 FL.Partial fs1 -> go SPEC s fs1

2182 FL.Done b -> return $ Yield b (WordsByInit s)

2191 FL.Done b -> return $ Yield b (WordsByInit s)

2183 Skip s -> go SPEC s acc

2192 Skip s -> go SPEC s acc

2193+ Stop -> do

2194+ r <- final acc

2184− Stop -> done acc >>= \r -> return $ Yield r WordsByDone

2195+ return $ Yield r WordsByDone

2185

2196

2186 stepOuter _ WordsByDone = return Stop

2197 stepOuter _ WordsByDone = return Stop

2187

2198

@@ -2239,7 +2250,7 @@ splitOnSeq

2239 -> Fold m a b

2250 -> Fold m a b

2240 -> Stream m a

2251 -> Stream m a

2241 -> Stream m b

2252 -> Stream m b

2242−splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2253+splitOnSeq patArr (Fold fstep initial _ final) (Stream step state) =

2243 Stream stepOuter SplitOnSeqInit

2254 Stream stepOuter SplitOnSeqInit

2244

2255

2245 where

2256 where

@@ -2322,12 +2333,12 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2322 r <- fstep acc x

2333 r <- fstep acc x

2323 b1 <-

2334 b1 <-

2324 case r of

2335 case r of

2325− FL.Partial acc1 -> done acc1

2336+ FL.Partial acc1 -> final acc1

2326 FL.Done b -> return b

2337 FL.Done b -> return b

2327 let jump c = SplitOnSeqEmpty c s

2338 let jump c = SplitOnSeqEmpty c s

2328 in yieldProceed jump b1

2339 in yieldProceed jump b1

2329 Skip s -> skip (SplitOnSeqEmpty acc s)

2340 Skip s -> skip (SplitOnSeqEmpty acc s)

2330− Stop -> return Stop

2341+ Stop -> final acc >> return Stop

2331

2342

2332 -----------------

2343 -----------------

2333 -- Done

2344 -- Done

@@ -2345,7 +2356,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2345 Yield x s -> do

2356 Yield x s -> do

2346 let jump c = SplitOnSeqSingle c s pat

2357 let jump c = SplitOnSeqSingle c s pat

2347 if pat == x

2358 if pat == x

2348− then done fs >>= yieldProceed jump

2359+ then final fs >>= yieldProceed jump

2349 else do

2360 else do

2350 r <- fstep fs x

2361 r <- fstep fs x

2351 case r of

2362 case r of

@@ -2353,7 +2364,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2353 FL.Done b -> yieldProceed jump b

2364 FL.Done b -> yieldProceed jump b

2354 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

2365 Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

2355 Stop -> do

2366 Stop -> do

2356− r <- done fs

2367+ r <- final fs

2357 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

2368 return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

2358

2369

2359 ---------------------------

2370 ---------------------------

@@ -2361,7 +2372,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2361 ---------------------------

2372 ---------------------------

2362

2373

2363 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

2374 stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

2364− r <- done fs

2375+ r <- final fs

2365 skip $ SplitOnSeqYield r SplitOnSeqDone

2376 skip $ SplitOnSeqYield r SplitOnSeqDone

2366 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

2377 stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

2367 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

2378 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

@@ -2388,7 +2399,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2388 if wrd1 .&. wordMask == wordPat

2399 if wrd1 .&. wordMask == wordPat

2389 then do

2400 then do

2390 let jump c = SplitOnSeqWordInit c s

2401 let jump c = SplitOnSeqWordInit c s

2391− done fs >>= yieldProceed jump

2402+ final fs >>= yieldProceed jump

2392 else skip $ SplitOnSeqWordLoop wrd1 s fs

2403 else skip $ SplitOnSeqWordLoop wrd1 s fs

2393 else go SPEC (idx + 1) wrd1 s

2404 else go SPEC (idx + 1) wrd1 s

2394 Skip s -> go SPEC idx wrd s

2405 Skip s -> go SPEC idx wrd s

@@ -2396,7 +2407,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2396 if idx /= 0

2407 if idx /= 0

2397 then skip $ SplitOnSeqWordDone idx fs wrd

2408 then skip $ SplitOnSeqWordDone idx fs wrd

2398 else do

2409 else do

2399− r <- done fs

2410+ r <- final fs

2400 skip $ SplitOnSeqYield r SplitOnSeqDone

2411 skip $ SplitOnSeqYield r SplitOnSeqDone

2401

2412

2402 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

2413 stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

@@ -2417,7 +2428,7 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2417 case r of

2428 case r of

2418 FL.Partial fs1 -> do

2429 FL.Partial fs1 -> do

2419 if wrd1 .&. wordMask == wordPat

2430 if wrd1 .&. wordMask == wordPat

2420− then done fs1 >>= yieldProceed jump

2431+ then final fs1 >>= yieldProceed jump

2421 else go SPEC wrd1 s fs1

2432 else go SPEC wrd1 s fs1

2422 FL.Done b -> yieldProceed jump b

2433 FL.Done b -> yieldProceed jump b

2423 Skip s -> go SPEC wrd s fs

2434 Skip s -> go SPEC wrd s fs

@@ -2502,14 +2513,14 @@ splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

2502 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

2513 stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

2503 if RB.unsafeEqArray rb rh patArr

2514 if RB.unsafeEqArray rb rh patArr

2504 then do

2515 then do

2505− r <- done fs

2516+ r <- final fs

2506 let rst = RB.startOf rb

2517 let rst = RB.startOf rb

2507 jump c = SplitOnSeqKRInit 0 c st rb rst

2518 jump c = SplitOnSeqKRInit 0 c st rb rst

2508 yieldProceed jump r

2519 yieldProceed jump r

2509 else skip $ SplitOnSeqKRLoop fs st rb rh patHash

2520 else skip $ SplitOnSeqKRLoop fs st rb rh patHash

2510

2521

2511 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

2522 stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

2512− r <- done fs

2523+ r <- final fs

2513 skip $ SplitOnSeqYield r SplitOnSeqDone

2524 skip $ SplitOnSeqYield r SplitOnSeqDone

2514 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

2525 stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

2515 old <- liftIO $ peek rh

2526 old <- liftIO $ peek rh

@@ -2553,7 +2564,7 @@ splitOnSuffixSeq

2553 -> Fold m a b

2564 -> Fold m a b

2554 -> Stream m a

2565 -> Stream m a

2555 -> Stream m b

2566 -> 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) =

2557 Stream stepOuter SplitOnSuffixSeqInit

2568 Stream stepOuter SplitOnSuffixSeqInit

2558

2569

2559 where

2570 where

@@ -2593,7 +2604,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2593 r <- if withSep then fstep fs x else return $ FL.Partial fs

2604 r <- if withSep then fstep fs x else return $ FL.Partial fs

2594 b1 <-

2605 b1 <-

2595 case r of

2606 case r of

2596− FL.Partial fs1 -> done fs1

2607+ FL.Partial fs1 -> final fs1

2597 FL.Done b -> return b

2608 FL.Done b -> return b

2598 yieldProceed jump b1

2609 yieldProceed jump b1

2599 else do

2610 else do

@@ -2656,11 +2667,11 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2656 r <- fstep acc x

2667 r <- fstep acc x

2657 b1 <-

2668 b1 <-

2658 case r of

2669 case r of

2659− FL.Partial fs -> done fs

2670+ FL.Partial fs -> final fs

2660 FL.Done b -> return b

2671 FL.Done b -> return b

2661 yieldProceed jump b1

2672 yieldProceed jump b1

2662 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)

2673 Skip s -> skip (SplitOnSuffixSeqEmpty acc s)

2663− Stop -> return Stop

2674+ Stop -> final acc >> return Stop

2664

2675

2665 -----------------

2676 -----------------

2666 -- Done

2677 -- Done

@@ -2677,7 +2688,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2677 case res of

2688 case res of

2678 Yield x s -> processYieldSingle pat x s fs

2689 Yield x s -> processYieldSingle pat x s fs

2679 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat

2690 Skip s -> skip $ SplitOnSuffixSeqSingleInit fs s pat

2680− Stop -> return Stop

2691+ Stop -> final fs >> return Stop

2681

2692

2682 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

2693 stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

2683 res <- step (adaptState gst) st

2694 res <- step (adaptState gst) st

@@ -2685,7 +2696,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2685 Yield x s -> processYieldSingle pat x s fs

2696 Yield x s -> processYieldSingle pat x s fs

2686 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat

2697 Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat

2687 Stop -> do

2698 Stop -> do

2688− r <- done fs

2699+ r <- final fs

2689 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2700 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2690

2701

2691 ---------------------------

2702 ---------------------------

@@ -2693,7 +2704,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2693 ---------------------------

2704 ---------------------------

2694

2705

2695 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do

2706 stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do

2696− r <- done fs

2707+ r <- final fs

2697 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2708 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2698 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do

2709 stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do

2699 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

2710 let old = elemMask .&. (wrd `shiftR` (elemBits * (n - 1)))

@@ -2716,7 +2727,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2716 let jump c = SplitOnSuffixSeqWordInit c s

2727 let jump c = SplitOnSuffixSeqWordInit c s

2717 yieldProceed jump b

2728 yieldProceed jump b

2718 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)

2729 Skip s -> skip (SplitOnSuffixSeqWordInit fs0 s)

2719− Stop -> return Stop

2730+ Stop -> final fs0 >> return Stop

2720

2731

2721 where

2732 where

2722

2733

@@ -2734,7 +2745,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2734 then go SPEC (idx + 1) wrd1 s fs1

2745 then go SPEC (idx + 1) wrd1 s fs1

2735 else if wrd1 .&. wordMask /= wordPat

2746 else if wrd1 .&. wordMask /= wordPat

2736 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

2747 then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

2737− else do done fs >>= yieldProceed jump

2748+ else do final fs >>= yieldProceed jump

2738 FL.Done b -> yieldProceed jump b

2749 FL.Done b -> yieldProceed jump b

2739 Skip s -> go SPEC idx wrd s fs

2750 Skip s -> go SPEC idx wrd s fs

2740 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

2751 Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

@@ -2760,16 +2771,16 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2760 case r of

2771 case r of

2761 FL.Partial fs1 ->

2772 FL.Partial fs1 ->

2762 if wrd1 .&. wordMask == wordPat

2773 if wrd1 .&. wordMask == wordPat

2763− then done fs1 >>= yieldProceed jump

2774+ then final fs1 >>= yieldProceed jump

2764 else go SPEC wrd1 s fs1

2775 else go SPEC wrd1 s fs1

2765 FL.Done b -> yieldProceed jump b

2776 FL.Done b -> yieldProceed jump b

2766 Skip s -> go SPEC wrd s fs

2777 Skip s -> go SPEC wrd s fs

2767 Stop ->

2778 Stop ->

2768 if wrd .&. wordMask == wordPat

2779 if wrd .&. wordMask == wordPat

2769− then return Stop

2780+ then final fs >> return Stop

2770 else if withSep

2781 else if withSep

2771 then do

2782 then do

2772− r <- done fs

2783+ r <- final fs

2773 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2784 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2774 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd

2785 else skip $ SplitOnSuffixSeqWordDone patLen fs wrd

2775

2786

@@ -2791,7 +2802,7 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2791 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

2802 jump c = SplitOnSuffixSeqKRInit 0 c s rb rst

2792 yieldProceed jump b

2803 yieldProceed jump b

2793 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0

2804 Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 fs s rb rh0

2794− Stop -> return Stop

2805+ Stop -> final fs >> return Stop

2795

2806

2796 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

2807 stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

2797 go SPEC 1 rh0 st0 fs0

2808 go SPEC 1 rh0 st0 fs0

@@ -2823,10 +2834,10 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2823 Stop -> do

2834 Stop -> do

2824 -- do not issue a blank segment when we end at pattern

2835 -- do not issue a blank segment when we end at pattern

2825 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2836 if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2826− then return Stop

2837+ then final fs >> return Stop

2827 else if withSep

2838 else if withSep

2828 then do

2839 then do

2829− r <- done fs

2840+ r <- final fs

2830 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2841 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2831 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)

2842 else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)

2832

2843

@@ -2855,24 +2866,24 @@ splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

2855 Skip s -> go SPEC fs s rh cksum

2866 Skip s -> go SPEC fs s rh cksum

2856 Stop ->

2867 Stop ->

2857 if RB.unsafeEqArray rb rh patArr

2868 if RB.unsafeEqArray rb rh patArr

2858− then return Stop

2869+ then final fs >> return Stop

2859 else if withSep

2870 else if withSep

2860 then do

2871 then do

2861− r <- done fs

2872+ r <- final fs

2862 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2873 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2863 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh

2874 else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh

2864

2875

2865 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do

2876 stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do

2866 if RB.unsafeEqArray rb rh patArr

2877 if RB.unsafeEqArray rb rh patArr

2867 then do

2878 then do

2868− r <- done fs

2879+ r <- final fs

2869 let rst = RB.startOf rb

2880 let rst = RB.startOf rb

2870 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst

2881 jump c = SplitOnSuffixSeqKRInit 0 c st rb rst

2871 yieldProceed jump r

2882 yieldProceed jump r

2872 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

2883 else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

2873

2884

2874 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

2885 stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

2875− r <- done fs

2886+ r <- final fs

2876 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2887 skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2877 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do

2888 stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do

2878 old <- liftIO $ peek rh

2889 old <- liftIO $ peek rh

core/src/Streamly/Internal/Data/Stream/Transform.hs+8−8

@@ -300,7 +300,7 @@ data TapState fs st a

300--

301{-# INLINE tap #-}

302tap :: 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

304

305 where

306

@@ -323,7 +323,7 @@ tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

323 FL.Done _ -> TapDone s

324 Skip s -> return $ Skip (Tapping acc s)

325 Stop -> do

326− void $ extract acc

326+ void $ final acc

327 return Stop

328 step' gst (TapDone st) = do

329 r <- step gst st

@@ -342,7 +342,7 @@ data TapOffState fs s a

342{-# INLINE_NORMAL tapOffsetEvery #-}

343tapOffsetEvery :: Monad m

344 => 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) =

346 Stream step' TapOffInit

347

348 where

@@ -372,7 +372,7 @@ tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

372 return $ Yield x next

373 Skip s -> return $ Skip (TapOffTapping acc s count)

374 Stop -> do

375− void $ extract acc

375+ void $ final acc

376 return Stop

377 step' gst (TapOffDone st) = do

378 r <- step gst st

@@ -437,7 +437,7 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone

437--

438{-# INLINE_NORMAL postscan #-}

439postscan :: 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) =

441 Stream step (ScanInit state)

442

443 where

@@ -460,13 +460,13 @@ postscan (FL.Fold fstep initial extract) (Stream sstep state) =

460 return $ Yield b $ ScanDo s fs1

461 FL.Done b -> return $ Yield b ScanDone

462 Skip s -> return $ Skip $ ScanDo s fs

463− Stop -> return Stop

463+ Stop -> final fs >> return Stop

464 step _ ScanDone = return Stop

465

466{-# INLINE scanWith #-}

467scanWith :: Monad m

468 => 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) =

470 Stream step (ScanInit state)

471

472 where

@@ -489,7 +489,7 @@ scanWith restart (Fold fstep initial extract) (Stream sstep state) =

489 case res of

490 Yield x s -> runStep s (fstep fs x)

491 Skip s -> return $ Skip $ ScanDo s fs

492− Stop -> return Stop

492+ Stop -> final fs >> return Stop

493 step _ ScanDone = return Stop

494

495-- 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

398{-# INLINE_NORMAL foldEither #-}

399foldEither :: Monad m =>

400 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

402 res <- begin

403 case res of

404 FL.Partial fs -> go SPEC fs state

@@ -416,7 +416,9 @@ foldEither (Fold fstep begin done) (UnStream step state) = do

416 FL.Done b -> return $! Right (b, Stream step s)

417 FL.Partial fs1 -> go SPEC fs1 s

418 Skip s -> go SPEC fs s

419+ Stop ->

419− Stop -> return $! Left (Fold fstep (return $ FL.Partial fs) done)

420+ let f = Fold fstep (return $ FL.Partial fs) done final

421+ in return $! Left f

420

422

421-- | Like 'fold' but also returns the remaining stream. The resulting stream

423-- | Like 'fold' but also returns the remaining stream. The resulting stream

422-- would be 'Stream.nil' if the stream finished before the fold.

424-- would be 'Stream.nil' if the stream finished before the fold.

@@ -427,12 +429,12 @@ foldBreak fld strm = do

427 r <- foldEither fld strm

429 r <- foldEither fld strm

428 case r of

430 case r of

429 Right res -> return res

431 Right res -> return res

430− Left (Fold _ initial extract) -> do

432+ Left (Fold _ initial _ final) -> do

431 res <- initial

433 res <- initial

432 case res of

434 case res of

433 FL.Done _ -> error "foldBreak: unreachable state"

435 FL.Done _ -> error "foldBreak: unreachable state"

434 FL.Partial s -> do

436 FL.Partial s -> do

435− b <- extract s

437+ b <- final s

436 return (b, nil)

438 return (b, nil)

437

439

438 where

440 where

@@ -475,8 +477,8 @@ fold fld strm = do

475--

477--

476{-# INLINE_NORMAL foldAddLazy #-}

478{-# INLINE_NORMAL foldAddLazy #-}

477foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b

479foldAddLazy :: Monad m => Fold m a b -> Stream m a -> Fold m a b

478−foldAddLazy (Fold fstep finitial fextract) (Stream sstep state) =

480+foldAddLazy (Fold fstep finitial fextract ffinal) (Stream sstep state) =

479− Fold fstep initial fextract

481+ Fold fstep initial fextract ffinal

480

482

481 where

483 where

482

484

@@ -1796,7 +1798,7 @@ data FoldManyPost s fs b a

1796--

1798--

1797{-# INLINE_NORMAL foldManyPost #-}

1799{-# INLINE_NORMAL foldManyPost #-}

1798foldManyPost :: Monad m => Fold m a b -> Stream m a -> Stream m b

1800foldManyPost :: 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) =

1800 Stream step' (FoldManyPostStart state)

1802 Stream step' (FoldManyPostStart state)

1801

1803

1802 where

1804 where

@@ -1824,7 +1826,7 @@ foldManyPost (Fold fstep initial extract) (Stream step state) =

1824 Yield x s -> consume x s fs

1826 Yield x s -> consume x s fs

1825 Skip s -> return $ Skip (FoldManyPostLoop s fs)

1827 Skip s -> return $ Skip (FoldManyPostLoop s fs)

1826 Stop -> do

1828 Stop -> do

1827− b <- extract fs

1829+ b <- final fs

1828 return $ Skip (FoldManyPostYield b FoldManyPostDone)

1830 return $ Skip (FoldManyPostYield b FoldManyPostDone)

1829 step' _ (FoldManyPostYield b next) = return $ Yield b next

1831 step' _ (FoldManyPostYield b next) = return $ Yield b next

1830 step' _ FoldManyPostDone = return Stop

1832 step' _ FoldManyPostDone = return Stop

@@ -1868,7 +1870,7 @@ data FoldMany s fs b a

1868--

1870--

1869{-# INLINE_NORMAL foldMany #-}

1871{-# INLINE_NORMAL foldMany #-}

1870foldMany :: Monad m => Fold m a b -> Stream m a -> Stream m b

1872foldMany :: 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) =

1872 Stream step' (FoldManyStart state)

1874 Stream step' (FoldManyStart state)

1873

1875

1874 where

1876 where

@@ -1895,14 +1897,14 @@ foldMany (Fold fstep initial extract) (Stream step state) =

1895 case r of

1897 case r of

1896 Yield x s -> consume x s fs

1898 Yield x s -> consume x s fs

1897 Skip s -> return $ Skip (FoldManyFirst fs s)

1899 Skip s -> return $ Skip (FoldManyFirst fs s)

1898− Stop -> return Stop

1900+ Stop -> final fs >> return Stop

1899 step' gst (FoldManyLoop st fs) = do

1901 step' gst (FoldManyLoop st fs) = do

1900 r <- step (adaptState gst) st

1902 r <- step (adaptState gst) st

1901 case r of

1903 case r of

1902 Yield x s -> consume x s fs

1904 Yield x s -> consume x s fs

1903 Skip s -> return $ Skip (FoldManyLoop s fs)

1905 Skip s -> return $ Skip (FoldManyLoop s fs)

1904 Stop -> do

1906 Stop -> do

1905− b <- extract fs

1907+ b <- final fs

1906 return $ Skip (FoldManyYield b FoldManyDone)

1908 return $ Skip (FoldManyYield b FoldManyDone)

1907 step' _ (FoldManyYield b next) = return $ Yield b next

1909 step' _ (FoldManyYield b next) = return $ Yield b next

1908 step' _ FoldManyDone = return Stop

1910 step' _ FoldManyDone = return Stop

core/src/Streamly/Internal/Data/StreamK.hs+14−11

@@ -336,7 +336,7 @@ foldlMx' step begin done = go begin

336--

337{-# INLINABLE fold #-}

338fold :: 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

340 res <- begin

341 case res of

342 FL.Partial fs -> go fs m

@@ -344,10 +344,10 @@ fold (FL.Fold step begin done) m = do

344

345 where

346 go !acc m1 =

347− let stop = done acc

347+ let stop = final acc

348 single a = step acc a

349 >>= \case

350− FL.Partial s -> done s

350+ FL.Partial s -> final s

351 FL.Done b1 -> return b1

352 yieldk a r = step acc a

353 >>= \case

@@ -365,7 +365,7 @@ fold (FL.Fold step begin done) m = do

365{-# INLINE foldEither #-}

366foldEither :: Monad m =>

367 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

369 res <- begin

370 case res of

371 FL.Partial fs -> go fs m

@@ -374,12 +374,15 @@ foldEither (FL.Fold step begin done) m = do

374 where

375

376 go !acc m1 =

377+ let stop =

377− let stop = return $ Left (Fold step (return $ FL.Partial acc) done)

378+ let f = Fold step (return $ FL.Partial acc) done final

379+ in return $ Left f

378 single a =

380 single a =

379 step acc a

381 step acc a

380 >>= \case

382 >>= \case

381 FL.Partial s ->

383 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

383 FL.Done b1 -> return $ Right (b1, nil)

386 FL.Done b1 -> return $ Right (b1, nil)

384 yieldk a r =

387 yieldk a r =

385 step acc a

388 step acc a

@@ -397,12 +400,12 @@ foldBreak fld strm = do

397 r <- foldEither fld strm

400 r <- foldEither fld strm

398 case r of

401 case r of

399 Right res -> return res

402 Right res -> return res

400− Left (Fold _ initial extract) -> do

403+ Left (Fold _ initial _ final) -> do

401 res <- initial

404 res <- initial

402 case res of

405 case res of

403 FL.Done _ -> error "foldBreak: unreachable state"

406 FL.Done _ -> error "foldBreak: unreachable state"

404 FL.Partial s -> do

407 FL.Partial s -> do

405− b <- extract s

408+ b <- final s

406 return (b, nil)

409 return (b, nil)

407

410

408-- XXX Array folds can be implemented using this.

411-- XXX Array folds can be implemented using this.

@@ -421,7 +424,7 @@ foldConcat :: Monad m =>

421 Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)

424 Producer m a b -> Fold m b c -> StreamK m a -> m (c, StreamK m a)

422foldConcat

425foldConcat

423 (Producer pstep pinject pextract)

426 (Producer pstep pinject pextract)

424− (Fold fstep begin done)

427+ (Fold fstep begin _ final)

425 stream = do

428 stream = do

426

429

427 res <- begin

430 res <- begin

@@ -433,14 +436,14 @@ foldConcat

433

436

434 go !acc m1 = do

437 go !acc m1 = do

435 let stop = do

438 let stop = do

436− r <- done acc

439+ r <- final acc

437 return (r, nil)

440 return (r, nil)

438 single a = do

441 single a = do

439 st <- pinject a

442 st <- pinject a

440 res <- go1 SPEC acc st

443 res <- go1 SPEC acc st

441 case res of

444 case res of

442 Left fs -> do

445 Left fs -> do

443− r <- done fs

446+ r <- final fs

444 return (r, nil)

447 return (r, nil)

445 Right (b, s) -> do

448 Right (b, s) -> do

446 x <- pextract s

449 x <- pextract s

core/src/Streamly/Internal/Data/Unfold.hs+9−9

@@ -205,7 +205,7 @@ swap = lmap Tuple.swap

205--

206{-# INLINE_NORMAL fold #-}

207fold :: 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

209 res <- initial

210 case res of

211 FL.Partial x -> inject a >>= go SPEC x

@@ -223,7 +223,7 @@ fold (Fold fstep initial extract) (Unfold ustep inject) a = do

223 FL.Partial fs1 -> go SPEC fs1 s

224 FL.Done c -> return c

225 Skip s -> go SPEC fs s

226− Stop -> extract fs

226+ Stop -> final fs

227

228-- {-# ANN type FoldMany Fuse #-}

229data FoldMany s fs b a

@@ -238,7 +238,7 @@ data FoldMany s fs b a

238-- /Pre-release/

239{-# INLINE_NORMAL foldMany #-}

240foldMany :: 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) =

242 Unfold step inject

243

244 where

@@ -269,14 +269,14 @@ foldMany (Fold fstep initial extract) (Unfold ustep inject1) =

269 case r of

270 Yield x s -> consume x s fs

271 Skip s -> return $ Skip (FoldManyFirst fs s)

272− Stop -> return Stop

272+ Stop -> final fs >> return Stop

273 step (FoldManyLoop st fs) = do

274 r <- ustep st

275 case r of

276 Yield x s -> consume x s fs

277 Skip s -> return $ Skip (FoldManyLoop s fs)

278 Stop -> do

279− b <- extract fs

279+ b <- final fs

280 return $ Skip (FoldManyYield b FoldManyDone)

281 step (FoldManyYield b next) = return $ Yield b next

282 step FoldManyDone = return Stop

@@ -317,7 +317,7 @@ either (Unfold stepL injectL) (Unfold stepR injectR) = Unfold step inject

317-- /Pre-release/

318{-# INLINE_NORMAL postscan #-}

319postscan :: 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) =

321 Unfold step inject

322

323 where

@@ -340,7 +340,7 @@ postscan (Fold stepF initial extract) (Unfold stepU injectU) =

340 v <- extract fs1

341 return $ Yield v (Just (fs1, s))

342 Skip s -> return $ Skip (Just (fs, s))

343− Stop -> return Stop

343+ Stop -> final fs >> return Stop

344

345 step Nothing = return Stop

346

@@ -348,7 +348,7 @@ data ScanState s f = ScanInit s | ScanDo s !f | ScanDone

348

349{-# INLINE_NORMAL scanWith #-}

350scanWith :: 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) =

352 Unfold step inject

353

354 where

@@ -373,7 +373,7 @@ scanWith restart (Fold fstep initial extract) (Unfold stepU injectU) =

373 case res of

374 Yield x s -> runStep s (fstep fs x)

375 Skip s -> return $ Skip $ ScanDo s fs

376− Stop -> return Stop

376+ Stop -> final fs >> return Stop

377 step ScanDone = return Stop

378

379-- | 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

438{-# INLINE writeChunks #-}

439writeChunks :: (MonadIO m, MonadCatch m)

440 => FilePath -> Fold m (Array a) ()

441−writeChunks path = Fold step initial extract

441+writeChunks path = Fold step initial extract final

442 where

443 initial = do

444 h <- liftIO (openFile path WriteMode)

@@ -448,12 +448,15 @@ writeChunks path = Fold step initial extract

448 step (fld, h) x = do

449 r <- FL.snoc fld x `MC.onException` liftIO (hClose h)

450 return $ FL.Partial (r, h)

451+

452+ extract _ = return ()

453+

451− extract (Fold _ initial1 extract1, h) = do

454+ final (Fold _ initial1 _ final1, h) = do

452 liftIO $ hClose h

455 liftIO $ hClose h

453 res <- initial1

456 res <- initial1

454 case res of

457 case res of

455− FL.Partial fs -> extract1 fs

458+ FL.Partial fs -> final1 fs

456− FL.Done fb -> return fb

459+ FL.Done () -> return ()

457

460

458-- | @writeWith chunkSize handle@ writes the input stream to @handle@.

461-- | @writeWith chunkSize handle@ writes the input stream to @handle@.

459-- Bytes in the input stream are collected into a buffer until we have a chunk

462-- 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)

111import Streamly.Internal.Data.Array.Type (Array(..))

112import Streamly.Internal.Data.MutArray.Type (MutableByteArray)

113import Streamly.Internal.Data.Fold (Fold)

114+import Streamly.Internal.Data.Parser (Parser)

114import Streamly.Internal.Data.Stream (Stream)

115import Streamly.Internal.Data.Stream (Stream)

115import Streamly.Internal.Data.Stream (Step (..))

116import Streamly.Internal.Data.Stream (Step (..))

116import Streamly.Internal.Data.SVar.Type (adaptState)

117import Streamly.Internal.Data.SVar.Type (adaptState)

@@ -523,8 +524,8 @@ parseCharUtf8WithD cfm = ParserD.Parser (step' utf8d) initial extract

523-- workflow requires backtracking 1 element. This can be revisited once "Fold"

524-- workflow requires backtracking 1 element. This can be revisited once "Fold"

524-- supports backtracking.

525-- supports backtracking.

525{-# INLINE writeCharUtf8' #-}

526{-# INLINE writeCharUtf8' #-}

526−writeCharUtf8' :: Monad m => Fold m Word8 Char

527+writeCharUtf8' :: Monad m => Parser Word8 m Char

527−writeCharUtf8' = ParserD.toFold (parseCharUtf8WithD ErrorOnCodingFailure)

528+writeCharUtf8' = parseCharUtf8WithD ErrorOnCodingFailure

528

529

529-- XXX The initial idea was to have "parseCharUtf8" and offload the error

530-- XXX The initial idea was to have "parseCharUtf8" and offload the error

530-- handling to another parser. So, say we had "parseCharUtf8'",

531-- 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'(..))

63--

64{-# INLINE takeInterval #-}

65takeInterval :: 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'

68 where

69 where

@@ -90,7 +91,7 @@ takeInterval n (Fold step initial done) = Fold step' initial' done'

90 then do

91 then do

91 res <- step s a

92 res <- step s a

92 case res of

93 case res of

93− Partial sres -> Done <$> done sres

94+ Partial sres -> Done <$> final sres

94 Done bres -> return $ Done bres

95 Done bres -> return $ Done bres

95 else do

96 else do

96 res <- step s a

97 res <- step s a

@@ -100,6 +101,8 @@ takeInterval n (Fold step initial done) = Fold step' initial' done'

100

101

101 done' (Tuple3' s _ _) = done s

102 done' (Tuple3' s _ _) = done s

102

103

104+ final' (Tuple3' s _ _) = final s

105+

103 timerThread mv = do

106 timerThread mv = do

104 liftIO $ threadDelay (round $ n * 1000000)

107 liftIO $ threadDelay (round $ n * 1000000)

105 -- Use IORef + CAS? instead of MVar since its a Bool?

108 -- 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

43-- | Evaluate a fold asynchronously using a concurrent channel. The driver just

44-- 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.

46--

47--

47{-# INLINABLE parEval #-}

48{-# INLINABLE parEval #-}

48parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b

49parEval :: MonadAsync m => (Config -> Config) -> Fold m a b -> Fold m a b

49parEval modifier f =

50parEval modifier f =

50− Fold step initial extract

51+ Fold step initial extract final

52 where

53 where

@@ -62,13 +63,33 @@ parEval modifier f =

62 --

63 --

63 -- A polled stream abstraction may be useful, it would consist of normal

64 -- A polled stream abstraction may be useful, it would consist of normal

64 -- events and tick events, latter are guaranteed to arrive.

65 -- 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.

65 step chan a = do

76 step chan a = do

66 status <- sendToWorker chan a

77 status <- sendToWorker chan a

67 return $ case status of

78 return $ case status of

68 Nothing -> Partial chan

79 Nothing -> Partial chan

69 Just b -> Done b

80 Just b -> Done b

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.

71− extract chan = do

92+ final chan = do

72 liftIO $ void

93 liftIO $ void

73 $ sendWithDoorBell

94 $ sendWithDoorBell

74 (outputQueue chan)

95 (outputQueue chan)

@@ -84,7 +105,7 @@ parEval modifier f =

84 "parEval: waiting to drain"

105 "parEval: waiting to drain"

85 $ takeMVar (outputDoorBellFromConsumer chan)

106 $ takeMVar (outputDoorBellFromConsumer chan)

86 -- XXX remove recursion

107 -- XXX remove recursion

87− extract chan

108+ final chan

88 Just b -> do

109 Just b -> do

89 when (svarInspectMode chan) $ liftIO $ do

110 when (svarInspectMode chan) $ liftIO $ do

90 t <- getTime Monotonic

111 t <- getTime Monotonic

src/Streamly/Internal/Data/Fold/SVar.hs+5−5

@@ -33,7 +33,7 @@ import Streamly.Internal.Data.SVar

33--

34{-# INLINE write #-}

35write :: 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

38 where

@@ -47,14 +47,14 @@ write svar winfo = Fold step initial extract

47 void $ send svar (ChildYield x)

48 return $ FL.Partial ()

50− extract () = liftIO $ sendStop svar winfo

50+ final () = liftIO $ sendStop svar winfo

52-- | Like write, but applies a yield limit.

53--

54{-# INLINE writeLimited #-}

55writeLimited :: MonadIO m

56 => 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

59 where

@@ -74,5 +74,5 @@ writeLimited svar winfo = Fold step initial extract

74 return $ FL.Done ()

75 step False _ = return $ FL.Done ()

77− extract True = liftIO $ sendStop svar winfo

77+ final True = liftIO $ sendStop svar winfo

78− extract False = return ()

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

34 mapDelete = HashMap.delete

35 mapUnion = HashMap.union

36 mapNull = HashMap.null

37+ mapTraverseWithKey = HashMap.traverseWithKey

src/Streamly/Internal/Data/Stream/IsStream/Reduce.hs+2−2

@@ -1321,10 +1321,10 @@ classifySessionsByGeneric

1321 -> t m (AbsTime, (Key f, a)) -- ^ timestamp, (session key, session data)

1322 -> t m (Key f, b) -- ^ session key, fold result

1323classifySessionsByGeneric _ tick reset ejectPred tmout

1324− (Fold step initial extract) input =

1324+ (Fold step initial extract final) input =

1325 Expand.unfoldMany

1326 (Unfold.lmap (toStreamK . sessionOutputStream) Unfold.fromStreamK)

1327− $ scanlMAfter' sstep (return szero) (flush extract)

1327+ $ scanlMAfter' sstep (return szero) (flush final)

1328 $ interjectSuffix tick (return Nothing)

1329 $ map Just input

1330

src/Streamly/Internal/Data/Stream/Time.hs+2−2

@@ -536,9 +536,9 @@ classifySessionsByGeneric

536 -- data)

537 -> Stream m (Key f, b) -- ^ session key, fold result

538classifySessionsByGeneric _ tick reset ejectPred tmout

539− (Fold step initial extract) input =

539+ (Fold step initial extract final) input =

540 Stream.unfoldMany (Unfold.lmap sessionOutputStream Unfold.fromStream)

541− $ Stream.scanlMAfter' sstep (return szero) (flush extract)

541+ $ Stream.scanlMAfter' sstep (return szero) (flush final)

542 $ interject (return Nothing) tick

543 $ fmap Just input

544

src/Streamly/Internal/Network/Inet/TCP.hs+7−4

@@ -358,7 +358,7 @@ writeChunks

358 => (Word8, Word8, Word8, Word8)

359 -> PortNumber

360 -> Fold m (Array Word8) ()

361−writeChunks addr port = Fold step initial extract

361+writeChunks addr port = Fold step initial extract final

362 where

363 initial = do

364 skt <- liftIO (connect addr port)

@@ -368,12 +368,15 @@ writeChunks addr port = Fold step initial extract

368 step (Tuple' fld skt) x = do

369 r <- FL.addOne x fld `MC.onException` liftIO (Net.close skt)

370 return $ FL.Partial (Tuple' r skt)

371+

372+ extract _ = return ()

373+

371− extract (Tuple' (Fold _ initial1 extract1) skt) = do

374+ final (Tuple' (Fold _ initial1 _ final1) skt) = do

372 liftIO $ Net.close skt

375 liftIO $ Net.close skt

373 res <- initial1

376 res <- initial1

374 case res of

377 case res of

375− FL.Partial fs -> extract1 fs

378+ FL.Partial fs -> final1 fs

376− FL.Done fb -> return fb

379+ FL.Done () -> return ()

377

380

378-- | Like 'write' but provides control over the write buffer. Output will

381-- | Like 'write' but provides control over the write buffer. Output will

379-- be written to the IO device as soon as we collect the specified number of

382-- 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

719many =

720 forAll (listOf (chooseInt (0, 1))) $ \ls ->

721 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

723 prsr =

724 flip P.many concatFold

725 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

@@ -740,7 +740,7 @@ some =

740 let

741 ls = 0 : genLs

742 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

744 prsr =

745 flip P.some concatFold

746 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

test/Streamly/Test/Data/ParserK.hs+2−2

@@ -532,7 +532,7 @@ many =

532 $ \ls ->

533 let fldstp conL currL = return $ FL.Partial (conL ++ currL)

534 concatFold =

535− FL.Fold fldstp (return (FL.Partial [])) return

535+ FL.Fold fldstp (return (FL.Partial [])) return return

536 prsr =

537 flip P.many concatFold

538 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList

@@ -552,7 +552,7 @@ some =

552 forAll (listOf (chooseInt (0, 1)))

553 $ \ls ->

554 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

556 prsr =

557 flip P.some concatFold

558 $ P.fromFold $ FL.takeEndBy_ (== 1) FL.toList