e7ebd59 · streamly · git.iko.soy

git.iko.soy/streamly

Refactor and cleanup IsStream and StreamD

This commit has no functionality changes whatsoever. It is a pure reorganization of existing code. Not a single line in any function should have changed. * Push down all functions from IsStream.hs to a common module below * Each submodule is now complete in itself i.e. exports all functions that belong to that module. * A few functions had to be moved around to classify them in the right modules. Each submodule has a crisp definition. * Further break down "Transform" module to create Nesting/Lift modules under IsStream * Create "Lift" module under StreamD as well, both IsStream and StreamD have the same structure now. * Rearrange exports to properly organize them in clearly defined categories. * Rearrange functions to reflect the export order or to bring them close to other similar functions.

commite7ebd59080cad6bf6a35137543de0c2e1e432ba9 authorHarendra Kumar <harendra@composewell.com> dateThu 7 Jan 2021, 01:52 (6 years ago) parentd216358

18 files changed+7714−7130

compare with master

unifiedsplit

.hlint.ignore+1

@@ -15,6 +15,7 @@ src/Streamly/Internal/Data/Stream/StreamD/Generate.hs

1515src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs

1616src/Streamly/Internal/Data/Stream/StreamD/Transform.hs

1717src/Streamly/Internal/Data/Stream/StreamD/Exception.hs

18+src/Streamly/Internal/Data/Stream/StreamD/Lift.hs

1819src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs

1920src/Streamly/Internal/Data/Pipe/Types.hs

2021src/Streamly/Internal/Data/SmallArray/Types.hs

src/Streamly/Internal/Data/Stream/IsStream.hs+8−959

@@ -598,17 +598,6 @@ module Streamly.Internal.Data.Stream.IsStream

598598 )

599599where

600600

601−import Control.Concurrent (threadDelay)

602−import Control.Exception (assert)

603−import Control.Monad.IO.Class (MonadIO(..))

604−import Data.Kind (Type)

605−import Data.Heap (Entry(..))

606−import Data.Maybe (isNothing)

607−import Foreign.Storable (Storable)

608−import Streamly.Internal.Data.Stream.Enumeration

609− (Enumerable(..), enumerate, enumerateTo)

610−import Streamly.Internal.Data.Fold.Types (Fold (..))

611−import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array)

612601import Streamly.Internal.Data.SVar (MonadAsync, Rate (..))

613602import Streamly.Internal.Data.Stream.Ahead (AheadT, Ahead, aheadly)

614603import Streamly.Internal.Data.Stream.Async

@@ -619,38 +608,26 @@ import Streamly.Internal.Data.Stream.Combinators

619608 , maxRate, constRate)

620609import Streamly.Internal.Data.Stream.Parallel

621610 ( ParallelT, Parallel, parallely)

622−import Streamly.Internal.Data.Stream.Prelude (toStreamS)

623−import Streamly.Internal.Data.Stream.StreamK (IsStream((|:), consM), adapt)

611+import Streamly.Internal.Data.Stream.StreamK (IsStream(), adapt)

624612import Streamly.Internal.Data.Stream.Serial

625613 ( SerialT, WSerialT, Serial, WSerial, serially

626614 , wSerially)

627615import Streamly.Internal.Data.Stream.Zip

628616 ( ZipSerialM, ZipSerial, ZipAsyncM, ZipAsync, zipSerially, zipAsyncly)

629−import Streamly.Internal.Data.Time.Units

630− ( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime

631− , toAbsTime, RelTime64)

632−import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

633617

634−import Streamly.Internal.Data.Stream.IsStream.Generate

635−import Streamly.Internal.Data.Stream.IsStream.Eliminate

636−import Streamly.Internal.Data.Stream.IsStream.Transform

637−import Streamly.Internal.Data.Stream.IsStream.Exception

638−

639−import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

640−import qualified Streamly.Internal.Data.Fold as FL

641618import qualified Streamly.Internal.Data.Stream.Prelude as P

642619import qualified Streamly.Internal.Data.Stream.StreamK as K

643620import qualified Streamly.Internal.Data.Stream.StreamD as D

644621import qualified Streamly.Internal.Data.Stream.Serial as Serial

645622import qualified Streamly.Internal.Data.Stream.Parallel as Par

646623import qualified Streamly.Internal.Data.Stream.Zip as Z

647−import qualified Data.Heap as H

648−import qualified Data.Map.Strict as Map

649−#ifdef USE_STREAMK_ONLY

650−import qualified Streamly.Internal.Data.Stream.StreamK as S

651−#else

652−import qualified Streamly.Internal.Data.Stream.StreamD as S

653−#endif

624+

625+import Streamly.Internal.Data.Stream.IsStream.Generate

626+import Streamly.Internal.Data.Stream.IsStream.Eliminate

627+import Streamly.Internal.Data.Stream.IsStream.Transform

628+import Streamly.Internal.Data.Stream.IsStream.Nesting

629+import Streamly.Internal.Data.Stream.IsStream.Exception

630+import Streamly.Internal.Data.Stream.IsStream.Lift

654631

655632import Prelude hiding

656633 ( filter, drop, dropWhile, take, takeWhile, zipWith, foldr

@@ -659,931 +636,3 @@ import Prelude hiding

659636 , reverse, iterate, init, and, or, lookup, foldr1, (!!)

660637 , scanl, scanl1, replicate, concatMap, span, splitAt, break

661638 , repeat, concat, mconcat)

662−

663−------------------------------------------------------------------------------

664−-- Conversions

665−------------------------------------------------------------------------------

666−

667−-- | Takes a callback setter function and provides it with a callback. The

668−-- callback when invoked adds a value at the tail of the stream. Returns a

669−-- stream of values generated by the callback.

670−--

671−-- /Internal/

672−--

673−{-# INLINE fromCallback #-}

674−fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> SerialT m a

675−fromCallback setCallback = concatM $ do

676− (callback, stream) <- D.newCallbackStream

677− setCallback callback

678− return stream

679−

680−------------------------------------------------------------------------------

681−-- Specialized folds

682−------------------------------------------------------------------------------

683−

684−-- XXX this can utilize parallel mapping if we implement it as drain . mapM

685−-- |

686−-- > mapM_ = drain . mapM

687−--

688−-- Apply a monadic action to each element of the stream and discard the output

689−-- of the action. This is not really a pure transformation operation but a

690−-- transformation followed by fold.

691−--

692−-- @since 0.1.0

693−{-# INLINE mapM_ #-}

694−mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()

695−mapM_ f m = S.mapM_ f $ toStreamS m

696−

697−-- |

698−-- > drainN n = drain . take n

699−-- > drainN n = fold (Fold.ltake n Fold.drain)

700−--

701−-- Run maximum up to @n@ iterations of a stream.

702−--

703−-- @since 0.7.0

704−{-# INLINE drainN #-}

705−drainN :: Monad m => Int -> SerialT m a -> m ()

706−drainN n = drain . take n

707−

708−-- |

709−-- > runN n = runStream . take n

710−--

711−-- Run maximum up to @n@ iterations of a stream.

712−--

713−-- @since 0.6.0

714−{-# DEPRECATED runN "Please use \"drainN\" instead" #-}

715−{-# INLINE runN #-}

716−runN :: Monad m => Int -> SerialT m a -> m ()

717−runN = drainN

718−

719−-- |

720−-- > drainWhile p = drain . takeWhile p

721−-- > drainWhile p = fold (Fold.sliceSepBy (not . p) Fold.drain)

722−--

723−-- Run a stream as long as the predicate holds true.

724−--

725−-- @since 0.7.0

726−{-# INLINE drainWhile #-}

727−drainWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()

728−drainWhile p = drain . takeWhile p

729−

730−-- |

731−-- > runWhile p = runStream . takeWhile p

732−--

733−-- Run a stream as long as the predicate holds true.

734−--

735−-- @since 0.6.0

736−{-# DEPRECATED runWhile "Please use \"drainWhile\" instead" #-}

737−{-# INLINE runWhile #-}

738−runWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()

739−runWhile = drainWhile

740−

741−------------------------------------------------------------------------------

742−-- Transformation by Inserting

743−------------------------------------------------------------------------------

744−

745−-- | Intersperse a monadic action into the input stream after every @n@

746−-- seconds.

747−--

748−-- @

749−-- > S.drain $ S.interjectSuffix 1 (putChar ',') $ S.mapM (\\x -> threadDelay 1000000 >> putChar x) $ S.fromList "hello"

750−-- "h,e,l,l,o"

751−-- @

752−--

753−-- /Internal/

754−{-# INLINE interjectSuffix #-}

755−interjectSuffix

756− :: (IsStream t, MonadAsync m)

757− => Double -> m a -> t m a -> t m a

758−interjectSuffix n f xs = xs `Par.parallelFst` repeatM timed

759− where timed = liftIO (threadDelay (round $ n * 1000000)) >> f

760−

761−-------------------------------------------------------------------------------

762−-- Indexing

763−-------------------------------------------------------------------------------

764−

765−-- Note: The timestamp stream must be the second stream in the zip so that the

766−-- timestamp is generated after generating the stream element and not before.

767−-- If we do not do that then the following example will generate the same

768−-- timestamp for first two elements:

769−--

770−-- S.mapM_ print $ S.timestamped $ S.delay $ S.enumerateFromTo 1 3

771−--

772−-- | Pair each element in a stream with an absolute timestamp, using a clock of

773−-- specified granularity. The timestamp is generated just before the element

774−-- is consumed.

775−--

776−-- @

777−-- >>> S.mapM_ print $ S.timestampWith 0.01 $ S.delay 1 $ S.enumerateFromTo 1 3

778−-- @

779−--

780−-- /Internal/

781−--

782−{-# INLINE timestampWith #-}

783−timestampWith :: (IsStream t, MonadAsync m, Functor (t m))

784− => Double -> t m a -> t m (AbsTime, a)

785−timestampWith g stream = Z.zipWith (flip (,)) stream (absTimesWith g)

786−

787−-- TBD: check performance vs a custom implementation without using zipWith.

788−--

789−-- /Internal/

790−--

791−{-# INLINE timestamped #-}

792−timestamped :: (IsStream t, MonadAsync m, Functor (t m))

793− => t m a -> t m (AbsTime, a)

794−timestamped = timestampWith 0.01

795−

796−-- | Pair each element in a stream with relative times starting from 0, using a

797−-- clock with the specified granularity. The time is measured just before the

798−-- element is consumed.

799−--

800−-- @

801−-- >>> S.mapM_ print $ S.timeIndexWith 0.01 $ S.delay 1 $ S.enumerateFromTo 1 3

802−-- @

803−--

804−-- /Internal/

805−--

806−{-# INLINE timeIndexWith #-}

807−timeIndexWith :: (IsStream t, MonadAsync m, Functor (t m))

808− => Double -> t m a -> t m (RelTime64, a)

809−timeIndexWith g stream = Z.zipWith (flip (,)) stream (relTimesWith g)

810−

811−-- | Pair each element in a stream with relative times starting from 0, using a

812−-- 10 ms granularity clock. The time is measured just before the element is

813−-- consumed.

814−--

815−-- @

816−-- >>> S.mapM_ print $ S.timeIndexed $ S.delay 1 $ S.enumerateFromTo 1 3

817−-- (RelTime64 (NanoSecond64 0),1)

818−-- (RelTime64 (NanoSecond64 996239000),2)

819−-- (RelTime64 (NanoSecond64 1996712000),3)

820−-- @

821−--

822−-- /Internal/

823−--

824−{-# INLINE timeIndexed #-}

825−timeIndexed :: (IsStream t, MonadAsync m, Functor (t m))

826− => t m a -> t m (RelTime64, a)

827−timeIndexed = timeIndexWith 0.01

828−

829−------------------------------------------------------------------------------

830−-- Searching

831−------------------------------------------------------------------------------

832−

833−-- | Returns the first index that satisfies the given predicate.

834−--

835−-- > findIndex = fold Fold.findIndex

836−--

837−-- @since 0.5.0

838−{-# INLINE findIndex #-}

839−findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)

840−findIndex p = head . findIndices p

841−

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

843−--

844−-- > elemIndex a = findIndex (== a)

845−--

846−-- @since 0.5.0

847−{-# INLINE elemIndex #-}

848−elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)

849−elemIndex a = findIndex (== a)

850−

851−------------------------------------------------------------------------------

852−-- Substreams

853−------------------------------------------------------------------------------

854−

855−-- | Returns 'True' if the first stream is a suffix of the second. A stream is

856−-- considered a suffix of itself.

857−--

858−-- @

859−-- > S.isSuffixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

860−-- True

861−-- @

862−--

863−-- Space: @O(n)@, buffers entire input stream and the suffix.

864−--

865−-- /Internal/

866−--

867−-- /Suboptimal/ - Help wanted.

868−--

869−{-# INLINE isSuffixOf #-}

870−isSuffixOf :: (Monad m, Eq a) => SerialT m a -> SerialT m a -> m Bool

871−isSuffixOf suffix stream = reverse suffix `isPrefixOf` reverse stream

872−

873−-- | Returns 'True' if the first stream is an infix of the second. A stream is

874−-- considered an infix of itself.

875−--

876−-- @

877−-- > S.isInfixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

878−-- True

879−-- @

880−--

881−-- Space: @O(n)@ worst case where @n@ is the length of the infix.

882−--

883−-- /Internal/

884−--

885−-- /Requires 'Storable' constraint/ - Help wanted.

886−--

887−{-# INLINE isInfixOf #-}

888−isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a)

889− => SerialT m a -> SerialT m a -> m Bool

890−isInfixOf infx stream = do

891− arr <- fold A.write infx

892− -- XXX can use breakOnSeq instead (when available)

893− r <- null $ drop 1 $ splitOnSeq arr FL.drain stream

894− return (not r)

895−

896−-- Note: If we want to return a Maybe value to know whether the

897−-- suffix/infix was present or not along with the stripped stream then

898−-- we need to buffer the whole input stream.

899−--

900−-- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does

901−-- not end with the given suffix. Returns @Just nil@ when the suffix is the

902−-- same as the stream.

903−--

904−-- It may be more efficient to convert the stream to an Array and use

905−-- stripSuffix on that especially if the elements have a Storable or Prim

906−-- instance.

907−--

908−-- Space: @O(n)@, buffers the entire input stream as well as the suffix

909−--

910−-- /Internal/

911−{-# INLINE stripSuffix #-}

912−stripSuffix

913− :: (Monad m, Eq a)

914− => SerialT m a -> SerialT m a -> m (Maybe (SerialT m a))

915−stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2)

916−

917−------------------------------------------------------------------------------

918−-- Split on a delimiter sequence

919−------------------------------------------------------------------------------

920−

921−-- XXX use a non-monadic intersperse to remove the MonadAsync constraint.

922−--

923−-- | Like 'splitOnSeq' but splits the separator as well, as an infix token.

924−--

925−-- > splitOn'_ pat xs = S.toList $ S.splitOn' (A.fromList pat) (FL.toList) (S.fromList xs)

926−--

927−-- >>> splitOn'_ "" "hello"

928−-- > ["h","","e","","l","","l","","o"]

929−--

930−-- >>> splitOn'_ "hello" ""

931−-- > [""]

932−--

933−-- >>> splitOn'_ "hello" "hello"

934−-- > ["","hello",""]

935−--

936−-- >>> splitOn'_ "x" "hello"

937−-- > ["hello"]

938−--

939−-- >>> splitOn'_ "h" "hello"

940−-- > ["","h","ello"]

941−--

942−-- >>> splitOn'_ "o" "hello"

943−-- > ["hell","o",""]

944−--

945−-- >>> splitOn'_ "e" "hello"

946−-- > ["h","e","llo"]

947−--

948−-- >>> splitOn'_ "l" "hello"

949−-- > ["he","l","","l","o"]

950−--

951−-- >>> splitOn'_ "ll" "hello"

952−-- > ["he","ll","o"]

953−--

954−-- /Internal/

955−{-# INLINE splitBySeq #-}

956−splitBySeq

957− :: (IsStream t, MonadAsync m, Storable a, Enum a, Eq a)

958− => Array a -> Fold m a b -> t m a -> t m b

959−splitBySeq patt f m =

960− intersperseM (fold f (A.toStream patt)) $ splitOnSeq patt f m

961−

962−------------------------------------------------------------------------------

963−-- Flattening Trees

964−------------------------------------------------------------------------------

965−

966−-- | Like 'iterateM' but iterates after mapping a stream generator on the

967−-- output.

968−--

969−-- Yield an input element in the output stream, map a stream generator on it

970−-- and then do the same on the resulting stream. This can be used for a depth

971−-- first traversal of a tree like structure.

972−--

973−-- Note that 'iterateM' is a special case of 'iterateMapWith':

974−--

975−-- @

976−-- iterateM f = iterateMapWith serial (yieldM . f) . yieldM

977−-- @

978−--

979−-- It can be used to traverse a tree structure. For example, to list a

980−-- directory tree:

981−--

982−-- @

983−-- Stream.iterateMapWith Stream.serial

984−-- (either Dir.toEither (const nil))

985−-- (yield (Left "tmp"))

986−-- @

987−--

988−-- /Internal/

989−--

990−{-# INLINE iterateMapWith #-}

991−iterateMapWith

992− :: IsStream t

993− => (t m a -> t m a -> t m a)

994− -> (a -> t m a)

995− -> t m a

996− -> t m a

997−iterateMapWith combine f = concatMapWith combine go

998− where

999− go x = yield x `combine` concatMapWith combine go (f x)

1000−

1001−{-

1002−{-# INLINE iterateUnfold #-}

1003−iterateUnfold :: (IsStream t, MonadAsync m)

1004− => Unfold m a a -> t m a -> t m a

1005−iterateUnfold unf xs = undefined

1006−-}

1007−

1008−------------------------------------------------------------------------------

1009−-- Flattening Graphs

1010−------------------------------------------------------------------------------

1011−

1012−-- To traverse graphs we need a state to be carried around in the traversal.

1013−-- For example, we can use a hashmap to store the visited status of nodes.

1014−

1015−-- | Like 'iterateMap' but carries a state in the stream generation function.

1016−-- This can be used to traverse graph like structures, we can remember the

1017−-- visited nodes in the state to avoid cycles.

1018−--

1019−-- Note that a combination of 'iterateMap' and 'usingState' can also be used to

1020−-- traverse graphs. However, this function provides a more localized state

1021−-- instead of using a global state.

1022−--

1023−-- See also: 'mfix'

1024−--

1025−-- /Internal/

1026−--

1027−{-# INLINE iterateSmapMWith #-}

1028−iterateSmapMWith

1029− :: (IsStream t, Monad m)

1030− => (t m a -> t m a -> t m a)

1031− -> (b -> a -> m (b, t m a))

1032− -> m b

1033− -> t m a

1034− -> t m a

1035−iterateSmapMWith combine f initial stream =

1036− concatMap (\b -> concatMapWith combine (go b) stream) (yieldM initial)

1037−

1038− where

1039−

1040− go b a = yield a `combine` feedback b a

1041−

1042− feedback b a =

1043− concatMap

1044− (\(b1, s) -> concatMapWith combine (go b1) s)

1045− (yieldM $ f b a)

1046−

1047−------------------------------------------------------------------------------

1048−-- Flattening Lists

1049−------------------------------------------------------------------------------

1050−

1051−-- | Given a stream value in the underlying monad, lift and join the underlying

1052−-- monad with the stream monad.

1053−--

1054−-- @

1055−-- concatM = concat . yieldM

1056−-- concatM = concat . lift -- requires @(MonadTrans t)@

1057−-- concatM = join . lift -- requires @(MonadTrans t@, @Monad (t m))@

1058−-- @

1059−--

1060−-- See also: 'concat', 'sequence'

1061−--

1062−-- /Internal/

1063−--

1064−{-# INLINE concatM #-}

1065−concatM :: (IsStream t, Monad m) => m (t m a) -> t m a

1066−concatM generator = concatMapM (\() -> generator) (yield ())

1067−

1068−------------------------------------------------------------------------------

1069−-- Either streams

1070−------------------------------------------------------------------------------

1071−

1072−-- | In an 'Either' stream iterate on 'Left's. This is a special case of

1073−-- 'iterateMapWith':

1074−--

1075−-- @

1076−-- iterateMapLeftsWith combine f = iterateMapWith combine (either f (const nil))

1077−-- @

1078−--

1079−-- To traverse a directory tree:

1080−--

1081−-- @

1082−-- iterateMapLeftsWith serial Dir.toEither (yield (Left "tmp"))

1083−-- @

1084−--

1085−-- /Internal/

1086−--

1087−{-# INLINE iterateMapLeftsWith #-}

1088−iterateMapLeftsWith

1089− :: IsStream t

1090− => (t m (Either a b) -> t m (Either a b) -> t m (Either a b))

1091− -> (a -> t m (Either a b))

1092− -> t m (Either a b)

1093− -> t m (Either a b)

1094−iterateMapLeftsWith combine f = iterateMapWith combine (either f (const K.nil))

1095−

1096−-------------------------------------------------------------------------------

1097−-- Breaking

1098−-------------------------------------------------------------------------------

1099−

1100−-- XXX we can implement this by repeatedly applying the 'lrunFor' fold.

1101−-- XXX add this example after fixing the serial stream rate control

1102−-- >>> S.toList $ S.take 5 $ intervalsOf 1 FL.sum $ constRate 2 $ S.enumerateFrom 1

1103−-- > [3,7,11,15,19]

1104−--

1105−-- | Group the input stream into windows of @n@ second each and then fold each

1106−-- group using the provided fold function.

1107−--

1108−-- @since 0.7.0

1109−{-# INLINE intervalsOf #-}

1110−intervalsOf

1111− :: (IsStream t, MonadAsync m)

1112− => Double -> Fold m a b -> t m a -> t m b

1113−intervalsOf n f xs =

1114− splitWithSuffix isNothing (FL.lcatMaybes f)

1115− (interjectSuffix n (return Nothing) (Serial.map Just xs))

1116−

1117−------------------------------------------------------------------------------

1118−-- Windowed classification

1119−------------------------------------------------------------------------------

1120−

1121−-- We divide the stream into windows or chunks in space or time and each window

1122−-- can be associated with a key, all events associated with a particular key in

1123−-- the window can be folded to a single result. The stream can be split into

1124−-- windows by size or by using a split predicate on the elements in the stream.

1125−-- For example, when we receive a closing flag, we can close the window.

1126−--

1127−-- A "chunk" is a space window and a "session" is a time window. Are there any

1128−-- other better short words to describe them. An alternative is to use

1129−-- "swindow" and "twindow". Another word for "session" could be "spell".

1130−--

1131−-- TODO: To mark the position in space or time we can have Indexed or

1132−-- TimeStamped types. That can make it easy to deal with the position indices

1133−-- or timestamps.

1134−

1135−------------------------------------------------------------------------------

1136−-- Keyed Sliding Windows

1137−------------------------------------------------------------------------------

1138−

1139−{-

1140−{-# INLINABLE classifySlidingChunks #-}

1141−classifySlidingChunks

1142− :: (IsStream t, MonadAsync m, Ord k)

1143− => Int -- ^ window size

1144− -> Int -- ^ window slide

1145− -> Fold m a b -- ^ Fold to be applied to window events

1146− -> t m (k, a, Bool) -- ^ window key, data, close event

1147− -> t m (k, b)

1148−classifySlidingChunks wsize wslide (Fold step initial extract) str

1149− = undefined

1150−

1151−-- XXX Another variant could be to slide the window on an event, e.g. in TCP we

1152−-- slide the send window when an ack is received and we slide the receive

1153−-- window when a sequence is complete. Sliding is stateful in case of TCP,

1154−-- sliding releases the send buffer or makes data available to the user from

1155−-- the receive buffer.

1156−{-# INLINABLE classifySlidingSessions #-}

1157−classifySlidingSessions

1158− :: (IsStream t, MonadAsync m, Ord k)

1159− => Double -- ^ timer tick in seconds

1160− -> Double -- ^ time window size

1161− -> Double -- ^ window slide

1162− -> Fold m a b -- ^ Fold to be applied to window events

1163− -> t m (k, a, Bool, AbsTime) -- ^ window key, data, close flag, timestamp

1164− -> t m (k, b)

1165−classifySlidingSessions tick interval slide (Fold step initial extract) str

1166− = undefined

1167−-}

1168−

1169−------------------------------------------------------------------------------

1170−-- Sliding Window Buffers

1171−------------------------------------------------------------------------------

1172−

1173−-- These buffered versions could be faster than concurrent incremental folds of

1174−-- all overlapping windows as in many cases we may not need all the values to

1175−-- compute the fold, we can just compute the result using the old value and new

1176−-- value. However, we may need the buffer once in a while, for example for

1177−-- string search we usually compute the hash incrementally but when the hash

1178−-- matches the hash of the pattern we need to compare the whole string.

1179−--

1180−-- XXX we should be able to implement sequence based splitting combinators

1181−-- using this combinator.

1182−

1183−{-

1184−-- | Buffer n elements of the input in a ring buffer. When t new elements are

1185−-- collected, slide the window to remove the same number of oldest elements,

1186−-- insert the new elements, and apply an incremental fold on the sliding

1187−-- window, supplying the outgoing elements, the new ring buffer as arguments.

1188−slidingChunkBuffer

1189− :: (IsStream t, Monad m, Ord a, Storable a)

1190− => Int -- window size

1191− -> Int -- window slide

1192− -> Fold m (Ring a, Array a) b

1193− -> t m a

1194− -> t m b

1195−slidingChunkBuffer = undefined

1196−

1197−-- Buffer n seconds worth of stream elements of the input in a radix tree.

1198−-- Every t seconds, remove the items that are older than n seconds, and apply

1199−-- an incremental fold on the sliding window, supplying the outgoing elements,

1200−-- and the new radix tree buffer as arguments.

1201−slidingSessionBuffer

1202− :: (IsStream t, Monad m, Ord a, Storable a)

1203− => Int -- window size

1204− -> Int -- tick size

1205− -> Fold m (RTree a, Array a) b

1206− -> t m a

1207− -> t m b

1208−slidingSessionBuffer = undefined

1209−-}

1210−

1211−------------------------------------------------------------------------------

1212−-- Keyed Session Windows

1213−------------------------------------------------------------------------------

1214−

1215−{-

1216−-- | Keyed variable size space windows. Close the window if we do not receive a

1217−-- window event in the next "spaceout" elements.

1218−{-# INLINABLE classifyChunksBy #-}

1219−classifyChunksBy

1220− :: (IsStream t, MonadAsync m, Ord k)

1221− => Int -- ^ window spaceout (spread)

1222− -> Bool -- ^ reset the spaceout when a chunk window element is received

1223− -> Fold m a b -- ^ Fold to be applied to chunk window elements

1224− -> t m (k, a, Bool) -- ^ chunk key, data, last element

1225− -> t m (k, b)

1226−classifyChunksBy spanout reset (Fold step initial extract) str = undefined

1227−

1228−-- | Like 'classifyChunksOf' but the chunk size is reset if an element is

1229−-- received within the chunk size window. The chunk gets closed only if no

1230−-- element is received within the chunk window.

1231−--

1232−{-# INLINABLE classifyKeepAliveChunks #-}

1233−classifyKeepAliveChunks

1234− :: (IsStream t, MonadAsync m, Ord k)

1235− => Int -- ^ window spaceout (spread)

1236− -> Fold m a b -- ^ Fold to be applied to chunk window elements

1237− -> t m (k, a, Bool) -- ^ chunk key, data, last element

1238− -> t m (k, b)

1239−classifyKeepAliveChunks spanout = classifyChunksBy spanout True

1240−-}

1241−

1242−data SessionState t m k a b = SessionState

1243− { sessionCurTime :: !AbsTime -- ^ time since last event

1244− , sessionEventTime :: !AbsTime -- ^ time as per last event

1245− , sessionCount :: !Int -- ^ total number sessions in progress

1246− , sessionTimerHeap :: H.Heap (H.Entry AbsTime k) -- ^ heap for timeouts

1247− , sessionKeyValueMap :: Map.Map k a -- ^ Stored sessions for keys

1248− , sessionOutputStream :: t (m :: Type -> Type) (k, b) -- ^ Completed sessions

1249− }

1250−

1251−#undef Type

1252−

1253−-- XXX Perhaps we should use an "Event a" type to represent timestamped data.

1254−-- | @classifySessionsBy tick timeout idle pred f stream@ groups timestamped

1255−-- events in an input event stream into sessions based on a session key. Each

1256−-- element in the input stream is an event consisting of a triple @(session key,

1257−-- sesssion data, timestamp)@. @session key@ is a key that uniquely identifies

1258−-- the session. All the events belonging to a session are folded using the fold

1259−-- @f@ until the fold terminates or a timeout has occurred. The session key and

1260−-- the result of the fold are emitted in the output stream when the session is

1261−-- purged.

1262−--

1263−-- When @idle@ is 'False', @timeout@ is the maximum lifetime of a session in

1264−-- seconds, measured from the @timestamp@ of the first event in that session.

1265−-- When @idle@ is 'True' then the timeout is an idle timeout, it is reset after

1266−-- every event received in the session.

1267−--

1268−-- @timestamp@ in an event characterizes the time when the input event was

1269−-- generated, this is an absolute time measured from some @Epoch@. The notion

1270−-- of current time is maintained by a monotonic event time clock using the

1271−-- timestamps seen in the input stream. The latest timestamp seen till now is

1272−-- used as the base for the current time. When no new events are seen, a timer

1273−-- is started with a tick duration specified by @tick@. This timer is used to

1274−-- detect session timeouts in the absence of new events.

1275−--

1276−-- The predicate @pred@ is invoked with the current session count, if it

1277−-- returns 'True' a session is ejected from the session cache before inserting

1278−-- a new session. This could be useful to alert or eject sessions when the

1279−-- number of sessions becomes too high.

1280−--

1281−-- /Internal/

1282−--

1283−{-# INLINABLE classifySessionsBy #-}

1284−classifySessionsBy

1285− :: (IsStream t, MonadAsync m, Ord k)

1286− => Double -- ^ timer tick in seconds

1287− -> Double -- ^ session timeout in seconds

1288− -> Bool -- ^ reset the timeout when an event is received

1289− -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count

1290− -> Fold m a b -- ^ Fold to be applied to session events

1291− -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

1292− -> t m (k, b) -- ^ session key, fold result

1293−classifySessionsBy tick tmout reset ejectPred

1294− (Fold step initial extract) str =

1295− concatMap sessionOutputStream $

1296− scanlMAfter' sstep (return szero) flush stream

1297−

1298− where

1299−

1300− timeoutMs = toRelTime (round (tmout * 1000) :: MilliSecond64)

1301− tickMs = toRelTime (round (tick * 1000) :: MilliSecond64)

1302− szero = SessionState

1303− { sessionCurTime = toAbsTime (0 :: MilliSecond64)

1304− , sessionEventTime = toAbsTime (0 :: MilliSecond64)

1305− , sessionCount = 0

1306− , sessionTimerHeap = H.empty

1307− , sessionKeyValueMap = Map.empty

1308− , sessionOutputStream = K.nil

1309− }

1310−

1311− -- We can eject sessions based on the current session count to limit

1312− -- memory consumption. There are two possible strategies:

1313− --

1314− -- 1) Eject old sessions or sessions beyond a certain/lower timeout

1315− -- threshold even before timeout, effectively reduce the timeout.

1316− -- 2) Drop creation of new sessions but keep accepting new events for the

1317− -- old ones.

1318− --

1319− -- We use the first strategy as of now.

1320−

1321− -- Got a new stream input element

1322− sstep session@SessionState{..} (Just (key, value, timestamp)) = do

1323− -- XXX we should use a heap in pinned memory to scale it to a large

1324− -- size

1325− --

1326− -- To detect session inactivity we keep a timestamp of the latest event

1327− -- in the Map along with the fold result. When we purge the session

1328− -- from the heap we match the timestamp in the heap with the timestamp

1329− -- in the Map, if the latest timestamp is newer and has not expired we

1330− -- reinsert the key in the heap.

1331− --

1332− -- XXX if the key is an Int, we can also use an IntMap for slightly

1333− -- better performance.

1334− --

1335− let curTime = max sessionEventTime timestamp

1336− mOld = Map.lookup key sessionKeyValueMap

1337−

1338− fs <-

1339− case mOld of

1340− Nothing -> initial

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

1342− res <- step fs value

1343− case res of

1344− FL.Done fb -> do

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

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

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

1348− -- lookup in the Map when the key is purged from the heap, that

1349− -- should not be expensive.

1350− --

1351− let (mp, cnt) = case mOld of

1352− Nothing -> (sessionKeyValueMap, sessionCount)

1353− Just _ -> (Map.delete key sessionKeyValueMap

1354− , sessionCount - 1)

1355− return $ session

1356− { sessionCurTime = curTime

1357− , sessionEventTime = curTime

1358− , sessionCount = cnt

1359− , sessionKeyValueMap = mp

1360− , sessionOutputStream = yield (key, fb)

1361− }

1362− FL.Partial fs1 -> do

1363− let acc = Tuple' timestamp fs1

1364− (hp1, mp1, out1, cnt1) <- do

1365− let vars = (sessionTimerHeap, sessionKeyValueMap,

1366− K.nil, sessionCount)

1367− case mOld of

1368− -- inserting new entry

1369− Nothing -> do

1370− -- Eject a session from heap and map is needed

1371− eject <- ejectPred sessionCount

1372− (hp, mp, out, cnt) <-

1373− if eject

1374− then ejectOne vars

1375− else return vars

1376−

1377− -- Insert the new session in heap

1378− let expiry = addToAbsTime timestamp timeoutMs

1379− hp' = H.insert (Entry expiry key) hp

1380− in return (hp', mp, out, cnt + 1)

1381− -- updating old entry

1382− Just _ -> return vars

1383−

1384− let mp2 = Map.insert key acc mp1

1385− return $ SessionState

1386− { sessionCurTime = curTime

1387− , sessionEventTime = curTime

1388− , sessionCount = cnt1

1389− , sessionTimerHeap = hp1

1390− , sessionKeyValueMap = mp2

1391− , sessionOutputStream = out1

1392− }

1393−

1394− -- Got a timer tick event

1395− sstep sessionState@SessionState{..} Nothing =

1396− let curTime = addToAbsTime sessionCurTime tickMs

1397− in ejectExpired sessionState curTime

1398−

1399− flush session@SessionState{..} = do

1400− (hp', mp', out, count) <-

1401− ejectAll

1402− ( sessionTimerHeap

1403− , sessionKeyValueMap

1404− , K.nil

1405− , sessionCount

1406− )

1407− return $ session

1408− { sessionCount = count

1409− , sessionTimerHeap = hp'

1410− , sessionKeyValueMap = mp'

1411− , sessionOutputStream = out

1412− }

1413−

1414− -- delete from map and output the fold accumulator

1415− ejectEntry hp mp out cnt acc key = do

1416− sess <- extract acc

1417− let out1 = (key, sess) `K.cons` out

1418− let mp1 = Map.delete key mp

1419− return (hp, mp1, out1, cnt - 1)

1420−

1421− ejectAll (hp, mp, out, !cnt) = do

1422− let hres = H.uncons hp

1423− case hres of

1424− Just (Entry _ key, hp1) -> do

1425− r <- case Map.lookup key mp of

1426− Nothing -> return (hp1, mp, out, cnt)

1427− Just (Tuple' _ acc) -> ejectEntry hp1 mp out cnt acc key

1428− ejectAll r

1429− Nothing -> do

1430− assert (Map.null mp) (return ())

1431− return (hp, mp, out, cnt)

1432−

1433− ejectOne (hp, mp, out, !cnt) = do

1434− let hres = H.uncons hp

1435− case hres of

1436− Just (Entry expiry key, hp1) ->

1437− case Map.lookup key mp of

1438− Nothing -> ejectOne (hp1, mp, out, cnt)

1439− Just (Tuple' latestTS acc) -> do

1440− let expiry1 = addToAbsTime latestTS timeoutMs

1441− if not reset || expiry1 <= expiry

1442− then ejectEntry hp1 mp out cnt acc key

1443− else

1444− -- reset the session timeout and continue

1445− let hp2 = H.insert (Entry expiry1 key) hp1

1446− in ejectOne (hp2, mp, out, cnt)

1447− Nothing -> do

1448− assert (Map.null mp) (return ())

1449− return (hp, mp, out, cnt)

1450−

1451− ejectExpired session@SessionState{..} curTime = do

1452− (hp', mp', out, count) <-

1453− ejectLoop sessionTimerHeap sessionKeyValueMap K.nil sessionCount

1454− return $ session

1455− { sessionCurTime = curTime

1456− , sessionCount = count

1457− , sessionTimerHeap = hp'

1458− , sessionKeyValueMap = mp'

1459− , sessionOutputStream = out

1460− }

1461−

1462− where

1463−

1464− ejectLoop hp mp out !cnt = do

1465− let hres = H.uncons hp

1466− case hres of

1467− Just (Entry expiry key, hp1) -> do

1468− (eject, force) <-

1469− if curTime >= expiry

1470− then return (True, False)

1471− else do

1472− r <- ejectPred cnt

1473− return (r, r)

1474− if eject

1475− then

1476− case Map.lookup key mp of

1477− Nothing -> ejectLoop hp1 mp out cnt

1478− Just (Tuple' latestTS acc) -> do

1479− let expiry1 = addToAbsTime latestTS timeoutMs

1480− if expiry1 <= curTime || not reset || force

1481− then do

1482− (hp2,mp1,out1,cnt1) <-

1483− ejectEntry hp1 mp out cnt acc key

1484− ejectLoop hp2 mp1 out1 cnt1

1485− else

1486− -- reset the session timeout and continue

1487− let hp2 = H.insert (Entry expiry1 key) hp1

1488− in ejectLoop hp2 mp out cnt

1489− else return (hp, mp, out, cnt)

1490− Nothing -> do

1491− assert (Map.null mp) (return ())

1492− return (hp, mp, out, cnt)

1493−

1494− -- merge timer events in the stream

1495− stream = Serial.map Just str `Par.parallelFst` repeatM timer

1496− timer = do

1497− liftIO $ threadDelay (round $ tick * 1000000)

1498− return Nothing

1499−

1500−-- | Like 'classifySessionsOf' but the session is kept alive if an event is

1501−-- received within the session window. The session times out and gets closed

1502−-- only if no event is received within the specified session window size.

1503−--

1504−-- If the ejection predicate returns 'True', the session that was idle for

1505−-- the longest time is ejected before inserting a new session.

1506−--

1507−-- @

1508−-- classifyKeepAliveSessions timeout pred = classifySessionsBy 1 timeout True pred

1509−-- @

1510−--

1511−-- /Internal/

1512−--

1513−{-# INLINABLE classifyKeepAliveSessions #-}

1514−classifyKeepAliveSessions ::

1515− (IsStream t, MonadAsync m, Ord k)

1516− => Double -- ^ session inactive timeout

1517− -> (Int -> m Bool) -- ^ predicate to eject sessions on session count

1518− -> Fold m a b -- ^ Fold to be applied to session payload data

1519− -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

1520− -> t m (k, b)

1521−classifyKeepAliveSessions tmout =

1522− classifySessionsBy 1 tmout True

1523−

1524−------------------------------------------------------------------------------

1525−-- Keyed tumbling windows

1526−------------------------------------------------------------------------------

1527−

1528−-- Tumbling windows is a special case of sliding windows where the window slide

1529−-- is the same as the window size. Or it can be a special case of session

1530−-- windows where the reset flag is set to False.

1531−

1532−-- XXX instead of using the early termination flag in the stream, we can use an

1533−-- early terminating fold instead.

1534−

1535−{-

1536−-- | Split the stream into fixed size chunks of specified size. Within each

1537−-- such chunk fold the elements in buckets identified by the keys. A particular

1538−-- bucket fold can be terminated early if a closing flag is encountered in an

1539−-- element for that key.

1540−--

1541−-- @since 0.7.0

1542−{-# INLINABLE classifyChunksOf #-}

1543−classifyChunksOf

1544− :: (IsStream t, MonadAsync m, Ord k)

1545− => Int -- ^ window size

1546− -> Fold m a b -- ^ Fold to be applied to window events

1547− -> t m (k, a, Bool) -- ^ window key, data, close event

1548− -> t m (k, b)

1549−classifyChunksOf wsize = classifyChunksBy wsize False

1550−-}

1551−

1552−-- | Split the stream into fixed size time windows of specified interval in

1553−-- seconds. Within each such window, fold the elements in sessions identified

1554−-- by the session keys. The fold result is emitted in the output stream if the

1555−-- fold returns a 'Left' result or if the time window ends.

1556−--

1557−-- Session @timestamp@ in the input stream is an absolute time from some epoch,

1558−-- characterizing the time when the input element was generated. To detect

1559−-- session window end, a monotonic event time clock is maintained synced with

1560−-- the timestamps with a clock resolution of 1 second.

1561−--

1562−-- If the ejection predicate returns 'True', the session with the longest

1563−-- lifetime is ejected before inserting a new session.

1564−--

1565−-- @

1566−-- classifySessionsOf interval pred = classifySessionsBy 1 interval False pred

1567−-- @

1568−--

1569−-- @

1570−-- >>> S.mapM_ print

1571−-- $ S.classifySessionsOf 3 (const (return False)) (fmap Right FL.toList)

1572−-- $ S.map (\(ts,(k,a)) -> (k, a, ts))

1573−-- $ S.timestamped

1574−-- $ S.delay 1

1575−-- $ (,) <$> S.fromList [1,2,3] <*> S.fromList [1,2,3]

1576−-- @

1577−--

1578−-- /Internal/

1579−--

1580−{-# INLINABLE classifySessionsOf #-}

1581−classifySessionsOf ::

1582− (IsStream t, MonadAsync m, Ord k)

1583− => Double -- ^ time window size

1584− -> (Int -> m Bool) -- ^ predicate to eject sessions on session count

1585− -> Fold m a b -- ^ Fold to be applied to session events

1586− -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

1587− -> t m (k, b)

1588−classifySessionsOf interval =

1589− classifySessionsBy 1 interval False

src/Streamly/Internal/Data/Stream/IsStream/Common.hsnew file+502

@@ -0,0 +1,502 @@

1+{-# OPTIONS_GHC -Wno-orphans #-}

3+-- |

4+-- Module : Streamly.Internal.Data.Stream.IsStream.Common

6+-- License : BSD-3-Clause

7+-- Maintainer : streamly@composewell.com

8+-- Stability : experimental

9+-- Portability : GHC

10+--

11+

12+module Streamly.Internal.Data.Stream.IsStream.Common

13+ (

14+ -- * Generation

15+ yield

16+ , yieldM

17+ , repeatM

18+ , timesWith

19+ , absTimesWith

20+ , relTimesWith

21+

22+ -- * Elimination

23+ , fold

24+

25+ -- * Transformation

26+ , scanlMAfter'

27+ , postscanlM'

28+ , smapM

29+ -- $smapM_Notes

30+ , take

31+ , takeWhile

32+ , drop

33+ , findIndices

34+ , intersperseM

35+ , interjectSuffix

36+ , reverse

37+ , reverse'

38+

39+ -- * Nesting

40+ , concatM

41+ , concatMapM

42+ , splitOnSeq

43+ )

44+where

45+

46+#include "inline.hs"

47+

48+import Control.Concurrent (threadDelay)

49+import Control.Monad.IO.Class (MonadIO(..))

50+import Foreign.Storable (Storable)

51+import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array)

52+import Streamly.Internal.Data.Fold.Types (Fold (..))

53+import Streamly.Internal.Data.Stream.Combinators (maxYields)

54+import Streamly.Internal.Data.Stream.Prelude (fromStreamS, toStreamS)

55+import Streamly.Internal.Data.Stream.Serial (SerialT)

56+import Streamly.Internal.Data.Stream.StreamD (fromStreamD, toStreamD)

57+import Streamly.Internal.Data.Stream.StreamK (IsStream())

58+import Streamly.Internal.Data.SVar (MonadAsync)

59+import Streamly.Internal.Data.Time.Units (AbsTime, RelTime64, addToAbsTime64)

60+

61+import qualified Streamly.Internal.Data.Stream.Parallel as Par

62+import qualified Streamly.Internal.Data.Stream.Prelude as P

63+import qualified Streamly.Internal.Data.Stream.Serial as Serial

64+import qualified Streamly.Internal.Data.Stream.StreamK as K

65+import qualified Streamly.Internal.Data.Stream.StreamD as D

66+#ifdef USE_STREAMK_ONLY

67+import qualified Streamly.Internal.Data.Stream.StreamK as S

68+#else

69+import qualified Streamly.Internal.Data.Stream.StreamD as S

70+#endif

71+

72+import Prelude hiding (take, takeWhile, drop, reverse)

73+

74+------------------------------------------------------------------------------

75+-- Generation

76+------------------------------------------------------------------------------

77+

78+-- Faster than yieldM because there is no bind.

79+--

80+-- |

81+-- @

82+-- yield a = a \`cons` nil

83+-- @

84+--

85+-- Create a singleton stream from a pure value.

86+--

87+-- The following holds in monadic streams, but not in Zip streams:

88+--

89+-- @

90+-- yield = pure

91+-- yield = yieldM . pure

92+-- @

93+--

94+-- In Zip applicative streams 'yield' is not the same as 'pure' because in that

95+-- case 'pure' is equivalent to 'repeat' instead. 'yield' and 'pure' are

96+-- equally efficient, in other cases 'yield' may be slightly more efficient

97+-- than the other equivalent definitions.

98+--

99+-- @since 0.4.0

100+{-# INLINE yield #-}

101+yield :: IsStream t => a -> t m a

102+yield = K.yield

103+

104+-- |

105+-- @

106+-- yieldM m = m \`consM` nil

107+-- @

108+--

109+-- Create a singleton stream from a monadic action.

110+--

111+-- @

112+-- > toList $ yieldM getLine

113+-- hello

114+-- ["hello"]

115+-- @

116+--

117+-- @since 0.4.0

118+{-# INLINE yieldM #-}

119+yieldM :: (Monad m, IsStream t) => m a -> t m a

120+yieldM = K.yieldM

121+

122+-- |

123+-- @

124+-- repeatM = fix . consM

125+-- repeatM = cycle1 . yieldM

126+-- @

127+--

128+-- Generate a stream by repeatedly executing a monadic action forever.

129+--

130+-- @

131+-- drain $ serially $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)

132+-- drain $ asyncly $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)

133+-- @

134+--

135+-- /Concurrent, infinite (do not use with 'parallely')/

136+--

137+-- @since 0.2.0

138+{-# INLINE_EARLY repeatM #-}

139+repeatM :: (IsStream t, MonadAsync m) => m a -> t m a

140+repeatM = K.repeatM

141+

142+{-# RULES "repeatM serial" repeatM = repeatMSerial #-}

143+{-# INLINE repeatMSerial #-}

144+repeatMSerial :: MonadAsync m => m a -> SerialT m a

145+repeatMSerial = fromStreamS . S.repeatM

146+

147+------------------------------------------------------------------------------

148+-- Generation - Time related

149+------------------------------------------------------------------------------

150+

151+-- | @timesWith g@ returns a stream of time value tuples. The first component

152+-- of the tuple is an absolute time reference (epoch) denoting the start of the

153+-- stream and the second component is a time relative to the reference.

154+--

155+-- The argument @g@ specifies the granularity of the relative time in seconds.

156+-- A lower granularity clock gives higher precision but is more expensive in

157+-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.

158+--

159+-- @

160+-- >>> S.mapM_ (\x -> print x >> threadDelay 1000000) $ S.timesWith 0.01

161+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 0))

162+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1002028000))

163+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1996656000))

164+-- @

165+--

166+-- Note: This API is not safe on 32-bit machines.

167+--

168+-- /Internal/

169+--

170+{-# INLINE timesWith #-}

171+timesWith :: (IsStream t, MonadAsync m) => Double -> t m (AbsTime, RelTime64)

172+timesWith g = fromStreamD $ D.times g

173+

174+-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of

175+-- granularity @g@ specified in seconds. A low granularity clock is more

176+-- expensive in terms of CPU usage. Any granularity lower than 1 ms is treated

177+-- as 1 ms.

178+--

179+-- @

180+-- >>> S.mapM_ print $ S.delayPre 1 $ S.absTimesWith 0.01

181+-- @

182+--

183+-- Note: This API is not safe on 32-bit machines.

184+--

185+-- /Internal/

186+--

187+{-# INLINE absTimesWith #-}

188+absTimesWith :: (IsStream t, MonadAsync m, Functor (t m))

189+ => Double -> t m AbsTime

190+absTimesWith = fmap (uncurry addToAbsTime64) . timesWith

191+

192+-- | @relTimesWith g@ returns a stream of relative time values starting from 0,

193+-- using a clock of granularity @g@ specified in seconds. A low granularity

194+-- clock is more expensive in terms of CPU usage. Any granularity lower than 1

195+-- ms is treated as 1 ms.

196+--

197+-- @

198+-- >>> S.mapM_ print $ S.delayPre 1 $ S.relTimesWith 0.01

199+-- > RelTime64 (NanoSecond64 0)

200+-- > RelTime64 (NanoSecond64 91139000)

201+-- > RelTime64 (NanoSecond64 204052000)

202+-- @

203+--

204+-- Note: This API is not safe on 32-bit machines.

205+--

206+-- /Internal/

207+--

208+{-# INLINE relTimesWith #-}

209+relTimesWith :: (IsStream t, MonadAsync m, Functor (t m))

210+ => Double -> t m RelTime64

211+relTimesWith = fmap snd . timesWith

212+

213+------------------------------------------------------------------------------

214+-- Elimination - Running a Fold

215+------------------------------------------------------------------------------

216+

217+-- | Fold a stream using the supplied left 'Fold' and reducing the resulting

218+-- expression strictly at each step. The behavior is similar to 'foldl''. A

219+-- 'Fold' can terminate early without consuming the full stream. See the

220+-- documentation of individual 'Fold's for termination behavior.

221+--

222+-- >>> S.fold FL.sum (S.enumerateFromTo 1 100)

223+-- 5050

224+--

225+-- @since 0.7.0

226+{-# INLINE fold #-}

227+fold :: Monad m => Fold m a b -> SerialT m a -> m b

228+fold = P.foldOnce

229+

230+------------------------------------------------------------------------------

231+-- Transformation

232+------------------------------------------------------------------------------

233+

234+-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except

235+-- that it provides an additional @done@ function to be applied on the

236+-- accumulator when the stream stops. The result of @done@ is also emitted in

237+-- the stream.

238+--

239+-- This function can be used to allocate a resource in the beginning of the

240+-- scan and release it when the stream ends or to flush the internal state of

241+-- the scan at the end.

242+--

243+-- /Internal/

244+--

245+{-# INLINE scanlMAfter' #-}

246+scanlMAfter' :: (IsStream t, Monad m)

247+ => (b -> a -> m b) -> m b -> (b -> m b) -> t m a -> t m b

248+scanlMAfter' step initial done stream =

249+ fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream

250+

251+-- XXX this needs to be concurrent

252+-- | Like 'postscanl'' but with a monadic step function and a monadic seed.

253+--

254+-- /Since: 0.7.0/

255+--

256+-- /Since: 0.8.0 (signature change)/

257+{-# INLINE postscanlM' #-}

258+postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

259+postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m

260+

261+-- $smapM_Notes

262+--

263+-- The stateful step function can be simplified to @(s -> a -> m b)@ to provide

264+-- a read-only environment. However, that would just be 'mapM'.

265+--

266+-- The initial action could be @m (s, Maybe b)@, and we can also add a final

267+-- action @s -> m (Maybe b)@. This can be used to get pre/post scan like

268+-- functionality and also to flush the state in the end like scanlMAfter'.

269+-- We can also use it along with a fusible version of bracket to get

270+-- scanlMAfter' like functionality. See issue #677.

271+--

272+-- This can be further generalized to a type similar to Fold/Parser, giving it

273+-- filtering and parsing capability as well (this is in fact equivalent to

274+-- parseMany):

275+--

276+-- smapM :: (s -> a -> m (Step s b)) -> m s -> t m a -> t m b

277+--

278+

279+-- | A stateful 'mapM', equivalent to a left scan, more like mapAccumL.

280+-- Hopefully, this is a better alternative to @scan@. Separation of state from

281+-- the output makes it easier to think in terms of a shared state, and also

282+-- makes it easier to keep the state fully strict and the output lazy.

283+--

284+-- See also: 'scanlM''

285+--

286+-- /Internal/

287+--

288+{-# INLINE smapM #-}

289+smapM :: (IsStream t, Monad m) =>

290+ (s -> a -> m (s, b))

291+ -> m s

292+ -> t m a

293+ -> t m b

294+smapM step initial stream =

295+ -- XXX implement this directly instead of using scanlM'

296+ -- Once we have postscanlM' with monadic initial we can use this code

297+ -- let r = postscanlM'

298+ -- (\(s, _) a -> step s a)

299+ -- (fmap (,undefined) initial)

300+ -- stream

301+ let r = postscanlM'

302+ (\(s, _) a -> step s a)

303+ (fmap (,undefined) initial)

304+ stream

305+ in Serial.map snd r

306+

307+------------------------------------------------------------------------------

308+-- Transformation - Trimming

309+------------------------------------------------------------------------------

310+

311+-- | Take first 'n' elements from the stream and discard the rest.

312+--

313+-- @since 0.1.0

314+{-# INLINE take #-}

315+take :: (IsStream t, Monad m) => Int -> t m a -> t m a

316+take n m = fromStreamS $ S.take n $ toStreamS

317+ (maxYields (Just (fromIntegral n)) m)

318+

319+-- | End the stream as soon as the predicate fails on an element.

320+--

321+-- @since 0.1.0

322+{-# INLINE takeWhile #-}

323+takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

324+takeWhile p m = fromStreamS $ S.takeWhile p $ toStreamS m

325+

326+-- | Discard first 'n' elements from the stream and take the rest.

327+--

328+-- @since 0.1.0

329+{-# INLINE drop #-}

330+drop :: (IsStream t, Monad m) => Int -> t m a -> t m a

331+drop n m = fromStreamS $ S.drop n $ toStreamS m

332+

333+------------------------------------------------------------------------------

334+-- Searching

335+------------------------------------------------------------------------------

336+

337+-- | Find all the indices where the element in the stream satisfies the given

338+-- predicate.

339+--

340+-- > findIndices = fold Fold.findIndices

341+--

342+-- @since 0.5.0

343+{-# INLINE findIndices #-}

344+findIndices :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m Int

345+findIndices p m = fromStreamS $ S.findIndices p (toStreamS m)

346+

347+------------------------------------------------------------------------------

348+-- Transformation by Inserting

349+------------------------------------------------------------------------------

350+

351+-- intersperseM = intersperseBySpan 1

352+

353+-- | Insert an effect and its output before consuming an element of a stream

354+-- except the first one.

355+--

356+-- @

357+-- >>> S.toList $ S.trace putChar $ S.intersperseM (putChar '.' >> return ',') $ S.fromList "hello"

358+-- > h.,e.,l.,l.,o"h,e,l,l,o"

359+-- @

360+--

361+-- @since 0.5.0

362+{-# INLINE intersperseM #-}

363+intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

364+intersperseM m = fromStreamS . S.intersperseM m . toStreamS

365+

366+-- | Intersperse a monadic action into the input stream after every @n@

367+-- seconds.

368+--

369+-- @

370+-- > S.drain $ S.interjectSuffix 1 (putChar ',') $ S.mapM (\\x -> threadDelay 1000000 >> putChar x) $ S.fromList "hello"

371+-- "h,e,l,l,o"

372+-- @

373+--

374+-- /Internal/

375+{-# INLINE interjectSuffix #-}

376+interjectSuffix

377+ :: (IsStream t, MonadAsync m)

378+ => Double -> m a -> t m a -> t m a

379+interjectSuffix n f xs = xs `Par.parallelFst` repeatM timed

380+ where timed = liftIO (threadDelay (round $ n * 1000000)) >> f

381+

382+------------------------------------------------------------------------------

383+-- Transformation by Reordering

384+------------------------------------------------------------------------------

385+

386+-- XXX Use a compact region list to temporarily store the list, in both reverse

387+-- as well as in reverse'.

388+--

389+-- /Note:/ 'reverse'' is much faster than this, use that when performance

390+-- matters.

391+--

392+-- > reverse = S.foldlT (flip S.cons) S.nil

393+--

394+-- | Returns the elements of the stream in reverse order. The stream must be

395+-- finite. Note that this necessarily buffers the entire stream in memory.

396+--

397+-- /Since 0.7.0 (Monad m constraint)/

398+--

399+-- /Since: 0.1.1/

400+{-# INLINE reverse #-}

401+reverse :: (IsStream t, Monad m) => t m a -> t m a

402+reverse s = fromStreamS $ S.reverse $ toStreamS s

403+

404+-- | Like 'reverse' but several times faster, requires a 'Storable' instance.

405+--

406+-- /Internal/

407+{-# INLINE reverse' #-}

408+reverse' :: (IsStream t, MonadIO m, Storable a) => t m a -> t m a

409+reverse' s = fromStreamD $ D.reverse' $ toStreamD s

410+

411+------------------------------------------------------------------------------

412+-- Combine streams and flatten

413+------------------------------------------------------------------------------

414+

415+-- | Map a stream producing monadic function on each element of the stream

416+-- and then flatten the results into a single stream. Since the stream

417+-- generation function is monadic, unlike 'concatMap', it can produce an

418+-- effect at the beginning of each iteration of the inner loop.

419+--

420+-- @since 0.6.0

421+{-# INLINE concatMapM #-}

422+concatMapM :: (IsStream t, Monad m) => (a -> m (t m b)) -> t m a -> t m b

423+concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)

424+

425+-- | Given a stream value in the underlying monad, lift and join the underlying

426+-- monad with the stream monad.

427+--

428+-- @

429+-- concatM = concat . yieldM

430+-- concatM = concat . lift -- requires @(MonadTrans t)@

431+-- concatM = join . lift -- requires @(MonadTrans t@, @Monad (t m))@

432+-- @

433+--

434+-- See also: 'concat', 'sequence'

435+--

436+-- /Internal/

437+--

438+{-# INLINE concatM #-}

439+concatM :: (IsStream t, Monad m) => m (t m a) -> t m a

440+concatM generator = concatMapM (\() -> generator) (yield ())

441+

442+------------------------------------------------------------------------------

443+-- Split stream and fold

444+------------------------------------------------------------------------------

445+

446+-- | Like 'splitOn' but the separator is a sequence of elements instead of a

447+-- single element.

448+--

449+-- For illustration, let's define a function that operates on pure lists:

450+--

451+-- @

452+-- splitOnSeq' pat xs = S.toList $ S.splitOnSeq (A.fromList pat) (FL.toList) (S.fromList xs)

453+-- @

454+--

455+-- >>> splitOnSeq' "" "hello"

456+-- > ["h","e","l","l","o"]

457+--

458+-- >>> splitOnSeq' "hello" ""

459+-- > [""]

460+--

461+-- >>> splitOnSeq' "hello" "hello"

462+-- > ["",""]

463+--

464+-- >>> splitOnSeq' "x" "hello"

465+-- > ["hello"]

466+--

467+-- >>> splitOnSeq' "h" "hello"

468+-- > ["","ello"]

469+--

470+-- >>> splitOnSeq' "o" "hello"

471+-- > ["hell",""]

472+--

473+-- >>> splitOnSeq' "e" "hello"

474+-- > ["h","llo"]

475+--

476+-- >>> splitOnSeq' "l" "hello"

477+-- > ["he","","o"]

478+--

479+-- >>> splitOnSeq' "ll" "hello"

480+-- > ["he","o"]

481+--

482+-- 'splitOnSeq' is an inverse of 'intercalate'. The following law always holds:

483+--

484+-- > intercalate . splitOn == id

485+--

486+-- The following law holds when the separator is non-empty and contains none of

487+-- the elements present in the input lists:

488+--

489+-- > splitOn . intercalate == id

490+--

491+-- /Internal/

492+

493+-- XXX We can use a polymorphic vector implemented by Array# to represent the

494+-- sequence, that way we can avoid the Storable constraint. If we still need

495+-- Storable Array for performance, we can use a separate splitOnArray API for

496+-- that. We can also have an API where the sequence itself is a lazy stream, so

497+-- that we can search files in files for example.

498+{-# INLINE splitOnSeq #-}

499+splitOnSeq

500+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

501+ => Array a -> Fold m a b -> t m a -> t m b

502+splitOnSeq patt f m = D.fromStreamD $ D.splitOnSeq patt f (D.toStreamD m)

src/Streamly/Internal/Data/Stream/IsStream/Eliminate.hs+345−179

@@ -5,44 +5,70 @@

55-- Maintainer : streamly@composewell.com

66-- Stability : experimental

77-- Portability : GHC

8+--

9+-- This module contains functions ending in the shape:

10+--

11+-- @

12+-- t m a -> m b

13+-- @

14+--

15+-- We call them stream folding functions, they reduce a stream @t m a@ to a

16+-- monadic value @m b@.

817

918module Streamly.Internal.Data.Stream.IsStream.Eliminate

1019 (

11− -- * Elimination

12− -- ** Deconstruction

13− uncons

14− , tail

15− , init

20+ -- * Running a 'Fold'

21+ -- See "Streamly.Internal.Data.Fold".

22+ fold

23+

24+ -- * Running a 'Parser'

25+ -- "Streamly.Internal.Data.Parser".

26+ , parse

27+ , parseK

28+ , parseD

1629

17− -- ** Folding

18− -- ** Right Folds

30+ -- * Stream Deconstruction

31+ -- | foldr and foldl do not provide the remaining stream. 'uncons' is more

32+ -- general, as it can be used to implement those as well. It allows to use

33+ -- the stream one element at a time, and we have the remaining stream all

34+ -- the time.

35+ , uncons

36+

37+ -- * Right Folds

1938 , foldrM

2039 , foldr

2140

22− -- ** Left Folds

41+ -- * Left Folds

2342 , foldl'

2443 , foldl1'

2544 , foldlM'

2645

27− -- ** Composable Left Folds

28− -- | See "Streamly.Internal.Data.Fold"

29− , fold

30−

31− -- ** Parsers

32− -- | See "Streamly.Internal.Data.Parser"

33− , parse

34− , parseK

35− , parseD

36−

37− -- ** Concurrent Folds

38− , foldAsync

39− , (|$.)

40− , (|&.)

46+ -- * Specific 'Fold's

47+ -- XXX Move to Data.Fold?

48+ , toStream -- XXX rename to write? buffer?

49+ , toStreamRev -- XXX rename to writeRev? bufferRev?

50+

51+ -- * Specific Fold Functions

52+ -- | Folds as functions of the shape @t m a -> m b@.

53+ --

54+ -- These functions are good to run individually but they do not compose

55+ -- well. Prefer writing folds as the 'Fold' data type. Use folds from

56+ -- "Streamly.Internal.Data.Fold" instead of using the functions in this

57+ -- section.

58+ --

59+ -- This section can possibly be removed in future. Are these better in

60+ -- some case compared to 'Fold'? When the input stream is in CPS style

61+ -- (StreamK) we may want to rewrite the function call to CPS implementation

62+ -- of the fold through these definitions. Will that be more efficient for

63+ -- StreamK?

4164

4265 -- ** Full Folds

4366

4467 -- -- ** To Summary (Full Folds)

68+ , mapM_

4569 , drain

70+ , drainN

71+ , drainWhile

4672 , last

4773 , length

4874 , sum

@@ -56,18 +82,6 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate

5682 , minimum

5783 , the

5884

59− -- ** Lazy Folds

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

61− , toList

62− , toListRev

63− , toPure

64− , toPureRev

65−

66− -- ** Composable Left Folds

67−

68− , toStream -- XXX rename to write?

69− , toStreamRev -- XXX rename to writeRev?

70−

7185 -- ** Partial Folds

7286

7387 -- -- ** To Elements (Partial Folds)

@@ -76,8 +90,12 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate

7690 , (!!)

7791 , head

7892 , headElse

93+ , tail

94+ , init

7995 , findM

8096 , find

97+ , findIndex

98+ , elemIndex

8199 , lookup

82100

83101 -- -- ** To Boolean (Partial Folds)

@@ -89,24 +107,41 @@ module Streamly.Internal.Data.Stream.IsStream.Eliminate

89107 , and

90108 , or

91109

92− -- ** Multi-Stream folds

110+ -- -- ** Lazy Folds

111+ -- ** To Containers

112+ , toList

113+ , toListRev

114+ , toPure -- XXX move toStream to Data.Fold and rename this to toStream?

115+ , toPureRev

116+

117+ -- * Concurrent Folds

118+ , foldAsync

119+ , (|$.)

120+ , (|&.)

121+

122+ -- * Multi-Stream folds

93123 -- Full equivalence

94124 , eqBy

95125 , cmpBy

96126

97127 -- finding subsequences

98128 , isPrefixOf

129+ , isInfixOf

130+ , isSuffixOf

99131 , isSubsequenceOf

100132

101133 -- trimming sequences

102134 , stripPrefix

103135 -- , stripInfix

136+ , stripSuffix

104137

105138 -- * Deprecated

106139 , foldx

107140 , foldxM

108141 , foldr1

109142 , runStream

143+ , runN

144+ , runWhile

110145 , toHandle

111146 )

112147where

@@ -116,20 +151,24 @@ where

116151import Control.Monad.Catch (MonadThrow)

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

118153import Data.Functor.Identity (Identity (..))

154+import Foreign.Storable (Storable)

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

120156import Streamly.Internal.Data.Parser (Parser (..))

121157import Streamly.Internal.Data.SVar (MonadAsync, defState)

158+import Streamly.Internal.Data.Stream.IsStream.Common

159+ (fold, drop, findIndices, reverse, splitOnSeq, take, takeWhile)

122160import Streamly.Internal.Data.Stream.Prelude (toStreamS)

123161import Streamly.Internal.Data.Stream.StreamD (fromStreamD, toStreamD)

124162import Streamly.Internal.Data.Stream.StreamK (IsStream)

125163import Streamly.Internal.Data.Stream.Serial (SerialT)

126164

165+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

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

128167import qualified Streamly.Internal.Data.Stream.Prelude as P

129−import qualified Streamly.Internal.Data.Stream.StreamK as K

130168import qualified Streamly.Internal.Data.Stream.StreamD as D

131−import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK

169+import qualified Streamly.Internal.Data.Stream.StreamK as K

132170import qualified Streamly.Internal.Data.Parser.ParserD as PRD

171+import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK

133172import qualified System.IO as IO

134173#ifdef USE_STREAMK_ONLY

135174import qualified Streamly.Internal.Data.Stream.StreamK as S

@@ -138,12 +177,10 @@ import qualified Streamly.Internal.Data.Stream.StreamD as S

138177#endif

139178

140179import Prelude hiding

141− ( filter, drop, dropWhile, take, takeWhile, zipWith, foldr

142− , foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem

143− , notElem, maximum, minimum, head, last, tail, length, null

144− , reverse, iterate, init, and, or, lookup, foldr1, (!!)

145− , scanl, scanl1, replicate, concatMap, span, splitAt, break

146− , repeat, concat, mconcat)

180+ ( drop, take, takeWhile, foldr , foldl, mapM_, sequence, all, any, sum

181+ , product, elem, notElem, maximum, minimum, head, last, tail, length

182+ , null , reverse, init, and, or, lookup, foldr1, (!!) , splitAt, break

183+ , mconcat)

147184

148185------------------------------------------------------------------------------

149186-- Deconstruction

@@ -165,7 +202,7 @@ uncons :: (IsStream t, Monad m) => SerialT m a -> m (Maybe (a, t m a))

165202uncons m = K.uncons (K.adapt m)

166203

167204------------------------------------------------------------------------------

168−-- Elimination by Folding

205+-- Right Folds

169206------------------------------------------------------------------------------

170207

171208-- | Right associative/lazy pull fold. @foldrM build final stream@ constructs

@@ -219,6 +256,10 @@ foldr = P.foldr

219256foldr1 :: Monad m => (a -> a -> a) -> SerialT m a -> m (Maybe a)

220257foldr1 f m = S.foldr1 f (toStreamS m)

221258

259+------------------------------------------------------------------------------

260+-- Left Folds

261+------------------------------------------------------------------------------

262+

222263-- | Strict left fold with an extraction function. Like the standard strict

223264-- left fold, but applies a user supplied extraction function (the third

224265-- argument) to the folded value at the end. This is designed to work with the

@@ -274,23 +315,6 @@ foldxM = P.foldlMx'

274315foldlM' :: Monad m => (b -> a -> m b) -> m b -> SerialT m a -> m b

275316foldlM' step begin m = S.foldlM' step begin $ toStreamS m

276317

277−------------------------------------------------------------------------------

278−-- Running a Fold

279−------------------------------------------------------------------------------

280−

281−-- | Fold a stream using the supplied left 'Fold' and reducing the resulting

282−-- expression strictly at each step. The behavior is similar to 'foldl''. A

283−-- 'Fold' can terminate early without consuming the full stream. See the

284−-- documentation of individual 'Fold's for termination behavior.

285−--

286−-- >>> S.fold FL.sum (S.enumerateFromTo 1 100)

287−-- 5050

288−--

289−-- @since 0.7.0

290−{-# INLINE fold #-}

291−fold :: Monad m => Fold m a b -> SerialT m a -> m b

292−fold = P.foldOnce

293−

294318------------------------------------------------------------------------------

295319-- Running a sink

296320------------------------------------------------------------------------------

@@ -327,9 +351,22 @@ parse :: MonadThrow m => Parser m a b -> SerialT m a -> m b

327351parse = parseD . PRK.fromParserK

328352

329353------------------------------------------------------------------------------

330−-- Specialized folds

354+-- Specific Fold Functions

331355------------------------------------------------------------------------------

332356

357+-- XXX this can utilize parallel mapping if we implement it as drain . mapM

358+-- |

359+-- > mapM_ = drain . mapM

360+--

361+-- Apply a monadic action to each element of the stream and discard the output

362+-- of the action. This is not really a pure transformation operation but a

363+-- transformation followed by fold.

364+--

365+-- @since 0.1.0

366+{-# INLINE mapM_ #-}

367+mapM_ :: Monad m => (a -> m b) -> SerialT m a -> m ()

368+mapM_ f m = S.mapM_ f $ toStreamS m

369+

333370-- |

334371-- > drain = mapM_ (\_ -> return ())

335372-- > drain = fold Fold.drain

@@ -343,6 +380,50 @@ parse = parseD . PRK.fromParserK

343380drain :: Monad m => SerialT m a -> m ()

344381drain = P.drain

345382

383+-- |

384+-- > drainN n = drain . take n

385+-- > drainN n = fold (Fold.ltake n Fold.drain)

386+--

387+-- Run maximum up to @n@ iterations of a stream.

388+--

389+-- @since 0.7.0

390+{-# INLINE drainN #-}

391+drainN :: Monad m => Int -> SerialT m a -> m ()

392+drainN n = drain . take n

393+

394+-- |

395+-- > runN n = runStream . take n

396+--

397+-- Run maximum up to @n@ iterations of a stream.

398+--

399+-- @since 0.6.0

400+{-# DEPRECATED runN "Please use \"drainN\" instead" #-}

401+{-# INLINE runN #-}

402+runN :: Monad m => Int -> SerialT m a -> m ()

403+runN = drainN

404+

405+-- |

406+-- > drainWhile p = drain . takeWhile p

407+-- > drainWhile p = fold (Fold.sliceSepBy (not . p) Fold.drain)

408+--

409+-- Run a stream as long as the predicate holds true.

410+--

411+-- @since 0.7.0

412+{-# INLINE drainWhile #-}

413+drainWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()

414+drainWhile p = drain . takeWhile p

415+

416+-- |

417+-- > runWhile p = runStream . takeWhile p

418+--

419+-- Run a stream as long as the predicate holds true.

420+--

421+-- @since 0.6.0

422+{-# DEPRECATED runWhile "Please use \"drainWhile\" instead" #-}

423+{-# INLINE runWhile #-}

424+runWhile :: Monad m => (a -> Bool) -> SerialT m a -> m ()

425+runWhile = drainWhile

426+

346427-- | Run a stream, discarding the results. By default it interprets the stream

347428-- as 'SerialT', to run other types of streams use the type adapting

348429-- combinators for example @runStream . 'asyncly'@.

@@ -553,6 +634,10 @@ maximumBy cmp m = S.maximumBy cmp (toStreamS m)

553634the :: (Eq a, Monad m) => SerialT m a -> m (Maybe a)

554635the m = S.the (toStreamS m)

555636

637+------------------------------------------------------------------------------

638+-- Searching

639+------------------------------------------------------------------------------

640+

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

557642--

558643-- @since 0.6.0

@@ -590,130 +675,26 @@ find p m = S.find p (toStreamS m)

590675findM :: Monad m => (a -> m Bool) -> SerialT m a -> m (Maybe a)

591676findM p m = S.findM p (toStreamS m)

592677

593−------------------------------------------------------------------------------

594−-- Substreams

595−------------------------------------------------------------------------------

596−

597−-- | Returns 'True' if the first stream is the same as or a prefix of the

598−-- second. A stream is a prefix of itself.

599−--

600−-- @

601−-- > S.isPrefixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

602−-- True

603−-- @

604−--

605−-- @since 0.6.0

606−{-# INLINE isPrefixOf #-}

607−isPrefixOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool

608−isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)

609−

610−-- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf

611−-- may use the suffix stream many times. To run in optimal memory we do not

612−-- want to buffer the suffix stream in memory therefore we need an ability to

613−-- clone (or consume it multiple times) the suffix stream without any side

614−-- effects so that multiple potential suffix matches can proceed in parallel

615−-- without buffering the suffix stream. For example, we may create the suffix

616−-- stream from a file handle, however, if we evaluate the stream multiple

617−-- times, once for each match, we will need a different file handle each time

618−-- which may exhaust the file descriptors. Instead, we want to share the same

619−-- underlying file descriptor, use pread on it to generate the stream and clone

620−-- the stream for each match. Therefore the suffix stream should be built in

621−-- such a way that it can be consumed multiple times without any problems.

622−

623−-- XXX Can be implemented with better space/time complexity.

624−-- Space: @O(n)@ worst case where @n@ is the length of the suffix.

625−

626−-- | Returns 'True' if all the elements of the first stream occur, in order, in

627−-- the second stream. The elements do not have to occur consecutively. A stream

628−-- is a subsequence of itself.

629−--

630−-- @

631−-- > S.isSubsequenceOf (S.fromList "hlo") (S.fromList "hello" :: SerialT IO Char)

632−-- True

633−-- @

634−--

635−-- @since 0.6.0

636−{-# INLINE isSubsequenceOf #-}

637−isSubsequenceOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool

638−isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)

639−

640−-- | @stripPrefix prefix stream@ strips @prefix@ from @stream@ if it is a

641−-- prefix of stream. Returns 'Nothing' if the stream does not start with the

642−-- given prefix, stripped stream otherwise. Returns @Just nil@ when the prefix

643−-- is the same as the stream.

644−--

645−-- Space: @O(1)@

646−--

647−-- @since 0.6.0

648−{-# INLINE stripPrefix #-}

649−stripPrefix

650− :: (Eq a, IsStream t, Monad m)

651− => t m a -> t m a -> m (Maybe (t m a))

652−stripPrefix m1 m2 = fmap fromStreamD <$>

653− D.stripPrefix (toStreamD m1) (toStreamD m2)

654−

655−------------------------------------------------------------------------------

656−-- Concurrent Application

657−------------------------------------------------------------------------------

658−

659−infixr 0 |$.

660−infixl 1 |&.

661−

662−-- | Parallel fold application operator; applies a fold function @t m a -> m b@

663−-- to a stream @t m a@ concurrently; The the input stream is evaluated

664−-- asynchronously in an independent thread yielding elements to a buffer and

665−-- the folding action runs in another thread consuming the input from the

666−-- buffer.

678+-- | Returns the first index that satisfies the given predicate.

667679--

668−-- If you read the signature as @(t m a -> m b) -> (t m a -> m b)@ you can look

669−-- at it as a transformation that converts a fold function to a buffered

670−-- concurrent fold function.

671−--

672−-- The @.@ at the end of the operator is a mnemonic for termination of the

673−-- stream.

674−--

675−-- @

676−-- S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()

677−-- |$. S.repeatM (threadDelay 1000000 >> return 1)

678−-- @

680+-- > findIndex = fold Fold.findIndex

679681--

680−-- /Concurrent/

681−--

682−-- /Since: 0.3.0 ("Streamly")/

683−--

684−-- @since 0.8.0

685−{-# INLINE (|$.) #-}

686−(|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)

687−-- (|$.) f = f . Async.mkAsync

688−(|$.) f = f . D.mkParallel

689−

690−-- | Same as '|$.'.

691−--

692−-- /Internal/

693−--

694−{-# INLINE foldAsync #-}

695−foldAsync :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)

696−foldAsync = (|$.)

682+-- @since 0.5.0

683+{-# INLINE findIndex #-}

684+findIndex :: Monad m => (a -> Bool) -> SerialT m a -> m (Maybe Int)

685+findIndex p = head . findIndices p

697686

698−-- | Parallel reverse function application operator for applying a run or fold

699−-- functions to a stream. Just like '|$.' except that the operands are reversed.

700−--

701−-- @

702−-- S.repeatM (threadDelay 1000000 >> return 1)

703−-- |&. S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()

704−-- @

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

705688--

706−-- /Concurrent/

689+-- > elemIndex a = findIndex (== a)

707690--

708−-- /Since: 0.3.0 ("Streamly")/

709−--

710−-- @since 0.8.0

711−{-# INLINE (|&.) #-}

712−(|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b

713−x |&. f = f |$. x

691+-- @since 0.5.0

692+{-# INLINE elemIndex #-}

693+elemIndex :: (Monad m, Eq a) => a -> SerialT m a -> m (Maybe Int)

694+elemIndex a = findIndex (== a)

714695

715696------------------------------------------------------------------------------

716−-- Conversions

697+-- To containers

717698------------------------------------------------------------------------------

718699

719700-- |

@@ -822,6 +803,191 @@ toPure = foldr K.cons K.nil

822803toPureRev :: Monad m => SerialT m a -> m (SerialT Identity a)

823804toPureRev = foldl' (flip K.cons) K.nil

824805

806+------------------------------------------------------------------------------

807+-- Concurrent Application

808+------------------------------------------------------------------------------

809+

810+-- | Parallel fold application operator; applies a fold function @t m a -> m b@

811+-- to a stream @t m a@ concurrently; The the input stream is evaluated

812+-- asynchronously in an independent thread yielding elements to a buffer and

813+-- the folding action runs in another thread consuming the input from the

814+-- buffer.

815+--

816+-- If you read the signature as @(t m a -> m b) -> (t m a -> m b)@ you can look

817+-- at it as a transformation that converts a fold function to a buffered

818+-- concurrent fold function.

819+--

820+-- The @.@ at the end of the operator is a mnemonic for termination of the

821+-- stream.

822+--

823+-- @

824+-- S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()

825+-- |$. S.repeatM (threadDelay 1000000 >> return 1)

826+-- @

827+--

828+-- /Concurrent/

829+--

830+-- /Since: 0.3.0 ("Streamly")/

831+--

832+-- @since 0.8.0

833+{-# INLINE (|$.) #-}

834+(|$.) :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)

835+-- (|$.) f = f . Async.mkAsync

836+(|$.) f = f . D.mkParallel

837+

838+infixr 0 |$.

839+

840+-- | Same as '|$.'.

841+--

842+-- /Internal/

843+--

844+{-# INLINE foldAsync #-}

845+foldAsync :: (IsStream t, MonadAsync m) => (t m a -> m b) -> (t m a -> m b)

846+foldAsync = (|$.)

847+

848+-- | Parallel reverse function application operator for applying a run or fold

849+-- functions to a stream. Just like '|$.' except that the operands are reversed.

850+--

851+-- @

852+-- S.repeatM (threadDelay 1000000 >> return 1)

853+-- |&. S.foldlM' (\\_ a -> threadDelay 1000000 >> print a) ()

854+-- @

855+--

856+-- /Concurrent/

857+--

858+-- /Since: 0.3.0 ("Streamly")/

859+--

860+-- @since 0.8.0

861+{-# INLINE (|&.) #-}

862+(|&.) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> m b) -> m b

863+x |&. f = f |$. x

864+

865+infixl 1 |&.

866+

867+------------------------------------------------------------------------------

868+-- Multi-stream folds

869+------------------------------------------------------------------------------

870+

871+-- | Returns 'True' if the first stream is the same as or a prefix of the

872+-- second. A stream is a prefix of itself.

873+--

874+-- @

875+-- > S.isPrefixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

876+-- True

877+-- @

878+--

879+-- @since 0.6.0

880+{-# INLINE isPrefixOf #-}

881+isPrefixOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool

882+isPrefixOf m1 m2 = D.isPrefixOf (toStreamD m1) (toStreamD m2)

883+

884+-- | Returns 'True' if the first stream is an infix of the second. A stream is

885+-- considered an infix of itself.

886+--

887+-- @

888+-- > S.isInfixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

889+-- True

890+-- @

891+--

892+-- Space: @O(n)@ worst case where @n@ is the length of the infix.

893+--

894+-- /Internal/

895+--

896+-- /Requires 'Storable' constraint/ - Help wanted.

897+--

898+{-# INLINE isInfixOf #-}

899+isInfixOf :: (MonadIO m, Eq a, Enum a, Storable a)

900+ => SerialT m a -> SerialT m a -> m Bool

901+isInfixOf infx stream = do

902+ arr <- fold A.write infx

903+ -- XXX can use breakOnSeq instead (when available)

904+ r <- null $ drop 1 $ splitOnSeq arr FL.drain stream

905+ return (not r)

906+

907+-- Note: isPrefixOf uses the prefix stream only once. In contrast, isSuffixOf

908+-- may use the suffix stream many times. To run in optimal memory we do not

909+-- want to buffer the suffix stream in memory therefore we need an ability to

910+-- clone (or consume it multiple times) the suffix stream without any side

911+-- effects so that multiple potential suffix matches can proceed in parallel

912+-- without buffering the suffix stream. For example, we may create the suffix

913+-- stream from a file handle, however, if we evaluate the stream multiple

914+-- times, once for each match, we will need a different file handle each time

915+-- which may exhaust the file descriptors. Instead, we want to share the same

916+-- underlying file descriptor, use pread on it to generate the stream and clone

917+-- the stream for each match. Therefore the suffix stream should be built in

918+-- such a way that it can be consumed multiple times without any problems.

919+

920+-- XXX Can be implemented with better space/time complexity.

921+-- Space: @O(n)@ worst case where @n@ is the length of the suffix.

922+

923+-- | Returns 'True' if the first stream is a suffix of the second. A stream is

924+-- considered a suffix of itself.

925+--

926+-- @

927+-- > S.isSuffixOf (S.fromList "hello") (S.fromList "hello" :: SerialT IO Char)

928+-- True

929+-- @

930+--

931+-- Space: @O(n)@, buffers entire input stream and the suffix.

932+--

933+-- /Internal/

934+--

935+-- /Suboptimal/ - Help wanted.

936+--

937+{-# INLINE isSuffixOf #-}

938+isSuffixOf :: (Monad m, Eq a) => SerialT m a -> SerialT m a -> m Bool

939+isSuffixOf suffix stream = reverse suffix `isPrefixOf` reverse stream

940+

941+-- | Returns 'True' if all the elements of the first stream occur, in order, in

942+-- the second stream. The elements do not have to occur consecutively. A stream

943+-- is a subsequence of itself.

944+--

945+-- @

946+-- > S.isSubsequenceOf (S.fromList "hlo") (S.fromList "hello" :: SerialT IO Char)

947+-- True

948+-- @

949+--

950+-- @since 0.6.0

951+{-# INLINE isSubsequenceOf #-}

952+isSubsequenceOf :: (Eq a, IsStream t, Monad m) => t m a -> t m a -> m Bool

953+isSubsequenceOf m1 m2 = D.isSubsequenceOf (toStreamD m1) (toStreamD m2)

954+

955+-- Note: If we want to return a Maybe value to know whether the

956+-- suffix/infix was present or not along with the stripped stream then

957+-- we need to buffer the whole input stream.

958+--

959+-- | @stripPrefix prefix stream@ strips @prefix@ from @stream@ if it is a

960+-- prefix of stream. Returns 'Nothing' if the stream does not start with the

961+-- given prefix, stripped stream otherwise. Returns @Just nil@ when the prefix

962+-- is the same as the stream.

963+--

964+-- Space: @O(1)@

965+--

966+-- @since 0.6.0

967+{-# INLINE stripPrefix #-}

968+stripPrefix

969+ :: (Eq a, IsStream t, Monad m)

970+ => t m a -> t m a -> m (Maybe (t m a))

971+stripPrefix m1 m2 = fmap fromStreamD <$>

972+ D.stripPrefix (toStreamD m1) (toStreamD m2)

973+

974+-- | Drops the given suffix from a stream. Returns 'Nothing' if the stream does

975+-- not end with the given suffix. Returns @Just nil@ when the suffix is the

976+-- same as the stream.

977+--

978+-- It may be more efficient to convert the stream to an Array and use

979+-- stripSuffix on that especially if the elements have a Storable or Prim

980+-- instance.

981+--

982+-- Space: @O(n)@, buffers the entire input stream as well as the suffix

983+--

984+-- /Internal/

985+{-# INLINE stripSuffix #-}

986+stripSuffix

987+ :: (Monad m, Eq a)

988+ => SerialT m a -> SerialT m a -> m (Maybe (SerialT m a))

989+stripSuffix m1 m2 = fmap reverse <$> stripPrefix (reverse m1) (reverse m2)

990+

825991------------------------------------------------------------------------------

826992-- Comparison

827993------------------------------------------------------------------------------

src/Streamly/Internal/Data/Stream/IsStream/Exception.hs+1−27

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

99module Streamly.Internal.Data.Stream.IsStream.Exception

1010 (

11− -- * Exceptions

1211 before

1312 , after_

1413 , after

@@ -26,20 +25,12 @@ import Control.Exception (Exception)

2625import Control.Monad.Catch (MonadCatch)

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

2827import Control.Monad.Trans.Control (MonadBaseControl)

29−import Streamly.Internal.Data.SVar (MonadAsync)

3028import Streamly.Internal.Data.Stream.StreamD (toStreamD)

3129import Streamly.Internal.Data.Stream.StreamK (IsStream)

30+import Streamly.Internal.Data.SVar (MonadAsync)

3231

3332import qualified Streamly.Internal.Data.Stream.StreamD as D

3433

35−import Prelude hiding

36− ( filter, drop, dropWhile, take, takeWhile, zipWith, foldr

37− , foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem

38− , notElem, maximum, minimum, head, last, tail, length, null

39− , reverse, iterate, init, and, or, lookup, foldr1, (!!)

40− , scanl, scanl1, replicate, concatMap, span, splitAt, break

41− , repeat, concat, mconcat)

42−

4334------------------------------------------------------------------------------

4435-- Exceptions

4536------------------------------------------------------------------------------

@@ -209,20 +200,3 @@ handle :: (IsStream t, MonadCatch m, Exception e)

209200 => (e -> t m a) -> t m a -> t m a

210201handle handler xs =

211202 D.fromStreamD $ D.handle (D.toStreamD . handler) $ D.toStreamD xs

212−

213−-- Keep concating either streams as long as rights are generated, stop as soon

214−-- as a left is generated and concat the left stream.

215−--

216−-- See also: 'handle'

217−--

218−-- /Unimplemented/

219−--

220−{-

221−concatMapEitherWith

222− :: -- (IsStream t, MonadAsync m) =>

223− (forall x. t m x -> t m x -> t m x)

224− -> (a -> t m (Either (t m b) b))

225− -> t m a

226− -> t m b

227−concatMapEitherWith = undefined

228−-}

src/Streamly/Internal/Data/Stream/IsStream/Generate.hs+224−314

@@ -7,23 +7,47 @@

77-- Maintainer : streamly@composewell.com

88-- Stability : experimental

99-- Portability : GHC

10+--

11+-- Most of the combinators in this module can be implemented as unfolds. Some

12+-- of them however can only be expressed in terms StreamK e.g. cons/consM,

13+-- fromFoldable, mfix. We can possibly remove those from this module which can

14+-- be expressed as unfolds. Unless we want to use rewrite rules to rewrite them

15+-- as StreamK when StreamK is used, avoiding conversion to StreamD. Will that

16+-- help? Are there any other reasons to keep these and not use unfolds?

1017

1118module Streamly.Internal.Data.Stream.IsStream.Generate

1219 (

13− -- ** From Values

14− yield

20+ -- * Primitives

21+ K.nil

22+ , K.nilM

23+ , K.cons

24+ , (K..:)

25+

26+ , consM

27+ , (|:)

28+

29+ -- * From 'Unfold'

30+ , unfold

31+ , unfold0

32+

33+ -- * Unfolding

34+ , unfoldr

35+ , unfoldrM

36+

37+ -- * From Values

38+ , yield

1539 , yieldM

1640 , repeat

1741 , repeatM

1842 , replicate

1943 , replicateM

2044

21− -- ** Enumeration

22− -- , Enumerable (..)

23− -- , enumerate

24− -- , enumerateTo

45+ -- * Enumeration

46+ , Enumerable (..)

47+ , enumerate

48+ , enumerateTo

2549

26− -- ** Time Enumeration

50+ -- * Time Enumeration

2751 , times

2852 , absTimes

2953 , absTimesWith

@@ -32,33 +56,32 @@ module Streamly.Internal.Data.Stream.IsStream.Generate

3256 , durations

3357 , ticks

3458 , timeout

35− , currentTime

3659

37− -- ** From Generators

38− , unfoldr

39− , unfoldrM

40− , unfold

41− , unfold0

60+ -- * From Generators

4261 , fromIndices

4362 , fromIndicesM

63+ -- , generate

64+ -- , generateM

4465

45− -- ** Iteration

66+ -- * Iteration

4667 , iterate

4768 , iterateM

4869

49− -- ** Cyclic Elements

70+ -- * Cyclic Elements

5071 , K.mfix

5172

52− -- ** From Containers

73+ -- * From Containers

5374 , P.fromList

5475 , fromListM

5576 , K.fromFoldable

5677 , fromFoldableM

5778 , fromPrimIORef

79+ , fromCallback

5880

5981 -- * Deprecated

6082 , each

6183 , fromHandle

84+ , currentTime

6285 )

6386where

6487

@@ -68,37 +91,50 @@ import Control.Monad.IO.Class (MonadIO(..))

6891import Data.Void (Void)

6992import Streamly.Internal.Data.Unfold.Types (Unfold)

7093import Streamly.Internal.Data.SVar (MonadAsync, Rate (..))

94+import Streamly.Internal.Data.Stream.Enumeration

95+ (Enumerable(..), enumerate, enumerateTo)

96+import Streamly.Internal.Data.Stream.IsStream.Common

97+ (absTimesWith, concatM, relTimesWith, timesWith, yield, yieldM, repeatM)

7198import Streamly.Internal.Data.Stream.Prelude (fromStreamS)

7299import Streamly.Internal.Data.Stream.StreamD (fromStreamD)

73−import Streamly.Internal.Data.Stream.StreamK (IsStream(consM))

100+import Streamly.Internal.Data.Stream.StreamK (IsStream((|:), consM))

74101import Streamly.Internal.Data.Stream.Serial (SerialT, WSerialT)

75102import Streamly.Internal.Data.Stream.Zip (ZipSerialM)

76−import Streamly.Internal.Data.Time.Units

77− ( AbsTime

78− , RelTime64, addToAbsTime64)

103+import Streamly.Internal.Data.Time.Units (AbsTime , RelTime64, addToAbsTime64)

79104import Streamly.Internal.Data.IORef.Prim (Prim, IORef)

80105

81106import qualified Streamly.Internal.Data.Stream.Prelude as P

82−import qualified Streamly.Internal.Data.Stream.StreamK as K

83−import qualified Streamly.Internal.Data.Stream.StreamD as D (toStreamK)

84−import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D

85107import qualified Streamly.Internal.Data.Stream.Serial as Serial

86−import qualified Prelude

87−import qualified System.IO as IO

108+import qualified Streamly.Internal.Data.Stream.StreamD.Generate as D

109+import qualified Streamly.Internal.Data.Stream.StreamK as K

88110#ifdef USE_STREAMK_ONLY

89111import qualified Streamly.Internal.Data.Stream.StreamK as S

90112#else

91−import qualified Streamly.Internal.Data.Stream.StreamD as S (toStreamK)

92113import qualified Streamly.Internal.Data.Stream.StreamD.Generate as S

93114#endif

115+import qualified System.IO as IO

116+

117+import Prelude hiding (iterate, replicate, repeat)

118+

119+------------------------------------------------------------------------------

120+-- From Unfold

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

94122

95−import Prelude hiding

96− ( filter, drop, dropWhile, take, takeWhile, zipWith, foldr

97− , foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem

98− , notElem, maximum, minimum, head, last, tail, length, null

99− , reverse, iterate, init, and, or, lookup, foldr1, (!!)

100− , scanl, scanl1, replicate, concatMap, span, splitAt, break

101− , repeat, concat, mconcat)

123+-- | Convert an 'Unfold' into a stream by supplying it an input seed.

124+--

125+-- >>> unfold (UF.replicateM 10) (putStrLn "hello")

126+--

127+-- /Since: 0.7.0/

128+{-# INLINE unfold #-}

129+unfold :: (IsStream t, Monad m) => Unfold m a b -> a -> t m b

130+unfold unf x = fromStreamD $ D.unfold unf x

131+

132+-- | Convert an 'Unfold' with a closed input end into a stream.

133+--

134+-- /Internal/

135+{-# INLINE unfold0 #-}

136+unfold0 :: (IsStream t, Monad m) => Unfold m Void b -> t m b

137+unfold0 unf = unfold unf (error "unfold0: unexpected void evaluation")

102138

103139------------------------------------------------------------------------------

104140-- Generation by Unfolding

@@ -185,69 +221,158 @@ unfoldrMWSerial = Serial.unfoldrM

185221unfoldrMZipSerial :: MonadAsync m => (b -> m (Maybe (a, b))) -> b -> ZipSerialM m a

186222unfoldrMZipSerial = Serial.unfoldrM

187223

188−-- | Convert an 'Unfold' into a stream by supplying it an input seed.

224+------------------------------------------------------------------------------

225+-- From Values

226+------------------------------------------------------------------------------

227+

228+-- |

229+-- Generate an infinite stream by repeating a pure value.

189230--

190−-- >>> unfold (UF.replicateM 10) (putStrLn "hello")

231+-- @since 0.4.0

232+{-# INLINE_NORMAL repeat #-}

233+repeat :: (IsStream t, Monad m) => a -> t m a

234+repeat = fromStreamS . S.repeat

235+

236+-- |

237+-- @

238+-- replicate = take n . repeat

239+-- @

191240--

192−-- /Since: 0.7.0/

193−{-# INLINE unfold #-}

194−unfold :: (IsStream t, Monad m) => Unfold m a b -> a -> t m b

195−unfold unf x = fromStreamD $ D.unfold unf x

241+-- Generate a stream of length @n@ by repeating a value @n@ times.

242+--

243+-- @since 0.6.0

244+{-# INLINE_NORMAL replicate #-}

245+replicate :: (IsStream t, Monad m) => Int -> a -> t m a

246+replicate n = fromStreamS . S.replicate n

196247

197−-- | Convert an 'Unfold' with a closed input end into a stream.

248+-- |

249+-- @

250+-- replicateM = take n . repeatM

251+-- @

198252--

199−-- /Internal/

200−{-# INLINE unfold0 #-}

201−unfold0 :: (IsStream t, Monad m) => Unfold m Void b -> t m b

202−unfold0 unf = unfold unf (error "unfold0: unexpected void evaluation")

253+-- Generate a stream by performing a monadic action @n@ times. Same as:

254+--

255+-- @

256+-- drain $ serially $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)

257+-- drain $ asyncly $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)

258+-- @

259+--

260+-- /Concurrent/

261+--

262+-- @since 0.1.1

263+{-# INLINE_EARLY replicateM #-}

264+replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a

265+replicateM = K.replicateM

266+

267+{-# RULES "replicateM serial" replicateM = replicateMSerial #-}

268+{-# INLINE replicateMSerial #-}

269+replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a

270+replicateMSerial n = fromStreamS . S.replicateM n

203271

204272------------------------------------------------------------------------------

205−-- Specialized Generation

273+-- Time Enumeration

206274------------------------------------------------------------------------------

207275

208−-- Faster than yieldM because there is no bind.

276+-- | @times@ returns a stream of time value tuples with clock of 10 ms

277+-- granularity. The first component of the tuple is an absolute time reference

278+-- (epoch) denoting the start of the stream and the second component is a time

279+-- relative to the reference.

209280--

210−-- |

211281-- @

212−-- yield a = a \`cons` nil

282+-- >>> S.mapM_ (\x -> print x >> threadDelay 1000000) $ S.times

283+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 0))

284+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1002028000))

285+-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1996656000))

213286-- @

214287--

215−-- Create a singleton stream from a pure value.

288+-- Note: This API is not safe on 32-bit machines.

216289--

217−-- The following holds in monadic streams, but not in Zip streams:

290+-- /Internal/

291+--

292+{-# INLINE times #-}

293+times :: (IsStream t, MonadAsync m) => t m (AbsTime, RelTime64)

294+times = timesWith 0.01

295+

296+-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms

297+-- granularity.

218298--

219299-- @

220−-- yield = pure

221−-- yield = yieldM . pure

300+-- >>> S.mapM_ print $ S.delayPre 1 $ S.absTimes

222301-- @

223302--

224−-- In Zip applicative streams 'yield' is not the same as 'pure' because in that

225−-- case 'pure' is equivalent to 'repeat' instead. 'yield' and 'pure' are

226−-- equally efficient, in other cases 'yield' may be slightly more efficient

227−-- than the other equivalent definitions.

303+-- Note: This API is not safe on 32-bit machines.

228304--

229−-- @since 0.4.0

230−{-# INLINE yield #-}

231−yield :: IsStream t => a -> t m a

232−yield = K.yield

305+-- /Internal/

306+--

307+{-# INLINE absTimes #-}

308+absTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m AbsTime

309+absTimes = fmap (uncurry addToAbsTime64) times

233310

234−-- |

311+{-# DEPRECATED currentTime "Please use absTimes instead" #-}

312+{-# INLINE currentTime #-}

313+currentTime :: (IsStream t, MonadAsync m, Functor (t m))

314+ => Double -> t m AbsTime

315+currentTime = absTimesWith

316+

317+-- | @relTimes@ returns a stream of relative time values starting from 0,

318+-- using a clock of granularity 10 ms.

319+--

235320-- @

236−-- yieldM m = m \`consM` nil

321+-- >>> S.mapM_ print $ S.delayPre 1 $ S.relTimes

237322-- @

238323--

239−-- Create a singleton stream from a monadic action.

324+-- Note: This API is not safe on 32-bit machines.

240325--

241−-- @

242−-- > toList $ yieldM getLine

243−-- hello

244−-- ["hello"]

245−-- @

326+-- /Internal/

246327--

247−-- @since 0.4.0

248−{-# INLINE yieldM #-}

249−yieldM :: (Monad m, IsStream t) => m a -> t m a

250−yieldM = K.yieldM

328+{-# INLINE relTimes #-}

329+relTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m RelTime64

330+relTimes = fmap snd times

331+

332+-- | @durations g@ returns a stream of relative time values measuring the time

333+-- elapsed since the immediate predecessor element of the stream was generated.

334+-- The first element of the stream is always 0. @durations@ uses a clock of

335+-- granularity @g@ specified in seconds. A low granularity clock is more

336+-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.

337+-- Durations lower than 1 ms will be 0.

338+--

339+-- Note: This API is not safe on 32-bit machines.

340+--

341+-- /Unimplemented/

342+--

343+{-# INLINE durations #-}

344+durations :: -- (IsStream t, MonadAsync m) =>

345+ Double -> t m RelTime64

346+durations = undefined

347+

348+-- | Generate ticks at the specified rate. The rate is adaptive, the tick

349+-- generation speed can be increased or decreased at different times to achieve

350+-- the specified rate. The specific behavior for different styles of 'Rate'

351+-- specifications is documented under 'Rate'. The effective maximum rate

352+-- achieved by a stream is governed by the processor speed.

353+--

354+-- /Unimplemented/

355+--

356+{-# INLINE ticks #-}

357+ticks :: -- (IsStream t, MonadAsync m) =>

358+ Rate -> t m ()

359+ticks = undefined

360+

361+-- | Generate a singleton event at or after the specified absolute time. Note

362+-- that this is different from a threadDelay, a threadDelay starts from the

363+-- time when the action is evaluated, whereas if we use AbsTime based timeout

364+-- it will immediately expire if the action is evaluated too late.

365+--

366+-- /Unimplemented/

367+--

368+{-# INLINE timeout #-}

369+timeout :: -- (IsStream t, MonadAsync m) =>

370+ AbsTime -> t m ()

371+timeout = undefined

372+

373+------------------------------------------------------------------------------

374+-- From Generator functions

375+------------------------------------------------------------------------------

251376

252377-- |

253378-- @

@@ -288,74 +413,9 @@ fromIndicesM = K.fromIndicesM

288413fromIndicesMSerial :: MonadAsync m => (Int -> m a) -> SerialT m a

289414fromIndicesMSerial = fromStreamS . S.fromIndicesM

290415

291−-- |

292−-- @

293−-- replicateM = take n . repeatM

294−-- @

295−--

296−-- Generate a stream by performing a monadic action @n@ times. Same as:

297−--

298−-- @

299−-- drain $ serially $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)

300−-- drain $ asyncly $ S.replicateM 10 $ (threadDelay 1000000 >> print 1)

301−-- @

302−--

303−-- /Concurrent/

304−--

305−-- @since 0.1.1

306−{-# INLINE_EARLY replicateM #-}

307−replicateM :: (IsStream t, MonadAsync m) => Int -> m a -> t m a

308−replicateM = K.replicateM

309−

310−{-# RULES "replicateM serial" replicateM = replicateMSerial #-}

311−{-# INLINE replicateMSerial #-}

312−replicateMSerial :: MonadAsync m => Int -> m a -> SerialT m a

313−replicateMSerial n = fromStreamS . S.replicateM n

314−

315−-- |

316−-- @

317−-- replicate = take n . repeat

318−-- @

319−--

320−-- Generate a stream of length @n@ by repeating a value @n@ times.

321−--

322−-- @since 0.6.0

323−{-# INLINE_NORMAL replicate #-}

324−replicate :: (IsStream t, Monad m) => Int -> a -> t m a

325−replicate n = fromStreamS . S.replicate n

326−

327−-- |

328−-- Generate an infinite stream by repeating a pure value.

329−--

330−-- @since 0.4.0

331−{-# INLINE_NORMAL repeat #-}

332−repeat :: (IsStream t, Monad m) => a -> t m a

333−repeat = fromStreamS . S.repeat

334−

335−-- |

336−-- @

337−-- repeatM = fix . consM

338−-- repeatM = cycle1 . yieldM

339−-- @

340−--

341−-- Generate a stream by repeatedly executing a monadic action forever.

342−--

343−-- @

344−-- drain $ serially $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)

345−-- drain $ asyncly $ S.take 10 $ S.repeatM $ (threadDelay 1000000 >> print 1)

346−-- @

347−--

348−-- /Concurrent, infinite (do not use with 'parallely')/

349−--

350−-- @since 0.2.0

351−{-# INLINE_EARLY repeatM #-}

352−repeatM :: (IsStream t, MonadAsync m) => m a -> t m a

353−repeatM = K.repeatM

354−

355−{-# RULES "repeatM serial" repeatM = repeatMSerial #-}

356−{-# INLINE repeatMSerial #-}

357−repeatMSerial :: MonadAsync m => m a -> SerialT m a

358−repeatMSerial = fromStreamS . S.repeatM

416+------------------------------------------------------------------------------

417+-- Iterating functions

418+------------------------------------------------------------------------------

359419

360420-- |

361421-- @

@@ -416,21 +476,6 @@ iterateMSerial step = fromStreamS . S.iterateM step

416476-- Conversions

417477------------------------------------------------------------------------------

418478

419−-- |

420−-- @

421−-- fromListM = 'Prelude.foldr' 'K.consM' 'K.nil'

422−-- @

423−--

424−-- Construct a stream from a list of monadic actions. This is more efficient

425−-- than 'fromFoldableM' for serial streams.

426−--

427−-- @since 0.4.0

428−{-# INLINE_EARLY fromListM #-}

429−fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a

430−fromListM = fromStreamD . D.fromListM

431−{-# RULES "fromListM fallback to StreamK" [1]

432− forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}

433−

434479-- |

435480-- @

436481-- fromFoldableM = 'Prelude.foldr' 'consM' 'K.nil'

@@ -450,6 +495,21 @@ fromListM = fromStreamD . D.fromListM

450495fromFoldableM :: (IsStream t, MonadAsync m, Foldable f) => f (m a) -> t m a

451496fromFoldableM = Prelude.foldr consM K.nil

452497

498+-- |

499+-- @

500+-- fromListM = 'Prelude.foldr' 'K.consM' 'K.nil'

501+-- @

502+--

503+-- Construct a stream from a list of monadic actions. This is more efficient

504+-- than 'fromFoldableM' for serial streams.

505+--

506+-- @since 0.4.0

507+{-# INLINE_EARLY fromListM #-}

508+fromListM :: (MonadAsync m, IsStream t) => [m a] -> t m a

509+fromListM = fromStreamD . D.fromListM

510+{-# RULES "fromListM fallback to StreamK" [1]

511+ forall a. D.toStreamK (D.fromListM a) = fromFoldableM a #-}

512+

453513-- | Same as 'fromFoldable'.

454514--

455515-- @since 0.1.0

@@ -482,165 +542,15 @@ fromHandle h = go

482542fromPrimIORef :: (IsStream t, MonadIO m, Prim a) => IORef a -> t m a

483543fromPrimIORef = fromStreamD . D.fromPrimIORef

484544

485−------------------------------------------------------------------------------

486−-- Time related

487−------------------------------------------------------------------------------

488−

489−-- | @timesWith g@ returns a stream of time value tuples. The first component

490−-- of the tuple is an absolute time reference (epoch) denoting the start of the

491−-- stream and the second component is a time relative to the reference.

492−--

493−-- The argument @g@ specifies the granularity of the relative time in seconds.

494−-- A lower granularity clock gives higher precision but is more expensive in

495−-- terms of CPU usage. Any granularity lower than 1 ms is treated as 1 ms.

496−--

497−-- @

498−-- >>> S.mapM_ (\x -> print x >> threadDelay 1000000) $ S.timesWith 0.01

499−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 0))

500−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1002028000))

501−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1996656000))

502−-- @

503−--

504−-- Note: This API is not safe on 32-bit machines.

505−--

506−-- /Internal/

507−--

508−{-# INLINE timesWith #-}

509−timesWith :: (IsStream t, MonadAsync m) => Double -> t m (AbsTime, RelTime64)

510−timesWith g = fromStreamD $ D.times g

511−

512−-- | @times@ returns a stream of time value tuples with clock of 10 ms

513−-- granularity. The first component of the tuple is an absolute time reference

514−-- (epoch) denoting the start of the stream and the second component is a time

515−-- relative to the reference.

516−--

517−-- @

518−-- >>> S.mapM_ (\x -> print x >> threadDelay 1000000) $ S.times

519−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 0))

520−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1002028000))

521−-- > (AbsTime (TimeSpec {sec = 2496295, nsec = 536223000}),RelTime64 (NanoSecond64 1996656000))

522−-- @

523−--

524−-- Note: This API is not safe on 32-bit machines.

525−--

526−-- /Internal/

527−--

528−{-# INLINE times #-}

529−times :: (IsStream t, MonadAsync m) => t m (AbsTime, RelTime64)

530−times = timesWith 0.01

531−

532−-- | @absTimesWith g@ returns a stream of absolute timestamps using a clock of

533−-- granularity @g@ specified in seconds. A low granularity clock is more

534−-- expensive in terms of CPU usage. Any granularity lower than 1 ms is treated

535−-- as 1 ms.

536−--

537−-- @

538−-- >>> S.mapM_ print $ S.delayPre 1 $ S.absTimesWith 0.01

539−-- @

540−--

541−-- Note: This API is not safe on 32-bit machines.

542−--

543−-- /Internal/

544−--

545−{-# INLINE absTimesWith #-}

546−absTimesWith :: (IsStream t, MonadAsync m, Functor (t m))

547− => Double -> t m AbsTime

548−absTimesWith = fmap (uncurry addToAbsTime64) . timesWith

549−

550−-- | @absTimes@ returns a stream of absolute timestamps using a clock of 10 ms

551−-- granularity.

552−--

553−-- @

554−-- >>> S.mapM_ print $ S.delayPre 1 $ S.absTimes

555−-- @

556−--

557−-- Note: This API is not safe on 32-bit machines.

558−--

559−-- /Internal/

560−--

561−{-# INLINE absTimes #-}

562−absTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m AbsTime

563−absTimes = fmap (uncurry addToAbsTime64) times

564−

565−{-# DEPRECATED currentTime "Please use absTimes instead" #-}

566−{-# INLINE currentTime #-}

567−currentTime :: (IsStream t, MonadAsync m, Functor (t m))

568− => Double -> t m AbsTime

569−currentTime = absTimesWith

570−

571−-- | @relTimesWith g@ returns a stream of relative time values starting from 0,

572−-- using a clock of granularity @g@ specified in seconds. A low granularity

573−-- clock is more expensive in terms of CPU usage. Any granularity lower than 1

574−-- ms is treated as 1 ms.

575−--

576−-- @

577−-- >>> S.mapM_ print $ S.delayPre 1 $ S.relTimesWith 0.01

578−-- > RelTime64 (NanoSecond64 0)

579−-- > RelTime64 (NanoSecond64 91139000)

580−-- > RelTime64 (NanoSecond64 204052000)

581−-- @

582−--

583−-- Note: This API is not safe on 32-bit machines.

545+-- | Takes a callback setter function and provides it with a callback. The

546+-- callback when invoked adds a value at the tail of the stream. Returns a

547+-- stream of values generated by the callback.

584548--

585549-- /Internal/

586550--

587−{-# INLINE relTimesWith #-}

588−relTimesWith :: (IsStream t, MonadAsync m, Functor (t m))

589− => Double -> t m RelTime64

590−relTimesWith = fmap snd . timesWith

591−

592−-- | @relTimes@ returns a stream of relative time values starting from 0,

593−-- using a clock of granularity 10 ms.

594−--

595−-- @

596−-- >>> S.mapM_ print $ S.delayPre 1 $ S.relTimes

597−-- @

598−--

599−-- Note: This API is not safe on 32-bit machines.

600−--

601−-- /Internal/

602−--

603−{-# INLINE relTimes #-}

604−relTimes :: (IsStream t, MonadAsync m, Functor (t m)) => t m RelTime64

605−relTimes = fmap snd times

606−

607−-- | @durations g@ returns a stream of relative time values measuring the time

608−-- elapsed since the immediate predecessor element of the stream was generated.

609−-- The first element of the stream is always 0. @durations@ uses a clock of

610−-- granularity @g@ specified in seconds. A low granularity clock is more

611−-- expensive in terms of CPU usage. The minimum granularity is 1 millisecond.

612−-- Durations lower than 1 ms will be 0.

613−--

614−-- Note: This API is not safe on 32-bit machines.

615−--

616−-- /Unimplemented/

617−--

618−{-# INLINE durations #-}

619−durations :: -- (IsStream t, MonadAsync m) =>

620− Double -> t m RelTime64

621−durations = undefined

622−

623−-- | Generate ticks at the specified rate. The rate is adaptive, the tick

624−-- generation speed can be increased or decreased at different times to achieve

625−-- the specified rate. The specific behavior for different styles of 'Rate'

626−-- specifications is documented under 'Rate'. The effective maximum rate

627−-- achieved by a stream is governed by the processor speed.

628−--

629−-- /Unimplemented/

630−--

631−{-# INLINE ticks #-}

632−ticks :: -- (IsStream t, MonadAsync m) =>

633− Rate -> t m ()

634−ticks = undefined

635−

636−-- | Generate a singleton event at or after the specified absolute time. Note

637−-- that this is different from a threadDelay, a threadDelay starts from the

638−-- time when the action is evaluated, whereas if we use AbsTime based timeout

639−-- it will immediately expire if the action is evaluated too late.

640−--

641−-- /Unimplemented/

642−--

643−{-# INLINE timeout #-}

644−timeout :: -- (IsStream t, MonadAsync m) =>

645− AbsTime -> t m ()

646−timeout = undefined

551+{-# INLINE fromCallback #-}

552+fromCallback :: MonadAsync m => ((a -> m ()) -> m ()) -> SerialT m a

553+fromCallback setCallback = concatM $ do

554+ (callback, stream) <- D.newCallbackStream

555+ setCallback callback

556+ return stream

src/Streamly/Internal/Data/Stream/IsStream/Lift.hsnew file+148

@@ -0,0 +1,148 @@

1+-- |

2+-- Module : Streamly.Internal.Data.Stream.IsStream.Lift

4+-- License : BSD-3-Clause

5+-- Maintainer : streamly@composewell.com

6+-- Stability : experimental

7+-- Portability : GHC

9+module Streamly.Internal.Data.Stream.IsStream.Lift

10+ (

11+ -- * Generalize Inner Monad

12+ hoist

13+ , generally

14+

15+ -- * Transform Inner Monad

16+ , liftInner

17+ , usingReaderT

18+ , runReaderT

19+ , evalStateT

20+ , usingStateT

21+ , runStateT

22+ )

23+where

24+

25+#include "inline.hs"

26+

27+import Control.Monad.Trans.Reader (ReaderT)

28+import Control.Monad.Trans.State.Strict (StateT)

29+import Control.Monad.Trans.Class (MonadTrans(..))

30+import Data.Functor.Identity (Identity (..))

31+import Streamly.Internal.Data.Stream.Prelude (fromStreamS, toStreamS)

32+import Streamly.Internal.Data.Stream.Serial (SerialT)

33+import Streamly.Internal.Data.Stream.StreamD (fromStreamD, toStreamD)

34+import Streamly.Internal.Data.Stream.StreamK (IsStream)

35+

36+import qualified Streamly.Internal.Data.Stream.StreamD as D

37+#ifdef USE_STREAMK_ONLY

38+import qualified Streamly.Internal.Data.Stream.StreamK as S

39+#else

40+import qualified Streamly.Internal.Data.Stream.StreamD as S

41+#endif

42+

43+------------------------------------------------------------------------------

44+-- Generalize the underlying monad

45+------------------------------------------------------------------------------

46+

47+-- | Transform the inner monad of a stream using a natural transformation.

48+--

49+-- / Internal/

50+--

51+{-# INLINE hoist #-}

52+hoist :: (Monad m, Monad n)

53+ => (forall x. m x -> n x) -> SerialT m a -> SerialT n a

54+hoist f xs = fromStreamS $ S.hoist f (toStreamS xs)

55+

56+-- | Generalize the inner monad of the stream from 'Identity' to any monad.

57+--

58+-- / Internal/

59+--

60+{-# INLINE generally #-}

61+generally :: (IsStream t, Monad m) => t Identity a -> t m a

62+generally xs = fromStreamS $ S.hoist (return . runIdentity) (toStreamS xs)

63+

64+------------------------------------------------------------------------------

65+-- Add and remove a monad transformer

66+------------------------------------------------------------------------------

67+

68+-- | Lift the inner monad @m@ of a stream @t m a@ to @tr m@ using the monad

69+-- transformer @tr@.

70+--

71+-- / Internal/

72+--

73+{-# INLINE liftInner #-}

74+liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m))

75+ => t m a -> t (tr m) a

76+liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)

77+

78+------------------------------------------------------------------------------

79+-- Sharing read only state in a stream

80+------------------------------------------------------------------------------

81+

82+-- | Evaluate the inner monad of a stream as 'ReaderT'.

83+--

84+-- / Internal/

85+--

86+{-# INLINE runReaderT #-}

87+runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a

88+runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)

89+

90+-- | Run a stream transformation using a given environment.

91+--

92+-- See also: 'Serial.map'

93+--

94+-- / Internal/

95+--

96+{-# INLINE usingReaderT #-}

97+usingReaderT

98+ :: (Monad m, IsStream t)

99+ => m r

100+ -> (t (ReaderT r m) a -> t (ReaderT r m) a)

101+ -> t m a

102+ -> t m a

103+usingReaderT r f xs = runReaderT r $ f $ liftInner xs

104+

105+------------------------------------------------------------------------------

106+-- Sharing read write state in a stream

107+------------------------------------------------------------------------------

108+

109+-- | Evaluate the inner monad of a stream as 'StateT'.

110+--

111+-- This is supported only for 'SerialT' as concurrent state updation may not be

112+-- safe.

113+--

114+-- / Internal/

115+--

116+{-# INLINE evalStateT #-}

117+evalStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m a

118+evalStateT s xs = fromStreamD $ D.evalStateT s (toStreamD xs)

119+

120+-- | Run a stateful (StateT) stream transformation using a given state.

121+--

122+-- This is supported only for 'SerialT' as concurrent state updation may not be

123+-- safe.

124+--

125+-- See also: 'scanl''

126+--

127+-- / Internal/

128+--

129+{-# INLINE usingStateT #-}

130+usingStateT

131+ :: Monad m

132+ => m s

133+ -> (SerialT (StateT s m) a -> SerialT (StateT s m) a)

134+ -> SerialT m a

135+ -> SerialT m a

136+usingStateT s f xs = evalStateT s $ f $ liftInner xs

137+

138+-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting

139+-- state and value pair after each step.

140+--

141+-- This is supported only for 'SerialT' as concurrent state updation may not be

142+-- safe.

143+--

144+-- / Internal/

145+--

146+{-# INLINE runStateT #-}

147+runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)

148+runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)

src/Streamly/Internal/Data/Stream/IsStream/Nesting.hsnew file+2098

@@ -0,0 +1,2098 @@

1+-- |

2+-- Module : Streamly.Internal.Data.Stream.IsStream.Nesting

4+-- License : BSD-3-Clause

5+-- Maintainer : streamly@composewell.com

6+-- Stability : experimental

7+-- Portability : GHC

8+--

9+-- Transformations involving multiple streams, streams and unfolds or streams

10+-- and folds.

11+

12+module Streamly.Internal.Data.Stream.IsStream.Nesting

13+ (

14+ -- * Generate

15+ -- | Combining streams to generate streams.

16+

17+ -- ** Combine Two Streams

18+ -- | Functions ending in the shape:

19+ --

20+ -- @t m a -> t m a -> t m a@.

21+

22+ -- *** Appending

23+ serial

24+ , append

25+

26+ -- *** Interleaving

27+ , interleave

28+ , interleaveMin

29+ , interleaveSuffix

30+ , interleaveInfix

31+

32+ , wSerial

33+ , Serial.wSerialFst

34+ , Serial.wSerialMin

35+

36+ -- *** Scheduling

37+ , ahead

38+ , async

39+ , wAsync

40+ , roundrobin

41+

42+ -- *** Parallel

43+ , parallel

44+ , Par.parallelFst

45+ , Par.parallelMin

46+

47+ -- *** Zipping

48+ , Z.zipWith

49+ , Z.zipWithM

50+ , Z.zipAsyncWith

51+ , Z.zipAsyncWithM

52+

53+ -- *** Merging

54+ -- , merge

55+ , mergeBy

56+ , mergeByM

57+ , mergeAsyncBy

58+ , mergeAsyncByM

59+

60+ -- ** Combine N Streams

61+ -- | Functions generally ending in these shapes:

62+ --

63+ -- @

64+ -- concat: f (t m a) -> t m a

65+ -- concatMap: (a -> t m b) -> t m a -> t m b

66+ -- concatUnfold: Unfold m a b -> t m a -> t m b

67+ -- @

68+

69+ -- *** Flatten Containers of Streams

70+ , concatM

71+ , concat

72+ , concatFoldableWith

73+

74+ -- *** ConcatMap

75+ -- | Map and flatten streams.

76+ , concatMapFoldableWith

77+ , concatForFoldableWith

78+ , concatMap

79+ , concatMapM

80+ , concatMapWith

81+ , concatSmapMWith

82+ -- , bindWith

83+

84+ -- *** ConcatUnfold

85+ -- | Unfold and flatten streams.

86+ , concatUnfold

87+ , concatUnfoldInterleave

88+ , concatUnfoldRoundrobin

89+

90+ -- *** Interpose

91+ -- | Insert effects between streams. Like concatUnfold but intersperses an

92+ -- effect between the streams. A

93+ -- special case of gintercalate.

94+ , interpose

95+ , interposeSuffix

96+ -- , interposeBy

97+

98+ -- *** Intercalate

99+ -- | Insert Streams between Streams.

100+ -- Like concatUnfold but intersperses streams from another source between

101+ -- the streams from the first source.

102+ , intercalate

103+ , intercalateSuffix

104+ , gintercalate

105+ , gintercalateSuffix

106+

107+ -- *** IterateMap

108+ -- | Map and flatten Trees of Streams

109+ , iterateMapWith

110+ , iterateSmapMWith

111+ , iterateMapLeftsWith

112+

113+ -- * Eliminate

114+ -- | Folding and Parsing chunks of streams to eliminate nested streams.

115+ -- Functions generally ending in these shapes:

116+ --

117+ -- @

118+ -- f (Fold m a b) -> t m a -> t m b

119+ -- f (Parser m a b) -> t m a -> t m b

120+ -- @

121+

122+ -- ** Folding

123+ -- | Apply folds on a stream.

124+ , foldMany

125+ , foldSequence

126+ , foldIterate

127+

128+ -- ** Parsing

129+ -- | Apply parsers on a stream.

130+ , parseMany

131+ , parseManyD

132+ , parseManyTill

133+ , parseSequence

134+ , parseIterate

135+

136+ -- ** Chunking

137+ -- | Element unaware grouping.

138+ , chunksOf

139+ , chunksOf2

140+ , arraysOf

141+ , intervalsOf

142+

143+ -- ** Trimming

144+ , dropPrefix

145+ , dropInfix

146+ , dropSuffix

147+

148+ -- ** Grouping

149+ -- In imperative terms, grouped folding can be considered as a nested loop

150+ -- where we loop over the stream to group elements and then loop over

151+ -- individual groups to fold them to a single value that is yielded in the

152+ -- output stream.

153+

154+ , groups

155+ , groupsBy

156+ , groupsByRolling

157+

158+ -- -- *** Searching Sequences

159+ -- , seqIndices -- search a sequence in the stream

160+

161+ -- -- *** Searching Multiple Sequences

162+ -- , seqIndicesAny -- search any of the given sequence in the stream

163+

164+ -- -- -- ** Searching Streams

165+ -- -- | Finding a stream within another stream.

166+

167+ -- ** Splitting

168+ -- | Streams can be sliced into segments in space or in time. We use the

169+ -- term @chunk@ to refer to a spatial length of the stream (spatial window)

170+ -- and the term @session@ to refer to a length in time (time window).

171+

172+ -- -- *** Using Element Separators

173+ , splitOn

174+ , splitOnSuffix

175+ -- , splitOnPrefix

176+

177+ -- , splitBy

178+ , splitWithSuffix

179+ -- , splitByPrefix

180+ , wordsBy -- stripAndCompactBy

181+

182+ -- -- *** Splitting By Sequences

183+ , splitBySeq

184+ , splitOnSeq

185+ , splitOnSuffixSeq

186+ -- , splitOnPrefixSeq

187+

188+ -- Keeping the delimiters

189+ , splitWithSuffixSeq

190+ -- , splitByPrefixSeq

191+ -- , wordsBySeq

192+

193+ -- Splitting using multiple sequence separators

194+ -- , splitOnAnySeq

195+ -- , splitOnAnySuffixSeq

196+ -- , splitOnAnyPrefixSeq

197+

198+ -- -- *** Splitting By Streams

199+ -- -- | Splitting a stream using another stream as separator.

200+

201+ -- ** Classifying

202+ -- | De-interleaving groups.

203+ , classifySessionsOf

204+ , classifyKeepAliveSessions

205+ , classifySessionsBy

206+

207+ -- * Transform (Nested Containers)

208+ -- Nested splitting

209+ , splitInnerBy

210+ , splitInnerBySuffix

211+ )

212+where

213+

214+#include "inline.hs"

215+

216+import Control.Concurrent (threadDelay)

217+import Control.Exception (assert)

218+import Control.Monad.Catch (MonadThrow)

219+import Control.Monad.IO.Class (MonadIO(..))

220+import Data.Heap (Entry(..))

221+import Data.Kind (Type)

222+import Data.Maybe (isNothing)

223+import Foreign.Storable (Storable)

224+import Streamly.Internal.Data.Fold.Types (Fold (..), Fold2 (..))

225+import Streamly.Internal.Data.Parser (Parser (..))

226+import Streamly.Internal.Data.Unfold.Types (Unfold)

227+import Streamly.Internal.Data.Array.Storable.Foreign.Types

228+ (Array, writeNUnsafe)

229+import Streamly.Internal.Data.SVar (MonadAsync)

230+import Streamly.Internal.Data.Stream.Ahead (ahead)

231+import Streamly.Internal.Data.Stream.Async (async, wAsync)

232+import Streamly.Internal.Data.Stream.IsStream.Common

233+ ( concatM

234+ , concatMapM

235+ , fold

236+ , interjectSuffix

237+ , intersperseM

238+ , repeatM

239+ , scanlMAfter'

240+ , smapM

241+ , splitOnSeq

242+ , yield

243+ , yieldM)

244+import Streamly.Internal.Data.Stream.Parallel (parallel)

245+import Streamly.Internal.Data.Stream.Prelude

246+ ( fromStreamS, toStreamS, concatFoldableWith, concatMapFoldableWith

247+ , concatForFoldableWith)

248+import Streamly.Internal.Data.Stream.StreamD (fromStreamD, toStreamD)

249+import Streamly.Internal.Data.Stream.StreamK (IsStream)

250+import Streamly.Internal.Data.Stream.Serial (serial, wSerial)

251+import Streamly.Internal.Data.Time.Units

252+ ( AbsTime, MilliSecond64(..), addToAbsTime, toRelTime

253+ , toAbsTime)

254+import Streamly.Internal.Data.Tuple.Strict (Tuple'(..))

255+

256+import qualified Data.Heap as H

257+import qualified Data.Map.Strict as Map

258+import qualified Streamly.Internal.Data.Array.Storable.Foreign as A

259+import qualified Streamly.Internal.Data.Fold as FL

260+import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK

261+import qualified Streamly.Internal.Data.Parser.ParserD as PRD

262+import qualified Streamly.Internal.Data.Stream.Parallel as Par

263+import qualified Streamly.Internal.Data.Stream.Serial as Serial

264+import qualified Streamly.Internal.Data.Stream.StreamD as D

265+import qualified Streamly.Internal.Data.Stream.StreamK as K

266+import qualified Streamly.Internal.Data.Stream.Zip as Z

267+#ifdef USE_STREAMK_ONLY

268+import qualified Streamly.Internal.Data.Stream.StreamK as S

269+#else

270+import qualified Streamly.Internal.Data.Stream.StreamD as S

271+#endif

272+

273+import Prelude hiding (zipWith, concatMap, concat)

274+

275+-------------------------------------------------------------------------------

276+-- Appending

277+-------------------------------------------------------------------------------

278+

279+-- | Append the outputs of two streams, yielding all the elements from the

280+-- first stream and then yielding all the elements from the second stream.

281+--

282+-- IMPORTANT NOTE: This could be 100x faster than @serial/<>@ for appending a

283+-- few (say 100) streams because it can fuse via stream fusion. However, it

284+-- does not scale for a large number of streams (say 1000s) and becomes

285+-- qudartically slow. Therefore use this for custom appending of a few streams

286+-- but use 'concatMap' or 'concatMapWith serial' for appending @n@ streams or

287+-- infinite containers of streams.

288+--

289+-- /Internal/

290+{-# INLINE append #-}

291+append ::(IsStream t, Monad m) => t m b -> t m b -> t m b

292+append m1 m2 = fromStreamD $ D.append (toStreamD m1) (toStreamD m2)

293+

294+-------------------------------------------------------------------------------

295+-- Interleaving

296+-------------------------------------------------------------------------------

297+

298+-- XXX Same as 'wSerial'. We should perhaps rename wSerial to interleave.

299+-- XXX Document the interleaving behavior of side effects in all the

300+-- interleaving combinators.

301+-- XXX Write time-domain equivalents of these. In the time domain we can

302+-- interleave two streams such that the value of second stream is always taken

303+-- from its last value even if no new value is being yielded, like

304+-- zipWithLatest. It would be something like interleaveWithLatest.

305+--

306+-- | Interleaves the outputs of two streams, yielding elements from each stream

307+-- alternately, starting from the first stream. If any of the streams finishes

308+-- early the other stream continues alone until it too finishes.

309+--

310+-- >>> :set -XOverloadedStrings

311+-- >>> interleave "ab" ",,,," :: SerialT Identity Char

312+-- fromList "a,b,,,"

313+-- >>> interleave "abcd" ",," :: SerialT Identity Char

314+-- fromList "a,b,cd"

315+--

316+-- 'interleave' is dual to 'interleaveMin', it can be called @interleaveMax@.

317+--

318+-- Do not use at scale in concatMapWith.

319+--

320+-- /Internal/

321+{-# INLINE interleave #-}

322+interleave ::(IsStream t, Monad m) => t m b -> t m b -> t m b

323+interleave m1 m2 = fromStreamD $ D.interleave (toStreamD m1) (toStreamD m2)

324+

325+-- | Interleaves the outputs of two streams, yielding elements from each stream

326+-- alternately, starting from the first stream. As soon as the first stream

327+-- finishes, the output stops, discarding the remaining part of the second

328+-- stream. In this case, the last element in the resulting stream would be from

329+-- the second stream. If the second stream finishes early then the first stream

330+-- still continues to yield elements until it finishes.

331+--

332+-- >>> :set -XOverloadedStrings

333+-- >>> interleaveSuffix "abc" ",,,," :: SerialT Identity Char

334+-- fromList "a,b,c,"

335+-- >>> interleaveSuffix "abc" "," :: SerialT Identity Char

336+-- fromList "a,bc"

337+--

338+-- 'interleaveSuffix' is a dual of 'interleaveInfix'.

339+--

340+-- Do not use at scale in concatMapWith.

341+--

342+-- /Internal/

343+{-# INLINE interleaveSuffix #-}

344+interleaveSuffix ::(IsStream t, Monad m) => t m b -> t m b -> t m b

345+interleaveSuffix m1 m2 =

346+ fromStreamD $ D.interleaveSuffix (toStreamD m1) (toStreamD m2)

347+

348+-- | Interleaves the outputs of two streams, yielding elements from each stream

349+-- alternately, starting from the first stream and ending at the first stream.

350+-- If the second stream is longer than the first, elements from the second

351+-- stream are infixed with elements from the first stream. If the first stream

352+-- is longer then it continues yielding elements even after the second stream

353+-- has finished.

354+--

355+-- >>> :set -XOverloadedStrings

356+-- >>> interleaveInfix "abc" ",,,," :: SerialT Identity Char

357+-- fromList "a,b,c"

358+-- >>> interleaveInfix "abc" "," :: SerialT Identity Char

359+-- fromList "a,bc"

360+--

361+-- 'interleaveInfix' is a dual of 'interleaveSuffix'.

362+--

363+-- Do not use at scale in concatMapWith.

364+--

365+-- /Internal/

366+{-# INLINE interleaveInfix #-}

367+interleaveInfix ::(IsStream t, Monad m) => t m b -> t m b -> t m b

368+interleaveInfix m1 m2 =

369+ fromStreamD $ D.interleaveInfix (toStreamD m1) (toStreamD m2)

370+

371+-- | Interleaves the outputs of two streams, yielding elements from each stream

372+-- alternately, starting from the first stream. The output stops as soon as any

373+-- of the two streams finishes, discarding the remaining part of the other

374+-- stream. The last element of the resulting stream would be from the longer

375+-- stream.

376+--

377+-- >>> :set -XOverloadedStrings

378+-- >>> interleaveMin "ab" ",,,," :: SerialT Identity Char

379+-- fromList "a,b,"

380+-- >>> interleaveMin "abcd" ",," :: SerialT Identity Char

381+-- fromList "a,b,c"

382+--

383+-- 'interleaveMin' is dual to 'interleave'.

384+--

385+-- Do not use at scale in concatMapWith.

386+--

387+-- /Internal/

388+{-# INLINE interleaveMin #-}

389+interleaveMin ::(IsStream t, Monad m) => t m b -> t m b -> t m b

390+interleaveMin m1 m2 = fromStreamD $ D.interleaveMin (toStreamD m1) (toStreamD m2)

391+

392+-------------------------------------------------------------------------------

393+-- Scheduling

394+-------------------------------------------------------------------------------

395+

396+-- | Schedule the execution of two streams in a fair round-robin manner,

397+-- executing each stream once, alternately. Execution of a stream may not

398+-- necessarily result in an output, a stream may chose to @Skip@ producing an

399+-- element until later giving the other stream a chance to run. Therefore, this

400+-- combinator fairly interleaves the execution of two streams rather than

401+-- fairly interleaving the output of the two streams. This can be useful in

402+-- co-operative multitasking without using explicit threads. This can be used

403+-- as an alternative to `async`.

404+--

405+-- Do not use at scale in concatMapWith.

406+--

407+-- /Internal/

408+{-# INLINE roundrobin #-}

409+roundrobin ::(IsStream t, Monad m) => t m b -> t m b -> t m b

410+roundrobin m1 m2 = fromStreamD $ D.roundRobin (toStreamD m1) (toStreamD m2)

411+

412+------------------------------------------------------------------------------

413+-- Merging

414+------------------------------------------------------------------------------

415+

416+-- | Merge two streams using a comparison function. The head elements of both

417+-- the streams are compared and the smaller of the two elements is emitted, if

418+-- both elements are equal then the element from the first stream is used

419+-- first.

420+--

421+-- If the streams are sorted in ascending order, the resulting stream would

422+-- also remain sorted in ascending order.

423+--

424+-- @

425+-- > S.toList $ S.mergeBy compare (S.fromList [1,3,5]) (S.fromList [2,4,6,8])

426+-- [1,2,3,4,5,6,8]

427+-- @

428+--

429+-- @since 0.6.0

430+{-# INLINABLE mergeBy #-}

431+mergeBy ::

432+ (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a -> t m a

433+mergeBy f m1 m2 = fromStreamS $ S.mergeBy f (toStreamS m1) (toStreamS m2)

434+

435+-- | Like 'mergeBy' but with a monadic comparison function.

436+--

437+-- Merge two streams randomly:

438+--

439+-- @

440+-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT

441+-- > S.toList $ S.mergeByM randomly (S.fromList [1,1,1,1]) (S.fromList [2,2,2,2])

442+-- [2,1,2,2,2,1,1,1]

443+-- @

444+--

445+-- Merge two streams in a proportion of 2:1:

446+--

447+-- @

448+-- proportionately m n = do

449+-- ref <- newIORef $ cycle $ concat [replicate m LT, replicate n GT]

450+-- return $ \\_ _ -> do

451+-- r <- readIORef ref

452+-- writeIORef ref $ tail r

453+-- return $ head r

454+--

455+-- main = do

456+-- f <- proportionately 2 1

457+-- xs <- S.toList $ S.mergeByM f (S.fromList [1,1,1,1,1,1]) (S.fromList [2,2,2])

458+-- print xs

459+-- @

460+-- @

461+-- [1,1,2,1,1,2,1,1,2]

462+-- @

463+--

464+-- @since 0.6.0

465+{-# INLINABLE mergeByM #-}

466+mergeByM

467+ :: (IsStream t, Monad m)

468+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

469+mergeByM f m1 m2 = fromStreamS $ S.mergeByM f (toStreamS m1) (toStreamS m2)

470+

471+{-

472+-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.

473+{-# INLINABLE mergeEndByAny #-}

474+mergeEndByAny

475+ :: (IsStream t, Monad m)

476+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

477+mergeEndByAny f m1 m2 = fromStreamD $

478+ D.mergeEndByAny f (toStreamD m1) (toStreamD m2)

479+

480+-- Like 'mergeByM' but stops merging as soon as the first stream stops.

481+{-# INLINABLE mergeEndByFirst #-}

482+mergeEndByFirst

483+ :: (IsStream t, Monad m)

484+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

485+mergeEndByFirst f m1 m2 = fromStreamS $

486+ D.mergeEndByFirst f (toStreamD m1) (toStreamD m2)

487+

488+-- Holding this back for now, we may want to use the name "merge" differently

489+-- | Same as @'mergeBy' 'compare'@.

490+--

491+-- @

492+-- > S.toList $ S.merge (S.fromList [1,3,5]) (S.fromList [2,4,6,8])

493+-- [1,2,3,4,5,6,8]

494+-- @

495+--

496+-- @since 0.6.0

497+{-# INLINABLE merge #-}

498+merge ::

499+ (IsStream t, Monad m, Ord a) => t m a -> t m a -> t m a

500+merge = mergeBy compare

501+-}

502+

503+-- | Like 'mergeBy' but merges concurrently (i.e. both the elements being

504+-- merged are generated concurrently).

505+--

506+-- @since 0.6.0

507+{-# INLINE mergeAsyncBy #-}

508+mergeAsyncBy :: (IsStream t, MonadAsync m)

509+ => (a -> a -> Ordering) -> t m a -> t m a -> t m a

510+mergeAsyncBy f = mergeAsyncByM (\a b -> return $ f a b)

511+

512+-- | Like 'mergeByM' but merges concurrently (i.e. both the elements being

513+-- merged are generated concurrently).

514+--

515+-- @since 0.6.0

516+{-# INLINE mergeAsyncByM #-}

517+mergeAsyncByM :: (IsStream t, MonadAsync m)

518+ => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

519+mergeAsyncByM f m1 m2 = fromStreamD $

520+ D.mergeByM f (D.mkParallelD $ toStreamD m1) (D.mkParallelD $ toStreamD m2)

521+

522+------------------------------------------------------------------------------

523+-- Combine N Streams - concatMap

524+------------------------------------------------------------------------------

525+

526+-- | @concatMapWith merge map stream@ is a two dimensional looping combinator.

527+-- The first argument specifies a merge or concat function that is used to

528+-- merge the streams generated by applying the second argument i.e. the @map@

529+-- function to each element of the input stream. The concat function could be

530+-- 'serial', 'parallel', 'async', 'ahead' or any other zip or merge function

531+-- and the second argument could be any stream generation function using a

532+-- seed.

533+--

534+-- /Compare 'foldMapWith'/

535+--

536+-- /Since: 0.7.0/

537+--

538+-- /Since: 0.8.0 (signature change)/

539+{-# INLINE concatMapWith #-}

540+concatMapWith

541+ :: IsStream t

542+ => (t m b -> t m b -> t m b)

543+ -> (a -> t m b)

544+ -> t m a

545+ -> t m b

546+concatMapWith = K.concatMapBy

547+

548+-- | Like 'concatMapWith' but carries a state which can be used to share

549+-- information across multiple steps of concat.

550+--

551+-- @

552+-- concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial

553+-- @

554+--

555+-- /Internal/

556+--

557+{-# INLINE concatSmapMWith #-}

558+concatSmapMWith

559+ :: (IsStream t, Monad m)

560+ => (t m b -> t m b -> t m b)

561+ -> (s -> a -> m (s, t m b))

562+ -> m s

563+ -> t m a

564+ -> t m b

565+concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial

566+

567+-- | Map a stream producing function on each element of the stream and then

568+-- flatten the results into a single stream.

569+--

570+-- @

571+-- concatMap f = 'concat . map f'

572+-- concatMap = 'concatMapWith' 'Serial.serial'

573+-- concatMap f = 'concatMapM' (return . f)

574+-- concatMap f = 'concatUnfold' (UF.lmap f UF.fromStream)

575+-- @

576+--

577+-- @since 0.6.0

578+{-# INLINE concatMap #-}

579+concatMap ::(IsStream t, Monad m) => (a -> t m b) -> t m a -> t m b

580+concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)

581+

582+-- | Flatten a stream of streams to a single stream.

583+--

584+-- @

585+-- concat = concatMap id

586+-- @

587+--

588+-- /Internal/

589+{-# INLINE concat #-}

590+concat :: (IsStream t, Monad m) => t m (t m a) -> t m a

591+concat = concatMap id

592+

593+-- Keep concating either streams as long as rights are generated, stop as soon

594+-- as a left is generated and concat the left stream.

595+--

596+-- See also: 'handle'

597+--

598+-- /Unimplemented/

599+--

600+{-

601+concatMapEitherWith

602+ :: -- (IsStream t, MonadAsync m) =>

603+ (forall x. t m x -> t m x -> t m x)

604+ -> (a -> t m (Either (t m b) b))

605+ -> t m a

606+ -> t m b

607+concatMapEitherWith = undefined

608+-}

609+

610+------------------------------------------------------------------------------

611+-- Combine N Streams - concatUnfold

612+------------------------------------------------------------------------------

613+

614+-- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike

615+-- 'concatMap' this can fuse the 'Unfold' code with the inner loop and

616+-- therefore provide many times better performance.

617+--

618+-- @since 0.7.0

619+{-# INLINE concatUnfold #-}

620+concatUnfold ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b

621+concatUnfold u m = fromStreamD $ D.concatMapU u (toStreamD m)

622+

623+-- | Like 'concatUnfold' but interleaves the streams in the same way as

624+-- 'interleave' behaves instead of appending them.

625+--

626+-- /Internal/

627+{-# INLINE concatUnfoldInterleave #-}

628+concatUnfoldInterleave ::(IsStream t, Monad m)

629+ => Unfold m a b -> t m a -> t m b

630+concatUnfoldInterleave u m =

631+ fromStreamD $ D.concatUnfoldInterleave u (toStreamD m)

632+

633+-- | Like 'concatUnfold' but executes the streams in the same way as

634+-- 'roundrobin'.

635+--

636+-- /Internal/

637+{-# INLINE concatUnfoldRoundrobin #-}

638+concatUnfoldRoundrobin ::(IsStream t, Monad m)

639+ => Unfold m a b -> t m a -> t m b

640+concatUnfoldRoundrobin u m =

641+ fromStreamD $ D.concatUnfoldRoundrobin u (toStreamD m)

642+

643+------------------------------------------------------------------------------

644+-- Combine N Streams - interpose

645+------------------------------------------------------------------------------

646+

647+-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)

648+--

649+-- | Unfold the elements of a stream, intersperse the given element between the

650+-- unfolded streams and then concat them into a single stream.

651+--

652+-- > unwords = S.interpose ' '

653+--

654+-- /Internal/

655+{-# INLINE interpose #-}

656+interpose :: (IsStream t, Monad m)

657+ => c -> Unfold m b c -> t m b -> t m c

658+interpose x unf str =

659+ D.fromStreamD $ D.interpose (return x) unf (D.toStreamD str)

660+

661+-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)

662+--

663+-- | Unfold the elements of a stream, append the given element after each

664+-- unfolded stream and then concat them into a single stream.

665+--

666+-- > unlines = S.interposeSuffix '\n'

667+--

668+-- /Internal/

669+{-# INLINE interposeSuffix #-}

670+interposeSuffix :: (IsStream t, Monad m)

671+ => c -> Unfold m b c -> t m b -> t m c

672+interposeSuffix x unf str =

673+ D.fromStreamD $ D.interposeSuffix (return x) unf (D.toStreamD str)

674+

675+------------------------------------------------------------------------------

676+-- Combine N Streams - intercalate

677+------------------------------------------------------------------------------

678+

679+-- XXX we can swap the order of arguments to gintercalate so that the

680+-- definition of concatUnfold becomes simpler? The first stream should be

681+-- infixed inside the second one. However, if we change the order in

682+-- "interleave" as well similarly, then that will make it a bit unintuitive.

683+--

684+-- > concatUnfold unf str =

685+-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())

686+--

687+-- | 'interleaveInfix' followed by unfold and concat.

688+--

689+-- /Internal/

690+{-# INLINE gintercalate #-}

691+gintercalate

692+ :: (IsStream t, Monad m)

693+ => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c

694+gintercalate unf1 str1 unf2 str2 =

695+ D.fromStreamD $ D.gintercalate

696+ unf1 (D.toStreamD str1)

697+ unf2 (D.toStreamD str2)

698+

699+-- XXX The order of arguments in "intercalate" is consistent with the list

700+-- intercalate but inconsistent with gintercalate and other stream interleaving

701+-- combinators. We can change the order of the arguments in other combinators

702+-- but then 'interleave' combinator may become a bit unintuitive because we

703+-- will be starting with the second stream.

704+

705+-- > intercalate seed unf str = gintercalate unf str unf (repeatM seed)

706+-- > intercalate a unf str = concatUnfold unf $ intersperse a str

707+--

708+-- | 'intersperse' followed by unfold and concat.

709+--

710+-- > unwords = intercalate " " UF.fromList

711+--

712+-- >>> intercalate " " UF.fromList ["abc", "def", "ghi"]

713+-- > "abc def ghi"

714+--

715+-- /Internal/

716+{-# INLINE intercalate #-}

717+intercalate :: (IsStream t, Monad m)

718+ => b -> Unfold m b c -> t m b -> t m c

719+intercalate seed unf str = D.fromStreamD $

720+ D.concatMapU unf $ D.intersperse seed (toStreamD str)

721+

722+-- | 'interleaveSuffix' followed by unfold and concat.

723+--

724+-- /Internal/

725+{-# INLINE gintercalateSuffix #-}

726+gintercalateSuffix

727+ :: (IsStream t, Monad m)

728+ => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c

729+gintercalateSuffix unf1 str1 unf2 str2 =

730+ D.fromStreamD $ D.gintercalateSuffix

731+ unf1 (D.toStreamD str1)

732+ unf2 (D.toStreamD str2)

733+

734+-- > intercalateSuffix seed unf str = gintercalateSuffix unf str unf (repeatM seed)

735+-- > intercalateSuffix a unf str = concatUnfold unf $ intersperseSuffix a str

736+--

737+-- | 'intersperseSuffix' followed by unfold and concat.

738+--

739+-- > unlines = intercalateSuffix "\n" UF.fromList

740+--

741+-- >>> intercalate "\n" UF.fromList ["abc", "def", "ghi"]

742+-- > "abc\ndef\nghi\n"

743+--

744+-- /Internal/

745+{-# INLINE intercalateSuffix #-}

746+intercalateSuffix :: (IsStream t, Monad m)

747+ => b -> Unfold m b c -> t m b -> t m c

748+intercalateSuffix seed unf str = fromStreamD $ D.concatMapU unf

749+ $ D.intersperseSuffix (return seed) (D.toStreamD str)

750+

751+------------------------------------------------------------------------------

752+-- IterateMap - Map and flatten Trees of Streams

753+------------------------------------------------------------------------------

754+

755+-- | Like 'iterateM' but iterates after mapping a stream generator on the

756+-- output.

757+--

758+-- Yield an input element in the output stream, map a stream generator on it

759+-- and then do the same on the resulting stream. This can be used for a depth

760+-- first traversal of a tree like structure.

761+--

762+-- Note that 'iterateM' is a special case of 'iterateMapWith':

763+--

764+-- @

765+-- iterateM f = iterateMapWith serial (yieldM . f) . yieldM

766+-- @

767+--

768+-- It can be used to traverse a tree structure. For example, to list a

769+-- directory tree:

770+--

771+-- @

772+-- Stream.iterateMapWith Stream.serial

773+-- (either Dir.toEither (const nil))

774+-- (yield (Left "tmp"))

775+-- @

776+--

777+-- /Internal/

778+--

779+{-# INLINE iterateMapWith #-}

780+iterateMapWith

781+ :: IsStream t

782+ => (t m a -> t m a -> t m a)

783+ -> (a -> t m a)

784+ -> t m a

785+ -> t m a

786+iterateMapWith combine f = concatMapWith combine go

787+ where

788+ go x = yield x `combine` concatMapWith combine go (f x)

789+

790+{-

791+{-# INLINE iterateUnfold #-}

792+iterateUnfold :: (IsStream t, MonadAsync m)

793+ => Unfold m a a -> t m a -> t m a

794+iterateUnfold unf xs = undefined

795+-}

796+

797+------------------------------------------------------------------------------

798+-- Flattening Graphs

799+------------------------------------------------------------------------------

800+

801+-- To traverse graphs we need a state to be carried around in the traversal.

802+-- For example, we can use a hashmap to store the visited status of nodes.

803+

804+-- | Like 'iterateMap' but carries a state in the stream generation function.

805+-- This can be used to traverse graph like structures, we can remember the

806+-- visited nodes in the state to avoid cycles.

807+--

808+-- Note that a combination of 'iterateMap' and 'usingState' can also be used to

809+-- traverse graphs. However, this function provides a more localized state

810+-- instead of using a global state.

811+--

812+-- See also: 'mfix'

813+--

814+-- /Internal/

815+--

816+{-# INLINE iterateSmapMWith #-}

817+iterateSmapMWith

818+ :: (IsStream t, Monad m)

819+ => (t m a -> t m a -> t m a)

820+ -> (b -> a -> m (b, t m a))

821+ -> m b

822+ -> t m a

823+ -> t m a

824+iterateSmapMWith combine f initial stream =

825+ concatMap (\b -> concatMapWith combine (go b) stream) (yieldM initial)

826+

827+ where

828+

829+ go b a = yield a `combine` feedback b a

830+

831+ feedback b a =

832+ concatMap

833+ (\(b1, s) -> concatMapWith combine (go b1) s)

834+ (yieldM $ f b a)

835+

836+------------------------------------------------------------------------------

837+-- iterateMap - Either streams

838+------------------------------------------------------------------------------

839+

840+-- | In an 'Either' stream iterate on 'Left's. This is a special case of

841+-- 'iterateMapWith':

842+--

843+-- @

844+-- iterateMapLeftsWith combine f = iterateMapWith combine (either f (const nil))

845+-- @

846+--

847+-- To traverse a directory tree:

848+--

849+-- @

850+-- iterateMapLeftsWith serial Dir.toEither (yield (Left "tmp"))

851+-- @

852+--

853+-- /Internal/

854+--

855+{-# INLINE iterateMapLeftsWith #-}

856+iterateMapLeftsWith

857+ :: IsStream t

858+ => (t m (Either a b) -> t m (Either a b) -> t m (Either a b))

859+ -> (a -> t m (Either a b))

860+ -> t m (Either a b)

861+ -> t m (Either a b)

862+iterateMapLeftsWith combine f = iterateMapWith combine (either f (const K.nil))

863+

864+------------------------------------------------------------------------------

865+-- Folding

866+------------------------------------------------------------------------------

867+

868+-- Splitting operations that take a predicate and a Fold can be

869+-- expressed using parseMany. Operations like chunksOf, intervalsOf, split*,

870+-- can be expressed using parseMany when used with an appropriate Parser.

871+--

872+-- XXX We need takeGE/takeBetween to implement "some" using "many".

873+

874+-- | Apply a 'Fold' repeatedly on a stream and emit the parsed values in the

875+-- output stream.

876+--

877+-- This is the streaming dual of the 'Streamly.Internal.Data.Fold.many'

878+-- parse combinator.

879+--

880+-- >>> f = Fold.ltake 2 Fold.sum

881+-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList [1..10]

882+-- > [3,7,11,15,19]

883+--

884+-- >>> f = Fold.sliceEndWith Fold.toList

885+-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList "hello\nworld"

886+-- > ["hello\n","world"]

887+--

888+-- /Internal/

889+--

890+{-# INLINE foldMany #-}

891+foldMany

892+ :: (IsStream t, Monad m)

893+ => Fold m a b

894+ -> t m a

895+ -> t m b

896+foldMany f m = D.fromStreamD $ D.foldMany f (D.toStreamD m)

897+

898+-- | Apply a stream of folds to an input stream and emit the results in the

899+-- output stream.

900+--

901+-- /Internal/

902+--

903+{-# INLINE foldSequence #-}

904+foldSequence

905+ :: -- (IsStream t, Monad m) =>

906+ t m (Fold m a b)

907+ -> t m a

908+ -> t m b

909+foldSequence _f _m = undefined

910+

911+-- | Iterate a fold generator on a stream. The initial value @b@ is used to

912+-- generate the first fold, the fold is applied on the stream and the result of

913+-- the fold is used to generate the next fold and so on.

914+--

915+-- >>> f x = Fold.ltake 2 (Fold.mconcatTo x)

916+-- >>> s = Stream.map Sum $ Stream.fromList [1..10]

917+-- >>> Stream.toList $ Stream.map getSum $ Stream.foldIterate f 0 s

918+-- > [3,10,21,36,55,55]

919+--

920+-- This is the streaming equivalent of monad like sequenced application of

921+-- folds where next fold is dependent on the previous fold.

922+--

923+-- /Internal/

924+--

925+{-# INLINE foldIterate #-}

926+foldIterate

927+ :: -- (IsStream t, Monad m) =>

928+ (b -> Fold m a b)

929+ -> b

930+ -> t m a

931+ -> t m b

932+foldIterate _f _i _m = undefined

933+-- D.fromStreamD $ D.foldIterate f i (D.toStreamD m)

934+

935+------------------------------------------------------------------------------

936+-- Parsing

937+------------------------------------------------------------------------------

938+

939+-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the

940+-- output stream.

941+--

942+-- This is the streaming equivalent of the 'Streamly.Internal.Data.Parser.many'

943+-- parse combinator.

944+--

945+-- >>> S.toList $ S.parseMany (PR.take 2 $ PR.fromFold FL.sum) $ S.fromList [1..10]

946+-- > [3,7,11,15,19]

947+--

948+-- >>> S.toList $ S.parseMany (PR.line FL.toList) $ S.fromList "hello\nworld"

949+-- > ["hello\n","world"]

950+--

951+-- /Internal/

952+--

953+{-# INLINE parseMany #-}

954+parseMany

955+ :: (IsStream t, MonadThrow m)

956+ => Parser m a b

957+ -> t m a

958+ -> t m b

959+parseMany p m =

960+ D.fromStreamD $ D.parseMany (PRK.fromParserK p) (D.toStreamD m)

961+

962+{-# INLINE parseManyD #-}

963+parseManyD

964+ :: (IsStream t, MonadThrow m)

965+ => PRD.Parser m a b

966+ -> t m a

967+ -> t m b

968+parseManyD p m =

969+ D.fromStreamD $ D.parseMany p (D.toStreamD m)

970+

971+-- | Apply a stream of parsers to an input stream and emit the results in the

972+-- output stream.

973+--

974+-- /Internal/

975+--

976+{-# INLINE parseSequence #-}

977+parseSequence

978+ :: -- (IsStream t, Monad m) =>

979+ t m (Parser m a b)

980+ -> t m a

981+ -> t m b

982+parseSequence _f _m = undefined

983+

984+-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,

985+-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds

986+-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The

987+-- output of @test@ is discarded and the output of @collect@ is emitted in the

988+-- output stream. The parser fails if @collect@ fails.

989+--

990+-- /Unimplemented/

991+--

992+{-# INLINE parseManyTill #-}

993+parseManyTill ::

994+ -- (IsStream t, MonadThrow m) =>

995+ Parser m a b

996+ -> Parser m a x

997+ -> t m a

998+ -> t m b

999+parseManyTill = undefined

1000+

1001+-- | Iterate a parser generating function on a stream. The initial value @b@ is

1002+-- used to generate the first parser, the parser is applied on the stream and

1003+-- the result is used to generate the next parser and so on.

1004+--

1005+-- >>> S.toList $ S.map getSum $ S.parseIterate (\b -> PR.take 2 (FL.mconcatTo b)) 0 $ S.map Sum $ S.fromList [1..10]

1006+-- > [3,10,21,36,55,55]

1007+--

1008+-- This is the streaming equivalent of monad like sequenced application of

1009+-- parsers where next parser is dependent on the previous parser.

1010+--

1011+-- /Internal/

1012+--

1013+{-# INLINE parseIterate #-}

1014+parseIterate

1015+ :: (IsStream t, MonadThrow m)

1016+ => (b -> Parser m a b)

1017+ -> b

1018+ -> t m a

1019+ -> t m b

1020+parseIterate f i m = D.fromStreamD $

1021+ D.parseIterate (PRK.fromParserK . f) i (D.toStreamD m)

1022+

1023+------------------------------------------------------------------------------

1024+-- Trimming

1025+------------------------------------------------------------------------------

1026+

1027+-- | Drop prefix from the input stream if present.

1028+--

1029+-- Space: @O(1)@

1030+--

1031+-- /Unimplemented/ - Help wanted.

1032+{-# INLINE dropPrefix #-}

1033+dropPrefix ::

1034+ -- (Eq a, IsStream t, Monad m) =>

1035+ t m a -> t m a -> t m a

1036+dropPrefix = error "Not implemented yet!"

1037+

1038+-- | Drop all matching infix from the input stream if present. Infix stream

1039+-- may be consumed multiple times.

1040+--

1041+-- Space: @O(n)@ where n is the length of the infix.

1042+--

1043+-- /Unimplemented/ - Help wanted.

1044+{-# INLINE dropInfix #-}

1045+dropInfix ::

1046+ -- (Eq a, IsStream t, Monad m) =>

1047+ t m a -> t m a -> t m a

1048+dropInfix = error "Not implemented yet!"

1049+

1050+-- | Drop suffix from the input stream if present. Suffix stream may be

1051+-- consumed multiple times.

1052+--

1053+-- Space: @O(n)@ where n is the length of the suffix.

1054+--

1055+-- /Unimplemented/ - Help wanted.

1056+{-# INLINE dropSuffix #-}

1057+dropSuffix ::

1058+ -- (Eq a, IsStream t, Monad m) =>

1059+ t m a -> t m a -> t m a

1060+dropSuffix = error "Not implemented yet!"

1061+

1062+------------------------------------------------------------------------------

1063+-- Generalized grouping

1064+------------------------------------------------------------------------------

1065+

1066+-- This combinator is the most general grouping combinator and can be used to

1067+-- implement all other grouping combinators.

1068+--

1069+-- XXX check if this can implement the splitOn combinator i.e. we can slide in

1070+-- new elements, slide out old elements and incrementally compute the hash.

1071+-- Also, can we implement the windowed classification combinators using this?

1072+--

1073+-- In fact this is a parse. Instead of using a special return value in the fold

1074+-- we are using a mapping function.

1075+--

1076+-- Note that 'scanl'' (usually followed by a map to extract the desired value

1077+-- from the accumulator) can be used to realize many implementations e.g. a

1078+-- sliding window implementation. A scan followed by a mapMaybe is also a good

1079+-- pattern to express many problems where we want to emit a filtered output and

1080+-- not emit an output on every input.

1081+--

1082+-- Passing on of the initial accumulator value to the next fold is equivalent

1083+-- to returning the leftover concept.

1084+

1085+{-

1086+-- | @groupScan splitter fold stream@ folds the input stream using @fold@.

1087+-- @splitter@ is applied on the accumulator of the fold every time an item is

1088+-- consumed by the fold. The fold continues until @splitter@ returns a 'Just'

1089+-- value. A 'Just' result from the @splitter@ specifies a result to be emitted

1090+-- in the output stream and the initial value of the accumulator for the next

1091+-- group's fold. This allows us to control whether to start fresh for the next

1092+-- fold or to continue from the previous fold's output.

1093+--

1094+{-# INLINE groupScan #-}

1095+groupScan

1096+ :: (IsStream t, Monad m)

1097+ => (x -> m (Maybe (b, x))) -> Fold m a x -> t m a -> t m b

1098+groupScan split fold m = undefined

1099+-}

1100+

1101+------------------------------------------------------------------------------

1102+-- Grouping

1103+------------------------------------------------------------------------------

1104+

1105+-- | @groupsBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the

1106+-- first group, if @b \`cmp` a@ is 'True' then @b@ is also assigned to the same

1107+-- group. If @c \`cmp` a@ is 'True' then @c@ is also assigned to the same

1108+-- group and so on. When the comparison fails a new group is started. Each

1109+-- group is folded using the fold @f@ and the result of the fold is emitted in

1110+-- the output stream.

1111+--

1112+-- >>> S.toList $ S.groupsBy (>) FL.toList $ S.fromList [1,3,7,0,2,5]

1113+-- > [[1,3,7],[0,2,5]]

1114+--

1115+-- @since 0.7.0

1116+{-# INLINE groupsBy #-}

1117+groupsBy

1118+ :: (IsStream t, Monad m)

1119+ => (a -> a -> Bool)

1120+ -> Fold m a b

1121+ -> t m a

1122+ -> t m b

1123+groupsBy cmp f m = D.fromStreamD $ D.groupsBy cmp f (D.toStreamD m)

1124+

1125+-- | Unlike @groupsBy@ this function performs a rolling comparison of two

1126+-- successive elements in the input stream. @groupsByRolling cmp f $ S.fromList

1127+-- [a,b,c,...]@ assigns the element @a@ to the first group, if @a \`cmp` b@ is

1128+-- 'True' then @b@ is also assigned to the same group. If @b \`cmp` c@ is

1129+-- 'True' then @c@ is also assigned to the same group and so on. When the

1130+-- comparison fails a new group is started. Each group is folded using the fold

1131+-- @f@.

1132+--

1133+-- >>> S.toList $ S.groupsByRolling (\a b -> a + 1 == b) FL.toList $ S.fromList [1,2,3,7,8,9]

1134+-- > [[1,2,3],[7,8,9]]

1135+--

1136+-- @since 0.7.0

1137+{-# INLINE groupsByRolling #-}

1138+groupsByRolling

1139+ :: (IsStream t, Monad m)

1140+ => (a -> a -> Bool)

1141+ -> Fold m a b

1142+ -> t m a

1143+ -> t m b

1144+groupsByRolling cmp f m = D.fromStreamD $ D.groupsRollingBy cmp f (D.toStreamD m)

1145+

1146+-- |

1147+-- > groups = groupsBy (==)

1148+-- > groups = groupsByRolling (==)

1149+--

1150+-- Groups contiguous spans of equal elements together in individual groups.

1151+--

1152+-- >>> S.toList $ S.groups FL.toList $ S.fromList [1,1,2,2]

1153+-- > [[1,1],[2,2]]

1154+--

1155+-- @since 0.7.0

1156+{-# INLINE groups #-}

1157+groups :: (IsStream t, Monad m, Eq a) => Fold m a b -> t m a -> t m b

1158+groups = groupsBy (==)

1159+

1160+------------------------------------------------------------------------------

1161+-- Splitting - by a predicate

1162+------------------------------------------------------------------------------

1163+

1164+-- TODO: Use a Splitter configuration similar to the "split" package to make it

1165+-- possible to express all splitting combinations. In general, we can have

1166+-- infix/suffix/prefix/condensing of separators, dropping both leading/trailing

1167+-- separators. We can have a single split operation taking the splitter config

1168+-- as argument.

1169+

1170+-- | Split on an infixed separator element, dropping the separator. Splits the

1171+-- stream on separator elements determined by the supplied predicate, separator

1172+-- is considered as infixed between two segments, if one side of the separator

1173+-- is missing then it is parsed as an empty stream. The supplied 'Fold' is

1174+-- applied on the split segments. With '-' representing non-separator elements

1175+-- and '.' as separator, 'splitOn' splits as follows:

1176+--

1177+-- @

1178+-- "--.--" => "--" "--"

1179+-- "--." => "--" ""

1180+-- ".--" => "" "--"

1181+-- @

1182+--

1183+-- @splitOn (== x)@ is an inverse of @intercalate (S.yield x)@

1184+--

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

1186+--

1187+-- > splitOn' p xs = S.toList $ S.splitOn p (FL.toList) (S.fromList xs)

1188+--

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

1190+-- [""]

1191+--

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

1193+-- ["",""]

1194+--

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

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

1197+--

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

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

1200+--

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

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

1203+--

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

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

1206+--

1207+-- @since 0.7.0

1208+

1209+-- This can be considered as an n-fold version of 'breakOn' where we apply

1210+-- 'breakOn' successively on the input stream, dropping the first element

1211+-- of the second segment after each break.

1212+--

1213+{-# INLINE splitOn #-}

1214+splitOn

1215+ :: (IsStream t, Monad m)

1216+ => (a -> Bool) -> Fold m a b -> t m a -> t m b

1217+splitOn predicate f = foldMany (FL.sliceSepBy predicate f)

1218+

1219+-- | Like 'splitOn' but the separator is considered as suffixed to the segments

1220+-- in the stream. A missing suffix at the end is allowed. A separator at the

1221+-- beginning is parsed as empty segment. With '-' representing elements and

1222+-- '.' as separator, 'splitOnSuffix' splits as follows:

1223+--

1224+-- @

1225+-- "--.--." => "--" "--"

1226+-- "--.--" => "--" "--"

1227+-- ".--." => "" "--"

1228+-- @

1229+--

1230+-- > splitOnSuffix' p xs = S.toList $ S.splitSuffixBy p (FL.toList) (S.fromList xs)

1231+--

1232+-- >>> splitOnSuffix' (== '.') ""

1233+-- []

1234+--

1235+-- >>> splitOnSuffix' (== '.') "."

1236+-- [""]

1237+--

1238+-- >>> splitOnSuffix' (== '.') "a"

1239+-- ["a"]

1240+--

1241+-- >>> splitOnSuffix' (== '.') ".a"

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

1243+--

1244+-- >>> splitOnSuffix' (== '.') "a."

1245+-- > ["a"]

1246+--

1247+-- >>> splitOnSuffix' (== '.') "a.b"

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

1249+--

1250+-- >>> splitOnSuffix' (== '.') "a.b."

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

1252+--

1253+-- >>> splitOnSuffix' (== '.') "a..b.."

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

1255+--

1256+-- > lines = splitOnSuffix (== '\n')

1257+--

1258+-- @since 0.7.0

1259+

1260+-- This can be considered as an n-fold version of 'breakPost' where we apply

1261+-- 'breakPost' successively on the input stream, dropping the first element

1262+-- of the second segment after each break.

1263+--

1264+{-# INLINE splitOnSuffix #-}

1265+splitOnSuffix

1266+ :: (IsStream t, Monad m)

1267+ => (a -> Bool) -> Fold m a b -> t m a -> t m b

1268+splitOnSuffix predicate f m =

1269+ D.fromStreamD $ D.foldMany1 (FL.sliceSepBy predicate f) (D.toStreamD m)

1270+

1271+-- | Like 'splitOn' after stripping leading, trailing, and repeated separators.

1272+-- Therefore, @".a..b."@ with '.' as the separator would be parsed as

1273+-- @["a","b"]@. In other words, its like parsing words from whitespace

1274+-- separated text.

1275+--

1276+-- > wordsBy' p xs = S.toList $ S.wordsBy p (FL.toList) (S.fromList xs)

1277+--

1278+-- >>> wordsBy' (== ',') ""

1279+-- > []

1280+--

1281+-- >>> wordsBy' (== ',') ","

1282+-- > []

1283+--

1284+-- >>> wordsBy' (== ',') ",a,,b,"

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

1286+--

1287+-- > words = wordsBy isSpace

1288+--

1289+-- @since 0.7.0

1290+

1291+-- It is equivalent to splitting in any of the infix/prefix/suffix styles

1292+-- followed by removal of empty segments.

1293+{-# INLINE wordsBy #-}

1294+wordsBy

1295+ :: (IsStream t, Monad m)

1296+ => (a -> Bool) -> Fold m a b -> t m a -> t m b

1297+wordsBy predicate f m =

1298+ D.fromStreamD $ D.wordsBy predicate f (D.toStreamD m)

1299+

1300+-- | Like 'splitOnSuffix' but keeps the suffix attached to the resulting

1301+-- splits.

1302+--

1303+-- > splitWithSuffix' p xs = S.toList $ S.splitWithSuffix p (FL.toList) (S.fromList xs)

1304+--

1305+-- >>> splitWithSuffix' (== '.') ""

1306+-- []

1307+--

1308+-- >>> splitWithSuffix' (== '.') "."

1309+-- ["."]

1310+--

1311+-- >>> splitWithSuffix' (== '.') "a"

1312+-- ["a"]

1313+--

1314+-- >>> splitWithSuffix' (== '.') ".a"

1315+-- > [".","a"]

1316+--

1317+-- >>> splitWithSuffix' (== '.') "a."

1318+-- > ["a."]

1319+--

1320+-- >>> splitWithSuffix' (== '.') "a.b"

1321+-- > ["a.","b"]

1322+--

1323+-- >>> splitWithSuffix' (== '.') "a.b."

1324+-- > ["a.","b."]

1325+--

1326+-- >>> splitWithSuffix' (== '.') "a..b.."

1327+-- > ["a.",".","b.","."]

1328+--

1329+-- @since 0.7.0

1330+

1331+-- This can be considered as an n-fold version of 'breakPost' where we apply

1332+-- 'breakPost' successively on the input stream.

1333+--

1334+{-# INLINE splitWithSuffix #-}

1335+splitWithSuffix

1336+ :: (IsStream t, Monad m)

1337+ => (a -> Bool) -> Fold m a b -> t m a -> t m b

1338+splitWithSuffix predicate f m =

1339+ D.fromStreamD $ D.foldMany1 (FL.sliceEndWith predicate f) (D.toStreamD m)

1340+

1341+------------------------------------------------------------------------------

1342+-- Splitting - on a delimiter sequence

1343+------------------------------------------------------------------------------

1344+

1345+-- Int list examples for splitOn:

1346+--

1347+-- >>> splitList [] [1,2,3,3,4]

1348+-- > [[1],[2],[3],[3],[4]]

1349+--

1350+-- >>> splitList [5] [1,2,3,3,4]

1351+-- > [[1,2,3,3,4]]

1352+--

1353+-- >>> splitList [1] [1,2,3,3,4]

1354+-- > [[],[2,3,3,4]]

1355+--

1356+-- >>> splitList [4] [1,2,3,3,4]

1357+-- > [[1,2,3,3],[]]

1358+--

1359+-- >>> splitList [2] [1,2,3,3,4]

1360+-- > [[1],[3,3,4]]

1361+--

1362+-- >>> splitList [3] [1,2,3,3,4]

1363+-- > [[1,2],[],[4]]

1364+--

1365+-- >>> splitList [3,3] [1,2,3,3,4]

1366+-- > [[1,2],[4]]

1367+--

1368+-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]

1369+-- > [[],[]]

1370+

1371+{-

1372+-- This can be implemented easily using Rabin Karp

1373+-- | Split on any one of the given patterns.

1374+{-# INLINE splitOnAny #-}

1375+splitOnAny

1376+ :: (IsStream t, Monad m, Storable a, Integral a)

1377+ => [Array a] -> Fold m a b -> t m a -> t m b

1378+splitOnAny subseq f m = undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)

1379+-}

1380+

1381+-- XXX use a non-monadic intersperse to remove the MonadAsync constraint.

1382+--

1383+-- | Like 'splitOnSeq' but splits the separator as well, as an infix token.

1384+--

1385+-- > splitOn'_ pat xs = S.toList $ S.splitOn' (A.fromList pat) (FL.toList) (S.fromList xs)

1386+--

1387+-- >>> splitOn'_ "" "hello"

1388+-- > ["h","","e","","l","","l","","o"]

1389+--

1390+-- >>> splitOn'_ "hello" ""

1391+-- > [""]

1392+--

1393+-- >>> splitOn'_ "hello" "hello"

1394+-- > ["","hello",""]

1395+--

1396+-- >>> splitOn'_ "x" "hello"

1397+-- > ["hello"]

1398+--

1399+-- >>> splitOn'_ "h" "hello"

1400+-- > ["","h","ello"]

1401+--

1402+-- >>> splitOn'_ "o" "hello"

1403+-- > ["hell","o",""]

1404+--

1405+-- >>> splitOn'_ "e" "hello"

1406+-- > ["h","e","llo"]

1407+--

1408+-- >>> splitOn'_ "l" "hello"

1409+-- > ["he","l","","l","o"]

1410+--

1411+-- >>> splitOn'_ "ll" "hello"

1412+-- > ["he","ll","o"]

1413+--

1414+-- /Internal/

1415+{-# INLINE splitBySeq #-}

1416+splitBySeq

1417+ :: (IsStream t, MonadAsync m, Storable a, Enum a, Eq a)

1418+ => Array a -> Fold m a b -> t m a -> t m b

1419+splitBySeq patt f m =

1420+ intersperseM (fold f (A.toStream patt)) $ splitOnSeq patt f m

1421+

1422+-- | Like 'splitSuffixBy' but the separator is a sequence of elements, instead

1423+-- of a predicate for a single element.

1424+--

1425+-- > splitOnSuffixSeq_ pat xs = S.toList $ S.splitOnSuffixSeq (A.fromList pat) (FL.toList) (S.fromList xs)

1426+--

1427+-- >>> splitOnSuffixSeq_ "." ""

1428+-- []

1429+--

1430+-- >>> splitOnSuffixSeq_ "." "."

1431+-- [""]

1432+--

1433+-- >>> splitOnSuffixSeq_ "." "a"

1434+-- ["a"]

1435+--

1436+-- >>> splitOnSuffixSeq_ "." ".a"

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

1438+--

1439+-- >>> splitOnSuffixSeq_ "." "a."

1440+-- > ["a"]

1441+--

1442+-- >>> splitOnSuffixSeq_ "." "a.b"

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

1444+--

1445+-- >>> splitOnSuffixSeq_ "." "a.b."

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

1447+--

1448+-- >>> splitOnSuffixSeq_ "." "a..b.."

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

1450+--

1451+-- > lines = splitOnSuffixSeq "\n"

1452+--

1453+-- 'splitOnSuffixSeq' is an inverse of 'intercalateSuffix'. The following law

1454+-- always holds:

1455+--

1456+-- > intercalateSuffix . splitOnSuffixSeq == id

1457+--

1458+-- The following law holds when the separator is non-empty and contains none of

1459+-- the elements present in the input lists:

1460+--

1461+-- > splitSuffixOn . intercalateSuffix == id

1462+--

1463+-- /Internal/

1464+{-# INLINE splitOnSuffixSeq #-}

1465+splitOnSuffixSeq

1466+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

1467+ => Array a -> Fold m a b -> t m a -> t m b

1468+splitOnSuffixSeq patt f m =

1469+ D.fromStreamD $ D.splitOnSuffixSeq False patt f (D.toStreamD m)

1470+

1471+{-

1472+-- | Like 'splitOn' but drops any empty splits.

1473+--

1474+{-# INLINE wordsOn #-}

1475+wordsOn

1476+ :: (IsStream t, Monad m, Storable a, Eq a)

1477+ => Array a -> Fold m a b -> t m a -> t m b

1478+wordsOn subseq f m = undefined -- D.fromStreamD $ D.wordsOn f subseq (D.toStreamD m)

1479+-}

1480+

1481+-- | Like 'splitOnSuffixSeq' but keeps the suffix intact in the splits.

1482+--

1483+-- > splitWithSuffixSeq'_ pat xs = S.toList $ S.splitWithSuffixSeq (A.fromList pat) (FL.toList) (S.fromList xs)

1484+--

1485+-- >>> splitWithSuffixSeq' "." ""

1486+-- [""]

1487+--

1488+-- >>> splitWithSuffixSeq' "." "."

1489+-- ["."]

1490+--

1491+-- >>> splitWithSuffixSeq' "." "a"

1492+-- ["a"]

1493+--

1494+-- >>> splitWithSuffixSeq' "." ".a"

1495+-- > [".","a"]

1496+--

1497+-- >>> splitWithSuffixSeq' "." "a."

1498+-- > ["a."]

1499+--

1500+-- >>> splitWithSuffixSeq' "." "a.b"

1501+-- > ["a.","b"]

1502+--

1503+-- >>> splitWithSuffixSeq' "." "a.b."

1504+-- > ["a.","b."]

1505+--

1506+-- >>> splitWithSuffixSeq' "." "a..b.."

1507+-- > ["a.",".","b.","."]

1508+--

1509+-- /Internal/

1510+{-# INLINE splitWithSuffixSeq #-}

1511+splitWithSuffixSeq

1512+ :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

1513+ => Array a -> Fold m a b -> t m a -> t m b

1514+splitWithSuffixSeq patt f m =

1515+ D.fromStreamD $ D.splitOnSuffixSeq True patt f (D.toStreamD m)

1516+

1517+{-

1518+-- This can be implemented easily using Rabin Karp

1519+-- | Split post any one of the given patterns.

1520+{-# INLINE splitOnSuffixSeqAny #-}

1521+splitOnSuffixSeqAny

1522+ :: (IsStream t, Monad m, Storable a, Integral a)

1523+ => [Array a] -> Fold m a b -> t m a -> t m b

1524+splitOnSuffixSeqAny subseq f m = undefined

1525+ -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)

1526+-}

1527+

1528+------------------------------------------------------------------------------

1529+-- Chunking

1530+------------------------------------------------------------------------------

1531+

1532+-- | Group the input stream into groups of @n@ elements each and then fold each

1533+-- group using the provided fold function.

1534+--

1535+-- >> S.toList $ S.chunksOf 2 FL.sum (S.enumerateFromTo 1 10)

1536+-- > [3,7,11,15,19]

1537+--

1538+-- This can be considered as an n-fold version of 'ltake' where we apply

1539+-- 'ltake' repeatedly on the leftover stream until the stream exhausts.

1540+--

1541+-- @since 0.7.0

1542+{-# INLINE chunksOf #-}

1543+chunksOf

1544+ :: (IsStream t, Monad m)

1545+ => Int -> Fold m a b -> t m a -> t m b

1546+chunksOf n f = foldMany (FL.ltake n f)

1547+

1548+-- |

1549+--

1550+-- /Internal/

1551+{-# INLINE chunksOf2 #-}

1552+chunksOf2

1553+ :: (IsStream t, Monad m)

1554+ => Int -> m c -> Fold2 m c a b -> t m a -> t m b

1555+chunksOf2 n action f m = D.fromStreamD $ D.groupsOf2 n action f (D.toStreamD m)

1556+

1557+-- | @arraysOf n stream@ groups the elements in the input stream into arrays of

1558+-- @n@ elements each.

1559+--

1560+-- Same as the following but may be more efficient:

1561+--

1562+-- > arraysOf n = S.chunksOf n (A.writeN n)

1563+--

1564+-- /Internal/

1565+{-# INLINE arraysOf #-}

1566+arraysOf :: (IsStream t, MonadIO m, Storable a)

1567+ => Int -> t m a -> t m (Array a)

1568+arraysOf n = chunksOf n (writeNUnsafe n)

1569+

1570+-- XXX we can implement this by repeatedly applying the 'lrunFor' fold.

1571+-- XXX add this example after fixing the serial stream rate control

1572+-- >>> S.toList $ S.take 5 $ intervalsOf 1 FL.sum $ constRate 2 $ S.enumerateFrom 1

1573+-- > [3,7,11,15,19]

1574+--

1575+-- | Group the input stream into windows of @n@ second each and then fold each

1576+-- group using the provided fold function.

1577+--

1578+-- @since 0.7.0

1579+{-# INLINE intervalsOf #-}

1580+intervalsOf

1581+ :: (IsStream t, MonadAsync m)

1582+ => Double -> Fold m a b -> t m a -> t m b

1583+intervalsOf n f xs =

1584+ splitWithSuffix isNothing (FL.lcatMaybes f)

1585+ (interjectSuffix n (return Nothing) (Serial.map Just xs))

1586+

1587+------------------------------------------------------------------------------

1588+-- Windowed classification

1589+------------------------------------------------------------------------------

1590+

1591+-- We divide the stream into windows or chunks in space or time and each window

1592+-- can be associated with a key, all events associated with a particular key in

1593+-- the window can be folded to a single result. The stream can be split into

1594+-- windows by size or by using a split predicate on the elements in the stream.

1595+-- For example, when we receive a closing flag, we can close the window.

1596+--

1597+-- A "chunk" is a space window and a "session" is a time window. Are there any

1598+-- other better short words to describe them. An alternative is to use

1599+-- "swindow" and "twindow". Another word for "session" could be "spell".

1600+--

1601+-- TODO: To mark the position in space or time we can have Indexed or

1602+-- TimeStamped types. That can make it easy to deal with the position indices

1603+-- or timestamps.

1604+

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

1606+-- Keyed Sliding Windows

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

1608+

1609+{-

1610+{-# INLINABLE classifySlidingChunks #-}

1611+classifySlidingChunks

1612+ :: (IsStream t, MonadAsync m, Ord k)

1613+ => Int -- ^ window size

1614+ -> Int -- ^ window slide

1615+ -> Fold m a b -- ^ Fold to be applied to window events

1616+ -> t m (k, a, Bool) -- ^ window key, data, close event

1617+ -> t m (k, b)

1618+classifySlidingChunks wsize wslide (Fold step initial extract) str

1619+ = undefined

1620+

1621+-- XXX Another variant could be to slide the window on an event, e.g. in TCP we

1622+-- slide the send window when an ack is received and we slide the receive

1623+-- window when a sequence is complete. Sliding is stateful in case of TCP,

1624+-- sliding releases the send buffer or makes data available to the user from

1625+-- the receive buffer.

1626+{-# INLINABLE classifySlidingSessions #-}

1627+classifySlidingSessions

1628+ :: (IsStream t, MonadAsync m, Ord k)

1629+ => Double -- ^ timer tick in seconds

1630+ -> Double -- ^ time window size

1631+ -> Double -- ^ window slide

1632+ -> Fold m a b -- ^ Fold to be applied to window events

1633+ -> t m (k, a, Bool, AbsTime) -- ^ window key, data, close flag, timestamp

1634+ -> t m (k, b)

1635+classifySlidingSessions tick interval slide (Fold step initial extract) str

1636+ = undefined

1637+-}

1638+

1639+------------------------------------------------------------------------------

1640+-- Sliding Window Buffers

1641+------------------------------------------------------------------------------

1642+

1643+-- These buffered versions could be faster than concurrent incremental folds of

1644+-- all overlapping windows as in many cases we may not need all the values to

1645+-- compute the fold, we can just compute the result using the old value and new

1646+-- value. However, we may need the buffer once in a while, for example for

1647+-- string search we usually compute the hash incrementally but when the hash

1648+-- matches the hash of the pattern we need to compare the whole string.

1649+--

1650+-- XXX we should be able to implement sequence based splitting combinators

1651+-- using this combinator.

1652+

1653+{-

1654+-- | Buffer n elements of the input in a ring buffer. When t new elements are

1655+-- collected, slide the window to remove the same number of oldest elements,

1656+-- insert the new elements, and apply an incremental fold on the sliding

1657+-- window, supplying the outgoing elements, the new ring buffer as arguments.

1658+slidingChunkBuffer

1659+ :: (IsStream t, Monad m, Ord a, Storable a)

1660+ => Int -- window size

1661+ -> Int -- window slide

1662+ -> Fold m (Ring a, Array a) b

1663+ -> t m a

1664+ -> t m b

1665+slidingChunkBuffer = undefined

1666+

1667+-- Buffer n seconds worth of stream elements of the input in a radix tree.

1668+-- Every t seconds, remove the items that are older than n seconds, and apply

1669+-- an incremental fold on the sliding window, supplying the outgoing elements,

1670+-- and the new radix tree buffer as arguments.

1671+slidingSessionBuffer

1672+ :: (IsStream t, Monad m, Ord a, Storable a)

1673+ => Int -- window size

1674+ -> Int -- tick size

1675+ -> Fold m (RTree a, Array a) b

1676+ -> t m a

1677+ -> t m b

1678+slidingSessionBuffer = undefined

1679+-}

1680+

1681+------------------------------------------------------------------------------

1682+-- Keyed Session Windows

1683+------------------------------------------------------------------------------

1684+

1685+{-

1686+-- | Keyed variable size space windows. Close the window if we do not receive a

1687+-- window event in the next "spaceout" elements.

1688+{-# INLINABLE classifyChunksBy #-}

1689+classifyChunksBy

1690+ :: (IsStream t, MonadAsync m, Ord k)

1691+ => Int -- ^ window spaceout (spread)

1692+ -> Bool -- ^ reset the spaceout when a chunk window element is received

1693+ -> Fold m a b -- ^ Fold to be applied to chunk window elements

1694+ -> t m (k, a, Bool) -- ^ chunk key, data, last element

1695+ -> t m (k, b)

1696+classifyChunksBy spanout reset (Fold step initial extract) str = undefined

1697+

1698+-- | Like 'classifyChunksOf' but the chunk size is reset if an element is

1699+-- received within the chunk size window. The chunk gets closed only if no

1700+-- element is received within the chunk window.

1701+--

1702+{-# INLINABLE classifyKeepAliveChunks #-}

1703+classifyKeepAliveChunks

1704+ :: (IsStream t, MonadAsync m, Ord k)

1705+ => Int -- ^ window spaceout (spread)

1706+ -> Fold m a b -- ^ Fold to be applied to chunk window elements

1707+ -> t m (k, a, Bool) -- ^ chunk key, data, last element

1708+ -> t m (k, b)

1709+classifyKeepAliveChunks spanout = classifyChunksBy spanout True

1710+-}

1711+

1712+data SessionState t m k a b = SessionState

1713+ { sessionCurTime :: !AbsTime -- ^ time since last event

1714+ , sessionEventTime :: !AbsTime -- ^ time as per last event

1715+ , sessionCount :: !Int -- ^ total number sessions in progress

1716+ , sessionTimerHeap :: H.Heap (H.Entry AbsTime k) -- ^ heap for timeouts

1717+ , sessionKeyValueMap :: Map.Map k a -- ^ Stored sessions for keys

1718+ , sessionOutputStream :: t (m :: Type -> Type) (k, b) -- ^ Completed sessions

1719+ }

1720+

1721+-- XXX Perhaps we should use an "Event a" type to represent timestamped data.

1722+-- | @classifySessionsBy tick timeout idle pred f stream@ groups timestamped

1723+-- events in an input event stream into sessions based on a session key. Each

1724+-- element in the input stream is an event consisting of a triple @(session key,

1725+-- sesssion data, timestamp)@. @session key@ is a key that uniquely identifies

1726+-- the session. All the events belonging to a session are folded using the fold

1727+-- @f@ until the fold terminates or a timeout has occurred. The session key and

1728+-- the result of the fold are emitted in the output stream when the session is

1729+-- purged.

1730+--

1731+-- When @idle@ is 'False', @timeout@ is the maximum lifetime of a session in

1732+-- seconds, measured from the @timestamp@ of the first event in that session.

1733+-- When @idle@ is 'True' then the timeout is an idle timeout, it is reset after

1734+-- every event received in the session.

1735+--

1736+-- @timestamp@ in an event characterizes the time when the input event was

1737+-- generated, this is an absolute time measured from some @Epoch@. The notion

1738+-- of current time is maintained by a monotonic event time clock using the

1739+-- timestamps seen in the input stream. The latest timestamp seen till now is

1740+-- used as the base for the current time. When no new events are seen, a timer

1741+-- is started with a tick duration specified by @tick@. This timer is used to

1742+-- detect session timeouts in the absence of new events.

1743+--

1744+-- The predicate @pred@ is invoked with the current session count, if it

1745+-- returns 'True' a session is ejected from the session cache before inserting

1746+-- a new session. This could be useful to alert or eject sessions when the

1747+-- number of sessions becomes too high.

1748+--

1749+-- /Internal/

1750+--

1751+{-# INLINABLE classifySessionsBy #-}

1752+classifySessionsBy

1753+ :: (IsStream t, MonadAsync m, Ord k)

1754+ => Double -- ^ timer tick in seconds

1755+ -> Double -- ^ session timeout in seconds

1756+ -> Bool -- ^ reset the timeout when an event is received

1757+ -> (Int -> m Bool) -- ^ predicate to eject sessions based on session count

1758+ -> Fold m a b -- ^ Fold to be applied to session events

1759+ -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

1760+ -> t m (k, b) -- ^ session key, fold result

1761+classifySessionsBy tick tmout reset ejectPred

1762+ (Fold step initial extract) str =

1763+ concatMap sessionOutputStream $

1764+ scanlMAfter' sstep (return szero) flush stream

1765+

1766+ where

1767+

1768+ timeoutMs = toRelTime (round (tmout * 1000) :: MilliSecond64)

1769+ tickMs = toRelTime (round (tick * 1000) :: MilliSecond64)

1770+ szero = SessionState

1771+ { sessionCurTime = toAbsTime (0 :: MilliSecond64)

1772+ , sessionEventTime = toAbsTime (0 :: MilliSecond64)

1773+ , sessionCount = 0

1774+ , sessionTimerHeap = H.empty

1775+ , sessionKeyValueMap = Map.empty

1776+ , sessionOutputStream = K.nil

1777+ }

1778+

1779+ -- We can eject sessions based on the current session count to limit

1780+ -- memory consumption. There are two possible strategies:

1781+ --

1782+ -- 1) Eject old sessions or sessions beyond a certain/lower timeout

1783+ -- threshold even before timeout, effectively reduce the timeout.

1784+ -- 2) Drop creation of new sessions but keep accepting new events for the

1785+ -- old ones.

1786+ --

1787+ -- We use the first strategy as of now.

1788+

1789+ -- Got a new stream input element

1790+ sstep session@SessionState{..} (Just (key, value, timestamp)) = do

1791+ -- XXX we should use a heap in pinned memory to scale it to a large

1792+ -- size

1793+ --

1794+ -- To detect session inactivity we keep a timestamp of the latest event

1795+ -- in the Map along with the fold result. When we purge the session

1796+ -- from the heap we match the timestamp in the heap with the timestamp

1797+ -- in the Map, if the latest timestamp is newer and has not expired we

1798+ -- reinsert the key in the heap.

1799+ --

1800+ -- XXX if the key is an Int, we can also use an IntMap for slightly

1801+ -- better performance.

1802+ --

1803+ let curTime = max sessionEventTime timestamp

1804+ mOld = Map.lookup key sessionKeyValueMap

1805+

1806+ fs <-

1807+ case mOld of

1808+ Nothing -> initial

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

1810+ res <- step fs value

1811+ case res of

1812+ FL.Done fb -> do

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

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

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

1816+ -- lookup in the Map when the key is purged from the heap, that

1817+ -- should not be expensive.

1818+ --

1819+ let (mp, cnt) = case mOld of

1820+ Nothing -> (sessionKeyValueMap, sessionCount)

1821+ Just _ -> (Map.delete key sessionKeyValueMap

1822+ , sessionCount - 1)

1823+ return $ session

1824+ { sessionCurTime = curTime

1825+ , sessionEventTime = curTime

1826+ , sessionCount = cnt

1827+ , sessionKeyValueMap = mp

1828+ , sessionOutputStream = yield (key, fb)

1829+ }

1830+ FL.Partial fs1 -> do

1831+ let acc = Tuple' timestamp fs1

1832+ (hp1, mp1, out1, cnt1) <- do

1833+ let vars = (sessionTimerHeap, sessionKeyValueMap,

1834+ K.nil, sessionCount)

1835+ case mOld of

1836+ -- inserting new entry

1837+ Nothing -> do

1838+ -- Eject a session from heap and map is needed

1839+ eject <- ejectPred sessionCount

1840+ (hp, mp, out, cnt) <-

1841+ if eject

1842+ then ejectOne vars

1843+ else return vars

1844+

1845+ -- Insert the new session in heap

1846+ let expiry = addToAbsTime timestamp timeoutMs

1847+ hp' = H.insert (Entry expiry key) hp

1848+ in return (hp', mp, out, cnt + 1)

1849+ -- updating old entry

1850+ Just _ -> return vars

1851+

1852+ let mp2 = Map.insert key acc mp1

1853+ return $ SessionState

1854+ { sessionCurTime = curTime

1855+ , sessionEventTime = curTime

1856+ , sessionCount = cnt1

1857+ , sessionTimerHeap = hp1

1858+ , sessionKeyValueMap = mp2

1859+ , sessionOutputStream = out1

1860+ }

1861+

1862+ -- Got a timer tick event

1863+ sstep sessionState@SessionState{..} Nothing =

1864+ let curTime = addToAbsTime sessionCurTime tickMs

1865+ in ejectExpired sessionState curTime

1866+

1867+ flush session@SessionState{..} = do

1868+ (hp', mp', out, count) <-

1869+ ejectAll

1870+ ( sessionTimerHeap

1871+ , sessionKeyValueMap

1872+ , K.nil

1873+ , sessionCount

1874+ )

1875+ return $ session

1876+ { sessionCount = count

1877+ , sessionTimerHeap = hp'

1878+ , sessionKeyValueMap = mp'

1879+ , sessionOutputStream = out

1880+ }

1881+

1882+ -- delete from map and output the fold accumulator

1883+ ejectEntry hp mp out cnt acc key = do

1884+ sess <- extract acc

1885+ let out1 = (key, sess) `K.cons` out

1886+ let mp1 = Map.delete key mp

1887+ return (hp, mp1, out1, cnt - 1)

1888+

1889+ ejectAll (hp, mp, out, !cnt) = do

1890+ let hres = H.uncons hp

1891+ case hres of

1892+ Just (Entry _ key, hp1) -> do

1893+ r <- case Map.lookup key mp of

1894+ Nothing -> return (hp1, mp, out, cnt)

1895+ Just (Tuple' _ acc) -> ejectEntry hp1 mp out cnt acc key

1896+ ejectAll r

1897+ Nothing -> do

1898+ assert (Map.null mp) (return ())

1899+ return (hp, mp, out, cnt)

1900+

1901+ ejectOne (hp, mp, out, !cnt) = do

1902+ let hres = H.uncons hp

1903+ case hres of

1904+ Just (Entry expiry key, hp1) ->

1905+ case Map.lookup key mp of

1906+ Nothing -> ejectOne (hp1, mp, out, cnt)

1907+ Just (Tuple' latestTS acc) -> do

1908+ let expiry1 = addToAbsTime latestTS timeoutMs

1909+ if not reset || expiry1 <= expiry

1910+ then ejectEntry hp1 mp out cnt acc key

1911+ else

1912+ -- reset the session timeout and continue

1913+ let hp2 = H.insert (Entry expiry1 key) hp1

1914+ in ejectOne (hp2, mp, out, cnt)

1915+ Nothing -> do

1916+ assert (Map.null mp) (return ())

1917+ return (hp, mp, out, cnt)

1918+

1919+ ejectExpired session@SessionState{..} curTime = do

1920+ (hp', mp', out, count) <-

1921+ ejectLoop sessionTimerHeap sessionKeyValueMap K.nil sessionCount

1922+ return $ session

1923+ { sessionCurTime = curTime

1924+ , sessionCount = count

1925+ , sessionTimerHeap = hp'

1926+ , sessionKeyValueMap = mp'

1927+ , sessionOutputStream = out

1928+ }

1929+

1930+ where

1931+

1932+ ejectLoop hp mp out !cnt = do

1933+ let hres = H.uncons hp

1934+ case hres of

1935+ Just (Entry expiry key, hp1) -> do

1936+ (eject, force) <-

1937+ if curTime >= expiry

1938+ then return (True, False)

1939+ else do

1940+ r <- ejectPred cnt

1941+ return (r, r)

1942+ if eject

1943+ then

1944+ case Map.lookup key mp of

1945+ Nothing -> ejectLoop hp1 mp out cnt

1946+ Just (Tuple' latestTS acc) -> do

1947+ let expiry1 = addToAbsTime latestTS timeoutMs

1948+ if expiry1 <= curTime || not reset || force

1949+ then do

1950+ (hp2,mp1,out1,cnt1) <-

1951+ ejectEntry hp1 mp out cnt acc key

1952+ ejectLoop hp2 mp1 out1 cnt1

1953+ else

1954+ -- reset the session timeout and continue

1955+ let hp2 = H.insert (Entry expiry1 key) hp1

1956+ in ejectLoop hp2 mp out cnt

1957+ else return (hp, mp, out, cnt)

1958+ Nothing -> do

1959+ assert (Map.null mp) (return ())

1960+ return (hp, mp, out, cnt)

1961+

1962+ -- merge timer events in the stream

1963+ stream = Serial.map Just str `Par.parallelFst` repeatM timer

1964+ timer = do

1965+ liftIO $ threadDelay (round $ tick * 1000000)

1966+ return Nothing

1967+

1968+-- | Like 'classifySessionsOf' but the session is kept alive if an event is

1969+-- received within the session window. The session times out and gets closed

1970+-- only if no event is received within the specified session window size.

1971+--

1972+-- If the ejection predicate returns 'True', the session that was idle for

1973+-- the longest time is ejected before inserting a new session.

1974+--

1975+-- @

1976+-- classifyKeepAliveSessions timeout pred = classifySessionsBy 1 timeout True pred

1977+-- @

1978+--

1979+-- /Internal/

1980+--

1981+{-# INLINABLE classifyKeepAliveSessions #-}

1982+classifyKeepAliveSessions ::

1983+ (IsStream t, MonadAsync m, Ord k)

1984+ => Double -- ^ session inactive timeout

1985+ -> (Int -> m Bool) -- ^ predicate to eject sessions on session count

1986+ -> Fold m a b -- ^ Fold to be applied to session payload data

1987+ -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

1988+ -> t m (k, b)

1989+classifyKeepAliveSessions tmout =

1990+ classifySessionsBy 1 tmout True

1991+

1992+------------------------------------------------------------------------------

1993+-- Keyed tumbling windows

1994+------------------------------------------------------------------------------

1995+

1996+-- Tumbling windows is a special case of sliding windows where the window slide

1997+-- is the same as the window size. Or it can be a special case of session

1998+-- windows where the reset flag is set to False.

1999+

2000+-- XXX instead of using the early termination flag in the stream, we can use an

2001+-- early terminating fold instead.

2002+

2003+{-

2004+-- | Split the stream into fixed size chunks of specified size. Within each

2005+-- such chunk fold the elements in buckets identified by the keys. A particular

2006+-- bucket fold can be terminated early if a closing flag is encountered in an

2007+-- element for that key.

2008+--

2009+-- @since 0.7.0

2010+{-# INLINABLE classifyChunksOf #-}

2011+classifyChunksOf

2012+ :: (IsStream t, MonadAsync m, Ord k)

2013+ => Int -- ^ window size

2014+ -> Fold m a b -- ^ Fold to be applied to window events

2015+ -> t m (k, a, Bool) -- ^ window key, data, close event

2016+ -> t m (k, b)

2017+classifyChunksOf wsize = classifyChunksBy wsize False

2018+-}

2019+

2020+-- | Split the stream into fixed size time windows of specified interval in

2021+-- seconds. Within each such window, fold the elements in sessions identified

2022+-- by the session keys. The fold result is emitted in the output stream if the

2023+-- fold returns a 'Left' result or if the time window ends.

2024+--

2025+-- Session @timestamp@ in the input stream is an absolute time from some epoch,

2026+-- characterizing the time when the input element was generated. To detect

2027+-- session window end, a monotonic event time clock is maintained synced with

2028+-- the timestamps with a clock resolution of 1 second.

2029+--

2030+-- If the ejection predicate returns 'True', the session with the longest

2031+-- lifetime is ejected before inserting a new session.

2032+--

2033+-- @

2034+-- classifySessionsOf interval pred = classifySessionsBy 1 interval False pred

2035+-- @

2036+--

2037+-- @

2038+-- >>> S.mapM_ print

2039+-- $ S.classifySessionsOf 3 (const (return False)) (fmap Right FL.toList)

2040+-- $ S.map (\(ts,(k,a)) -> (k, a, ts))

2041+-- $ S.timestamped

2042+-- $ S.delay 1

2043+-- $ (,) <$> S.fromList [1,2,3] <*> S.fromList [1,2,3]

2044+-- @

2045+--

2046+-- /Internal/

2047+--

2048+{-# INLINABLE classifySessionsOf #-}

2049+classifySessionsOf ::

2050+ (IsStream t, MonadAsync m, Ord k)

2051+ => Double -- ^ time window size

2052+ -> (Int -> m Bool) -- ^ predicate to eject sessions on session count

2053+ -> Fold m a b -- ^ Fold to be applied to session events

2054+ -> t m (k, a, AbsTime) -- ^ session key, data, timestamp

2055+ -> t m (k, b)

2056+classifySessionsOf interval =

2057+ classifySessionsBy 1 interval False

2058+

2059+------------------------------------------------------------------------------

2060+-- Nested Split

2061+------------------------------------------------------------------------------

2062+

2063+-- | @splitInnerBy splitter joiner stream@ splits the inner containers @f a@ of

2064+-- an input stream @t m (f a)@ using the @splitter@ function. Container

2065+-- elements @f a@ are collected until a split occurs, then all the elements

2066+-- before the split are joined using the @joiner@ function.

2067+--

2068+-- For example, if we have a stream of @Array Word8@, we may want to split the

2069+-- stream into arrays representing lines separated by '\n' byte such that the

2070+-- resulting stream after a split would be one array for each line.

2071+--

2072+-- CAUTION! This is not a true streaming function as the container size after

2073+-- the split and merge may not be bounded.

2074+--

2075+-- /Internal/

2076+{-# INLINE splitInnerBy #-}

2077+splitInnerBy

2078+ :: (IsStream t, Monad m)

2079+ => (f a -> m (f a, Maybe (f a))) -- splitter

2080+ -> (f a -> f a -> m (f a)) -- joiner

2081+ -> t m (f a)

2082+ -> t m (f a)

2083+splitInnerBy splitter joiner xs =

2084+ D.fromStreamD $ D.splitInnerBy splitter joiner $ D.toStreamD xs

2085+

2086+-- | Like 'splitInnerBy' but splits assuming the separator joins the segment in

2087+-- a suffix style.

2088+--

2089+-- /Internal/

2090+{-# INLINE splitInnerBySuffix #-}

2091+splitInnerBySuffix

2092+ :: (IsStream t, Monad m, Eq (f a), Monoid (f a))

2093+ => (f a -> m (f a, Maybe (f a))) -- splitter

2094+ -> (f a -> f a -> m (f a)) -- joiner

2095+ -> t m (f a)

2096+ -> t m (f a)

2097+splitInnerBySuffix splitter joiner xs =

2098+ D.fromStreamD $ D.splitInnerBySuffix splitter joiner $ D.toStreamD xs

src/Streamly/Internal/Data/Stream/IsStream/Transform.hs+836−2384

@@ -8,17 +8,22 @@

99module Streamly.Internal.Data.Stream.IsStream.Transform

1010 (

11− -- * Transformation

11+ -- * Piping

12+ -- | Pass through a 'Pipe'.

1213 transform

1314

14− -- ** Mapping

15+ -- * Folding

16+ , foldrS

17+ , foldrT

18+

19+ -- * Mapping

20+ -- | Stateless one-to-one maps.

1521 , Serial.map

1622 , sequence

1723 , mapM

1824 , smapM

19− -- $smapM_Notes

2025

21− -- ** Special Maps

26+ -- * Mapping Side Effects

2227 , trace

2328 , trace_

2429 , tap

@@ -27,13 +32,12 @@ module Streamly.Internal.Data.Stream.IsStream.Transform

2732 , tapRate

2833 , pollCounts

2934

30− -- ** Folding

31− -- ** Right folds

32− , foldrS

33− , foldrT

35+ -- * Scanning By 'Fold'

36+ , scan

37+ , postscan

3438

35− -- ** Scanning

36− -- ** Left scans

39+ -- * Scanning

40+ -- | Left scans. Stateful, mostly one-to-one maps.

3741 , scanl'

3842 , scanlM'

3943 , scanlMAfter'

@@ -44,10 +48,6 @@ module Streamly.Internal.Data.Stream.IsStream.Transform

4448 , scanl1'

4549 , scanl1M'

4650

47− -- ** Scan Using Fold

48− , scan

49− , postscan

50−

5151 -- XXX Once we have pipes the contravariant transformations can be

5252 -- represented by attaching pipes before a transformation.

5353 --

@@ -61,69 +61,20 @@ module Streamly.Internal.Data.Stream.IsStream.Transform

6161 -- , lprescanl'

6262 -- , lprescanlM'

6363

64− -- ** Concurrent Transformation

65− , D.mkParallel

66− -- Par.mkParallel

67− , applyAsync

68− , (|$)

69− , (|&)

70−

71− -- ** Filtering

64+ -- * Filtering

65+ -- | Produce a subset of the stream.

7266

7367 , filter

7468 , filterM

75−

76− -- ** Deleting Elements

7769 , deleteBy

7870 , uniq

7971 -- , uniqBy -- by predicate e.g. to remove duplicate "/" in a path

8072 -- , uniqOn -- to remove duplicate sequences

8173 -- , pruneBy -- dropAround + uniqBy - like words

8274

83− -- ** Inserting Elements

84−

85− , insertBy

86− , intersperseM

87− , intersperseM_

88− , intersperse

89− , intersperseSuffix

90− , intersperseSuffix_

91− , interspersePrefix_

92− , intersperseSuffixBySpan

93− -- , intersperseBySpan

94− -- , intersperseByIndices -- using an index function/stream

95−

96− -- time domain intersperse

97− -- , intersperseByTime

98− -- , intersperseByEvent

99− , delay

100− , delayPost

101− , delayPre

102−

103− -- ** Indexing

104− , indexed

105− , indexedR

106− -- , timestampedR -- timer

107−

108− -- ** Reordering

109− , reverse

110− , reverse'

75+ -- * Trimming

76+ -- | Produce a subset of the stream trimmed at ends.

11177

112− -- ** Composable Left Folds

113− -- | See "Streamly.Internal.Data.Fold"

114− , foldMany

115− , foldSequence

116− , foldIterate

117−

118− -- ** Parsers

119− -- | See "Streamly.Internal.Data.Parser"

120− , parseMany

121− , parseManyD

122− , parseManyTill

123− , parseSequence

124− , parseIterate

125−

126− -- ** Trimming

12778 , take

12879 -- , takeGE

12980 -- , takeBetween

@@ -139,170 +90,74 @@ module Streamly.Internal.Data.Stream.IsStream.Transform

13990 , dropWhileM

14091 -- , dropWhileEnd

14192 -- , dropAround

142− , dropPrefix

143− , dropInfix

144− , dropSuffix

145−

146− -- ** Breaking

147−

148− -- Nary

149− , chunksOf

150− , chunksOf2

151− , arraysOf

152−

153− -- ** Searching

154− -- -- *** Searching Elements

155− , findIndices

156− , elemIndices

157−

158− -- -- *** Searching Sequences

159− -- , seqIndices -- search a sequence in the stream

160−

161− -- -- *** Searching Multiple Sequences

162− -- , seqIndicesAny -- search any of the given sequence in the stream

163−

164− -- -- -- ** Searching Streams

165− -- -- | Finding a stream within another stream.

166−

167− -- ** Splitting

168− -- | Streams can be sliced into segments in space or in time. We use the

169− -- term @chunk@ to refer to a spatial length of the stream (spatial window)

170− -- and the term @session@ to refer to a length in time (time window).

17193

172− -- -- *** Using Element Separators

173− , splitOn

174− , splitOnSuffix

175− -- , splitOnPrefix

94+ -- * Inserting Elements

95+ -- | Produce a superset of the stream.

17696

177− -- , splitBy

178− , splitWithSuffix

179− -- , splitByPrefix

180− , wordsBy -- stripAndCompactBy

181−

182− -- -- *** Splitting By Sequences

183− , splitOnSeq

184− , splitOnSuffixSeq

185− -- , splitOnPrefixSeq

186−

187− -- Keeping the delimiters

188− , splitWithSuffixSeq

189− -- , splitByPrefixSeq

190− -- , wordsBySeq

97+ , insertBy

98+ , intersperse

99+ , intersperseM -- XXX naming

100+ , intersperseSuffix

101+ , intersperseSuffixBySpan

102+ -- , intersperseBySpan

103+ -- , intersperseByIndices -- using an index function/stream

191104

192− -- Splitting using multiple sequence separators

193− -- , splitOnAnySeq

194− -- , splitOnAnySuffixSeq

195− -- , splitOnAnyPrefixSeq

105+ -- * Inserting Side Effects

106+ , intersperseM_ -- XXX naming

107+ , intersperseSuffix_

108+ , interspersePrefix_

196109

197− -- -- *** Splitting By Streams

198− -- -- | Splitting a stream using another stream as separator.

110+ -- * Inserting Time

111+ -- , intersperseByTime

112+ -- , intersperseByEvent

113+ , interjectSuffix

114+ , delay

115+ , delayPost

116+ , delayPre

199117

200− -- Nested splitting

201− , splitInnerBy

202− , splitInnerBySuffix

118+ -- * Reordering

119+ , reverse

120+ , reverse'

121+ , reassembleBy

203122

204− -- ** Grouping

205− -- In imperative terms, grouped folding can be considered as a nested loop

206− -- where we loop over the stream to group elements and then loop over

207− -- individual groups to fold them to a single value that is yielded in the

208− -- output stream.

123+ -- * Position Indexing

124+ , indexed

125+ , indexedR

209126

210− -- , groupScan

127+ -- * Time Indexing

128+ , timestamped

129+ , timestampWith

130+ -- , timestampedR -- timer

131+ , timeIndexed

132+ , timeIndexWith

211133

212− , groups

213− , groupsBy

214− , groupsByRolling

134+ -- * Searching

135+ , findIndices -- XXX indicesBy

136+ , elemIndices -- XXX indicesOf

215137

216− -- ** Group map

138+ -- * Rolling map

139+ -- | Map using the previous element.

217140 , rollingMapM

218141 , rollingMap

219142

220− -- ** Appending

221− , serial

222− , append

223−

224− -- ** Interleaving

225− , interleave

226− , interleaveMin

227− , interleaveSuffix

228− , interleaveInfix

229−

230− , wSerial

231− , Serial.wSerialFst

232− , Serial.wSerialMin

233−

234− -- ** Scheduling

235− , ahead

236− , async

237− , wAsync

238− , roundrobin

239−

240− -- ** Parallel

241− , parallel

242− , Par.parallelFst

243− , Par.parallelMin

244−

245− -- ** Merging

246− -- , merge

247− , mergeBy

248− , mergeByM

249− , mergeAsyncBy

250− , mergeAsyncByM

251−

252− -- ** Zipping

253− , Z.zipWith

254− , Z.zipWithM

255− , Z.zipAsyncWith

256− , Z.zipAsyncWithM

257−

258− -- ** Flattening a Container of Streams

259− , concatFoldableWith

260− , concatMapFoldableWith

261− , concatForFoldableWith

262−

263− -- ** Flattening a Stream of Streams

264− , concat

265− , concatMap

266− , concatMapM

267− , concatMapWith

268− , concatSmapMWith

269− -- , bindWith

270−

271− -- ** Flattening Using Unfolds

272− , concatUnfold

273− , concatUnfoldInterleave

274− , concatUnfoldRoundrobin

275−

276− -- ** Inserting Streams in Streams

277− , gintercalate

278− , gintercalateSuffix

279− , intercalate

280− , intercalateSuffix

281− , interpose

282− , interposeSuffix

283− -- , interposeBy

284−

285− -- * Generalize Inner Monad

286− , hoist

287− , generally

288−

289− -- * Transform Inner Monad

290− , liftInner

291− , usingReaderT

292− , runReaderT

293− , evalStateT

294− , usingStateT

295− , runStateT

296−

297− -- ** Maybe Streams

298− , catMaybes

143+ -- * Maybe Streams

144+ , catMaybes -- XXX justs (like lefts/rights)

299145 , mapMaybe

300146 , mapMaybeM

301147

302− -- ** Either Streams

148+ -- * Either Streams

303149 , lefts

304150 , rights

305151

152+ -- * Threading

153+ -- | Run streaming stages concurrently.

154+

155+ , D.mkParallel

156+ -- Par.mkParallel

157+ , applyAsync

158+ , (|$)

159+ , (|&)

160+

306161 -- * Deprecated

307162 , scanx

308163 )

@@ -312,43 +167,42 @@ where

312167

313168import Control.Concurrent (threadDelay)

314169import Control.Monad (void)

315−import Control.Monad.Catch (MonadCatch, MonadThrow)

170+import Control.Monad.Catch (MonadCatch)

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

317−import Control.Monad.Trans.Reader (ReaderT)

318−import Control.Monad.Trans.State.Strict (StateT)

319172import Control.Monad.Trans.Class (MonadTrans(..))

320173import Data.Either (isLeft, isRight)

321−import Data.Functor.Identity (Identity (..))

322174import Data.Maybe (isJust, fromJust)

323−import Foreign.Storable (Storable)

324175import Streamly.Internal.BaseCompat (fromLeft, fromRight)

325−import Streamly.Internal.Data.Fold.Types (Fold (..), Fold2 (..))

326−import Streamly.Internal.Data.Parser (Parser (..))

327−import Streamly.Internal.Data.Unfold.Types (Unfold)

328−import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array, writeNUnsafe)

176+import Streamly.Internal.Data.Fold.Types (Fold (..))

329177import Streamly.Internal.Data.SVar (MonadAsync)

330−import Streamly.Internal.Data.Stream.Ahead (ahead)

331−import Streamly.Internal.Data.Stream.Async (async, wAsync)

332−import Streamly.Internal.Data.Stream.Combinators (maxYields)

333−import Streamly.Internal.Data.Stream.Parallel (parallel)

334−import Streamly.Internal.Data.Stream.Prelude

335− (fromStreamS, toStreamS, concatFoldableWith, concatMapFoldableWith

336− , concatForFoldableWith)

178+import Streamly.Internal.Data.Stream.IsStream.Common

179+ ( absTimesWith

180+ , drop

181+ , findIndices

182+ , postscanlM'

183+ , relTimesWith

184+ , reverse

185+ , reverse'

186+ , scanlMAfter'

187+ , smapM

188+ , take

189+ , takeWhile

190+ , interjectSuffix

191+ , intersperseM

192+ )

193+import Streamly.Internal.Data.Stream.Prelude (fromStreamS, toStreamS)

337194import Streamly.Internal.Data.Stream.StreamD (fromStreamD, toStreamD)

338195import Streamly.Internal.Data.Stream.StreamK (IsStream)

339−import Streamly.Internal.Data.Stream.Serial (SerialT, serial, wSerial)

196+import Streamly.Internal.Data.Stream.Serial (SerialT)

340197import Streamly.Internal.Data.Pipe.Types (Pipe (..))

341−import Streamly.Internal.Data.Time.Units (TimeUnit64)

198+import Streamly.Internal.Data.Time.Units ( TimeUnit64, AbsTime, RelTime64)

342199

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

344201import qualified Streamly.Internal.Data.Stream.Prelude as P

345−import qualified Streamly.Internal.Data.Stream.StreamK as K

346−import qualified Streamly.Internal.Data.Stream.StreamD as D

347202import qualified Streamly.Internal.Data.Stream.Serial as Serial

348−import qualified Streamly.Internal.Data.Stream.Parallel as Par

203+import qualified Streamly.Internal.Data.Stream.StreamD as D

204+import qualified Streamly.Internal.Data.Stream.StreamK as K

349205import qualified Streamly.Internal.Data.Stream.Zip as Z

350−import qualified Streamly.Internal.Data.Parser.ParserK.Types as PRK

351−import qualified Streamly.Internal.Data.Parser.ParserD as PRD

352206#ifdef USE_STREAMK_ONLY

353207import qualified Streamly.Internal.Data.Stream.StreamK as S

354208#else

@@ -356,2440 +210,1038 @@ import qualified Streamly.Internal.Data.Stream.StreamD as S

356210#endif

357211

358212import Prelude hiding

359− ( filter, drop, dropWhile, take, takeWhile, zipWith, foldr

360− , foldl, map, mapM, mapM_, sequence, all, any, sum, product, elem

361− , notElem, maximum, minimum, head, last, tail, length, null

362− , reverse, iterate, init, and, or, lookup, foldr1, (!!)

363− , scanl, scanl1, replicate, concatMap, span, splitAt, break

364− , repeat, concat, mconcat)

213+ ( filter, drop, dropWhile, take, takeWhile, foldr, map, mapM, sequence

214+ , reverse, foldr1 , scanl, scanl1)

365215

366216------------------------------------------------------------------------------

367−-- Searching

217+-- Piping

368218------------------------------------------------------------------------------

369219

370−-- | Find all the indices where the element in the stream satisfies the given

371−-- predicate.

372−--

373−-- > findIndices = fold Fold.findIndices

374−--

375−-- @since 0.5.0

376−{-# INLINE findIndices #-}

377−findIndices :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m Int

378−findIndices p m = fromStreamS $ S.findIndices p (toStreamS m)

379−

380−-- | Find all the indices where the value of the element in the stream is equal

381−-- to the given value.

220+-- | Use a 'Pipe' to transform a stream.

382221--

383−-- > elemIndices a = findIndices (== a)

222+-- /Internal/

384223--

385−-- @since 0.5.0

386−{-# INLINE elemIndices #-}

387−elemIndices :: (IsStream t, Eq a, Monad m) => a -> t m a -> t m Int

388−elemIndices a = findIndices (== a)

224+{-# INLINE transform #-}

225+transform :: (IsStream t, Monad m) => Pipe m a b -> t m a -> t m b

226+transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)

389227

390228------------------------------------------------------------------------------

391−-- Concurrent Application

229+-- Transformation Folds

392230------------------------------------------------------------------------------

393231

394−infixr 0 |$

395−infixl 1 |&

396−

397−-- | Parallel transform application operator; applies a stream transformation

398−-- function @t m a -> t m b@ to a stream @t m a@ concurrently; the input stream

399−-- is evaluated asynchronously in an independent thread yielding elements to a

400−-- buffer and the transformation function runs in another thread consuming the

401−-- input from the buffer. '|$' is just like regular function application

402−-- operator '$' except that it is concurrent.

403−--

404−-- If you read the signature as @(t m a -> t m b) -> (t m a -> t m b)@ you can

405−-- look at it as a transformation that converts a transform function to a

406−-- buffered concurrent transform function.

232+-- | Right fold to a streaming monad.

407233--

408−-- The following code prints a value every second even though each stage adds a

409−-- 1 second delay.

234+-- > foldrS S.cons S.nil === id

410235--

236+-- 'foldrS' can be used to perform stateless stream to stream transformations

237+-- like map and filter in general. It can be coupled with a scan to perform

238+-- stateful transformations. However, note that the custom map and filter

239+-- routines can be much more efficient than this due to better stream fusion.

411240--

412−-- @

413−-- drain $

414−-- S.mapM (\\x -> threadDelay 1000000 >> print x)

415−-- |$ S.repeatM (threadDelay 1000000 >> return 1)

416−-- @

241+-- >>> S.toList $ S.foldrS S.cons S.nil $ S.fromList [1..5]

242+-- > [1,2,3,4,5]

417243--

418−-- /Concurrent/

244+-- Find if any element in the stream is 'True':

419245--

420−-- /Since: 0.3.0 ("Streamly")/

246+-- >>> S.toList $ S.foldrS (\x xs -> if odd x then return True else xs) (return False) $ (S.fromList (2:4:5:undefined) :: SerialT IO Int)

247+-- > [True]

421248--

422−-- @since 0.8.0

423−{-# INLINE (|$) #-}

424−(|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> (t m a -> t m b)

425−-- (|$) f = f . Async.mkAsync

426−(|$) f = f . D.mkParallel

427−

428−-- | Same as '|$'.

249+-- Map (+2) on odd elements and filter out the even elements:

429250--

430−-- /Internal/

251+-- >>> S.toList $ S.foldrS (\x xs -> if odd x then (x + 2) `S.cons` xs else xs) S.nil $ (S.fromList [1..5] :: SerialT IO Int)

252+-- > [3,5,7]

431253--

432−{-# INLINE applyAsync #-}

433−applyAsync :: (IsStream t, MonadAsync m)

434− => (t m a -> t m b) -> (t m a -> t m b)

435−applyAsync = (|$)

436−

437−-- | Parallel reverse function application operator for streams; just like the

438−-- regular reverse function application operator '&' except that it is

439−-- concurrent.

254+-- 'foldrM' can also be represented in terms of 'foldrS', however, the former

255+-- is much more efficient:

440256--

441−-- @

442−-- drain $

443−-- S.repeatM (threadDelay 1000000 >> return 1)

444−-- |& S.mapM (\\x -> threadDelay 1000000 >> print x)

445−-- @

257+-- > foldrM f z s = runIdentityT $ foldrS (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s

446258--

447−-- /Concurrent/

259+-- /Internal/

260+{-# INLINE foldrS #-}

261+foldrS :: IsStream t => (a -> t m b -> t m b) -> t m b -> t m a -> t m b

262+foldrS = K.foldrS

263+

264+-- | Right fold to a transformer monad. This is the most general right fold

265+-- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'

266+-- implementation can be more efficient:

448267--

449−-- /Since: 0.3.0 ("Streamly")/

268+-- > foldrS = foldrT

269+-- > foldrM f z s = runIdentityT $ foldrT (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s

450270--

451−-- @since 0.8.0

452−{-# INLINE (|&) #-}

453−(|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b

454−x |& f = f |$ x

455−

456−------------------------------------------------------------------------------

457−-- General Transformation

458−------------------------------------------------------------------------------

459−

460−-- | Use a 'Pipe' to transform a stream.

271+-- 'foldrT' can be used to translate streamly streams to other transformer

272+-- monads e.g. to a different streaming type.

461273--

462274-- /Internal/

463−--

464−{-# INLINE transform #-}

465−transform :: (IsStream t, Monad m) => Pipe m a b -> t m a -> t m b

466−transform pipe xs = fromStreamD $ D.transform pipe (toStreamD xs)

275+{-# INLINE foldrT #-}

276+foldrT :: (IsStream t, Monad m, Monad (s m), MonadTrans s)

277+ => (a -> s m b -> s m b) -> s m b -> t m a -> s m b

278+foldrT f z s = S.foldrT f z (toStreamS s)

467279

468280------------------------------------------------------------------------------

469−-- Transformation by Folding (Scans)

281+-- Transformation by Mapping

470282------------------------------------------------------------------------------

471283

472−-- XXX It may be useful to have a version of scan where we can keep the

473−-- accumulator independent of the value emitted. So that we do not necessarily

474−-- have to keep a value in the accumulator which we are not using. We can pass

475−-- an extraction function that will take the accumulator and the current value

476−-- of the element and emit the next value in the stream. That will also make it

477−-- possible to modify the accumulator after using it. In fact, the step function

478−-- can return new accumulator and the value to be emitted. The signature would

479−-- be more like mapAccumL. Or we can change the signature of scanx to

480−-- accommodate this.

481−--

482−-- | Strict left scan with an extraction function. Like 'scanl'', but applies a

483−-- user supplied extraction function (the third argument) at each step. This is

484−-- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for

485−-- extraction.

486−--

487−-- /Since 0.2.0/

488−--

489−-- /Since: 0.7.0 (Monad m constraint)/

490−{-# DEPRECATED scanx "Please use scanl followed by map instead." #-}

491−{-# INLINE scanx #-}

492−scanx :: (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

493−scanx = P.scanlx'

494−

495−-- XXX this needs to be concurrent

496−-- XXX because of the use of D.cons for appending, scanlM' has quadratic

497−-- complexity when iterated over a stream. We should use StreamK style scanlM'

498−-- for linear performance on iteration.

284+-- |

285+-- @

286+-- mapM f = sequence . map f

287+-- @

499288--

500−-- | Like 'scanl'' but with a monadic step function and a monadic seed.

289+-- Apply a monadic function to each element of the stream and replace it with

290+-- the output of the resulting action.

501291--

502−-- /Since: 0.4.0/

292+-- @

293+-- > drain $ S.mapM putStr $ S.fromList ["a", "b", "c"]

294+-- abc

503295--

504−-- /Since: 0.8.0 (signature change)/

505−{-# INLINE scanlM' #-}

506−scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

507−scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m

508−

509−-- | @scanlMAfter' accumulate initial done stream@ is like 'scanlM'' except

510−-- that it provides an additional @done@ function to be applied on the

511−-- accumulator when the stream stops. The result of @done@ is also emitted in

512−-- the stream.

296+-- drain $ S.replicateM 10 (return 1)

297+-- & (serially . S.mapM (\\x -> threadDelay 1000000 >> print x))

513298--

514−-- This function can be used to allocate a resource in the beginning of the

515−-- scan and release it when the stream ends or to flush the internal state of

516−-- the scan at the end.

299+-- drain $ S.replicateM 10 (return 1)

300+-- & (asyncly . S.mapM (\\x -> threadDelay 1000000 >> print x))

301+-- @

517302--

518−-- /Internal/

303+-- /Concurrent (do not use with 'parallely' on infinite streams)/

519304--

520−{-# INLINE scanlMAfter' #-}

521−scanlMAfter' :: (IsStream t, Monad m)

522− => (b -> a -> m b) -> m b -> (b -> m b) -> t m a -> t m b

523−scanlMAfter' step initial done stream =

524− fromStreamD $ D.scanlMAfter' step initial done $ toStreamD stream

305+-- @since 0.1.0

306+{-# INLINE_EARLY mapM #-}

307+mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b

308+mapM = K.mapM

525309

526−-- XXX because of the use of D.cons for appending, scanl' has quadratic

527−-- complexity when iterated over a stream. We should use StreamK style scanlM'

528−-- for linear performance on iteration.

529−

530−-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,

531−-- however it adds an extra element.

532−--

533−-- @

534−-- > S.toList $ S.scanl' (+) 0 $ fromList [1,2,3,4]

535−-- [0,1,3,6,10]

536−-- @

537−--

538−-- @

539−-- > S.toList $ S.scanl' (flip (:)) [] $ S.fromList [1,2,3,4]

540−-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]

541−-- @

542−--

543−-- The output of 'scanl'' is the initial value of the accumulator followed by

544−-- all the intermediate steps and the final result of 'foldl''.

545−--

546−-- By streaming the accumulated state after each fold step, we can share the

547−-- state across multiple stages of stream composition. Each stage can modify or

548−-- extend the state, do some processing with it and emit it for the next stage,

549−-- thus modularizing the stream processing. This can be useful in

550−-- stateful or event-driven programming.

551−--

552−-- Consider the following monolithic example, computing the sum and the product

553−-- of the elements in a stream in one go using a @foldl'@:

554−--

555−-- @

556−-- > S.foldl' (\\(s, p) x -> (s + x, p * x)) (0,1) $ S.fromList \[1,2,3,4]

557−-- (10,24)

558−-- @

559−--

560−-- Using @scanl'@ we can make it modular by computing the sum in the first

561−-- stage and passing it down to the next stage for computing the product:

562−--

563−-- @

564−-- > S.foldl' (\\(_, p) (s, x) -> (s, p * x)) (0,1)

565−-- $ S.scanl' (\\(s, _) x -> (s + x, x)) (0,1)

566−-- $ S.fromList \[1,2,3,4]

567−-- (10,24)

568−-- @

569−--

570−-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF. To avoid building

571−-- lazy expressions inside the accumulator, it is recommended that a strict

572−-- data structure is used for accumulator.

573−--

574−-- See also: 'usingStateT'

575−--

576−-- @since 0.2.0

577−{-# INLINE scanl' #-}

578−scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

579−scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m

580−

581−-- | Like 'scanl'' but does not stream the initial value of the accumulator.

582−--

583−-- > postscanl' f z xs = S.drop 1 $ S.scanl' f z xs

584−--

585−-- @since 0.7.0

586−{-# INLINE postscanl' #-}

587−postscanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

588−postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m

589−

590−-- XXX this needs to be concurrent

591−-- | Like 'postscanl'' but with a monadic step function and a monadic seed.

592−--

593−-- /Since: 0.7.0/

594−--

595−-- /Since: 0.8.0 (signature change)/

596−{-# INLINE postscanlM' #-}

597−postscanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

598−postscanlM' step z m = fromStreamD $ D.postscanlM' step z $ toStreamD m

599−

600−-- XXX prescanl does not sound very useful, enable only if there is a

601−-- compelling use case.

602−--

603−-- | Like scanl' but does not stream the final value of the accumulator.

604−--

605−-- /Internal/

606−{-# INLINE prescanl' #-}

607−prescanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

608−prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m

609−

610−-- XXX this needs to be concurrent

611−-- | Like prescanl' but with a monadic step function and a monadic seed.

612−--

613−-- /Internal/

614−{-# INLINE prescanlM' #-}

615−prescanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

616−prescanlM' step z m = fromStreamD $ D.prescanlM' step z $ toStreamD m

617−

618−-- XXX this needs to be concurrent

619−-- | Like 'scanl1'' but with a monadic step function.

620−--

621−-- @since 0.6.0

622−{-# INLINE scanl1M' #-}

623−scanl1M' :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a

624−scanl1M' step m = fromStreamD $ D.scanl1M' step $ toStreamD m

625−

626−-- | Like 'scanl'' but for a non-empty stream. The first element of the stream

627−-- is used as the initial value of the accumulator. Does nothing if the stream

628−-- is empty.

629−--

630−-- @

631−-- > S.toList $ S.scanl1 (+) $ fromList [1,2,3,4]

632−-- [1,3,6,10]

633−-- @

634−--

635−-- @since 0.6.0

636−{-# INLINE scanl1' #-}

637−scanl1' :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a

638−scanl1' step m = fromStreamD $ D.scanl1' step $ toStreamD m

639−

640−------------------------------------------------------------------------------

641−-- Scanning with a Fold

642−------------------------------------------------------------------------------

643−

644−-- | Scan a stream using the given monadic fold.

645−--

646−-- @since 0.7.0

647−{-# INLINE scan #-}

648−scan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b

649−scan = P.scanOnce

650−

651−-- | Postscan a stream using the given monadic fold.

652−--

653−-- @since 0.7.0

654−{-# INLINE postscan #-}

655−postscan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b

656−postscan = P.postscanOnce

657−

658−------------------------------------------------------------------------------

659−-- Stateful Transformations

660−------------------------------------------------------------------------------

661−

662−-- XXX this is not a one-to-one map so calling it map may not be right.

663−-- We can perhaps call it zipWithTail or rollWith.

664−--

665−-- | Apply a function on every two successive elements of a stream. If the

666−-- stream consists of a single element the output is an empty stream.

667−--

668−-- This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.

669−--

670−-- /Internal/

671−--

672−{-# INLINE rollingMap #-}

673−rollingMap :: (IsStream t, Monad m) => (a -> a -> b) -> t m a -> t m b

674−rollingMap f m = fromStreamD $ D.rollingMap f $ toStreamD m

675−

676−-- | Like 'rollingMap' but with an effectful map function.

677−--

678−-- /Internal/

679−--

680−{-# INLINE rollingMapM #-}

681−rollingMapM :: (IsStream t, Monad m) => (a -> a -> m b) -> t m a -> t m b

682−rollingMapM f m = fromStreamD $ D.rollingMapM f $ toStreamD m

683−

684−------------------------------------------------------------------------------

685−-- Transformation by Filtering

686−------------------------------------------------------------------------------

687−

688−-- | Include only those elements that pass a predicate.

689−--

690−-- @since 0.1.0

691−{-# INLINE filter #-}

692−#if __GLASGOW_HASKELL__ != 802

693−-- GHC 8.2.2 crashes with this code, when used with "stack"

694−filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

695−filter p m = fromStreamS $ S.filter p $ toStreamS m

696−#else

697−filter :: IsStream t => (a -> Bool) -> t m a -> t m a

698−filter = K.filter

699−#endif

700−

701−-- | Same as 'filter' but with a monadic predicate.

702−--

703−-- @since 0.4.0

704−{-# INLINE filterM #-}

705−filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

706−filterM p m = fromStreamD $ D.filterM p $ toStreamD m

707−

708−-- | Drop repeated elements that are adjacent to each other.

709−--

710−-- @since 0.6.0

711−{-# INLINE uniq #-}

712−uniq :: (Eq a, IsStream t, Monad m) => t m a -> t m a

713−uniq = fromStreamD . D.uniq . toStreamD

714−

715−-- | Take first 'n' elements from the stream and discard the rest.

716−--

717−-- @since 0.1.0

718−{-# INLINE take #-}

719−take :: (IsStream t, Monad m) => Int -> t m a -> t m a

720−take n m = fromStreamS $ S.take n $ toStreamS

721− (maxYields (Just (fromIntegral n)) m)

722−

723−-- | End the stream as soon as the predicate fails on an element.

724−--

725−-- @since 0.1.0

726−{-# INLINE takeWhile #-}

727−takeWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

728−takeWhile p m = fromStreamS $ S.takeWhile p $ toStreamS m

729−

730−-- | Same as 'takeWhile' but with a monadic predicate.

731−--

732−-- @since 0.4.0

733−{-# INLINE takeWhileM #-}

734−takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

735−takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m

736−

737−-- | @takeByTime duration@ yields stream elements upto specified time

738−-- @duration@. The duration starts when the stream is evaluated for the first

739−-- time, before the first element is yielded. The time duration is checked

740−-- before generating each element, if the duration has expired the stream

741−-- stops.

742−--

743−-- The total time taken in executing the stream is guaranteed to be /at least/

744−-- @duration@, however, because the duration is checked before generating an

745−-- element, the upper bound is indeterminate and depends on the time taken in

746−-- generating and processing the last element.

747−--

748−-- No element is yielded if the duration is zero. At least one element is

749−-- yielded if the duration is non-zero.

750−--

751−-- /Internal/

752−--

753−{-# INLINE takeByTime #-}

754−takeByTime ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a

755−takeByTime d = fromStreamD . D.takeByTime d . toStreamD

756−

757−-- | Discard first 'n' elements from the stream and take the rest.

758−--

759−-- @since 0.1.0

760−{-# INLINE drop #-}

761−drop :: (IsStream t, Monad m) => Int -> t m a -> t m a

762−drop n m = fromStreamS $ S.drop n $ toStreamS m

763−

764−-- | Drop elements in the stream as long as the predicate succeeds and then

765−-- take the rest of the stream.

766−--

767−-- @since 0.1.0

768−{-# INLINE dropWhile #-}

769−dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

770−dropWhile p m = fromStreamS $ S.dropWhile p $ toStreamS m

771−

772−-- | Same as 'dropWhile' but with a monadic predicate.

773−--

774−-- @since 0.4.0

775−{-# INLINE dropWhileM #-}

776−dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

777−dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m

778−

779−-- | @dropByTime duration@ drops stream elements until specified @duration@ has

780−-- passed. The duration begins when the stream is evaluated for the first

781−-- time. The time duration is checked /after/ generating a stream element, the

782−-- element is yielded if the duration has expired otherwise it is dropped.

783−--

784−-- The time elapsed before starting to generate the first element is /at most/

785−-- @duration@, however, because the duration expiry is checked after the

786−-- element is generated, the lower bound is indeterminate and depends on the

787−-- time taken in generating an element.

788−--

789−-- All elements are yielded if the duration is zero.

790−--

791−-- /Internal/

792−--

793−{-# INLINE dropByTime #-}

794−dropByTime ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a

795−dropByTime d = fromStreamD . D.dropByTime d . toStreamD

796−

797−-- | Drop prefix from the input stream if present.

798−--

799−-- Space: @O(1)@

800−--

801−-- /Unimplemented/ - Help wanted.

802−{-# INLINE dropPrefix #-}

803−dropPrefix ::

804− -- (Eq a, IsStream t, Monad m) =>

805− t m a -> t m a -> t m a

806−dropPrefix = error "Not implemented yet!"

807−

808−-- | Drop all matching infix from the input stream if present. Infix stream

809−-- may be consumed multiple times.

810−--

811−-- Space: @O(n)@ where n is the length of the infix.

812−--

813−-- /Unimplemented/ - Help wanted.

814−{-# INLINE dropInfix #-}

815−dropInfix ::

816− -- (Eq a, IsStream t, Monad m) =>

817− t m a -> t m a -> t m a

818−dropInfix = error "Not implemented yet!"

819−

820−-- | Drop suffix from the input stream if present. Suffix stream may be

821−-- consumed multiple times.

822−--

823−-- Space: @O(n)@ where n is the length of the suffix.

824−--

825−-- /Unimplemented/ - Help wanted.

826−{-# INLINE dropSuffix #-}

827−dropSuffix ::

828− -- (Eq a, IsStream t, Monad m) =>

829− t m a -> t m a -> t m a

830−dropSuffix = error "Not implemented yet!"

831−

832−------------------------------------------------------------------------------

833−-- Transformation by Mapping

834−------------------------------------------------------------------------------

835−

836−-- |

837−-- @

838−-- mapM f = sequence . map f

839−-- @

840−--

841−-- Apply a monadic function to each element of the stream and replace it with

842−-- the output of the resulting action.

843−--

844−-- @

845−-- > drain $ S.mapM putStr $ S.fromList ["a", "b", "c"]

846−-- abc

847−--

848−-- drain $ S.replicateM 10 (return 1)

849−-- & (serially . S.mapM (\\x -> threadDelay 1000000 >> print x))

850−--

851−-- drain $ S.replicateM 10 (return 1)

852−-- & (asyncly . S.mapM (\\x -> threadDelay 1000000 >> print x))

853−-- @

854−--

855−-- /Concurrent (do not use with 'parallely' on infinite streams)/

856−--

857−-- @since 0.1.0

858−{-# INLINE_EARLY mapM #-}

859−mapM :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m b

860−mapM = K.mapM

861−

862−{-# RULES "mapM serial" mapM = mapMSerial #-}

863−{-# INLINE mapMSerial #-}

864−mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b

865−mapMSerial = Serial.mapM

866−

867−-- |

868−-- @

869−-- sequence = mapM id

870−-- @

871−--

872−-- Replace the elements of a stream of monadic actions with the outputs of

873−-- those actions.

874−--

875−-- @

876−-- > drain $ S.sequence $ S.fromList [putStr "a", putStr "b", putStrLn "c"]

877−-- abc

878−--

879−-- drain $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)

880−-- & (serially . S.sequence)

881−--

882−-- drain $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)

883−-- & (asyncly . S.sequence)

884−-- @

885−--

886−-- /Concurrent (do not use with 'parallely' on infinite streams)/

887−--

888−-- @since 0.1.0

889−{-# INLINE sequence #-}

890−sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a

891−sequence m = fromStreamS $ S.sequence (toStreamS m)

892−

893−-- $smapM_Notes

894−--

895−-- The stateful step function can be simplified to @(s -> a -> m b)@ to provide

896−-- a read-only environment. However, that would just be 'mapM'.

897−--

898−-- The initial action could be @m (s, Maybe b)@, and we can also add a final

899−-- action @s -> m (Maybe b)@. This can be used to get pre/post scan like

900−-- functionality and also to flush the state in the end like scanlMAfter'.

901−-- We can also use it along with a fusible version of bracket to get

902−-- scanlMAfter' like functionality. See issue #677.

903−--

904−-- This can be further generalized to a type similar to Fold/Parser, giving it

905−-- filtering and parsing capability as well (this is in fact equivalent to

906−-- parseMany):

907−--

908−-- smapM :: (s -> a -> m (Step s b)) -> m s -> t m a -> t m b

909−--

910−

911−-- | A stateful 'mapM', equivalent to a left scan, more like mapAccumL.

912−-- Hopefully, this is a better alternative to @scan@. Separation of state from

913−-- the output makes it easier to think in terms of a shared state, and also

914−-- makes it easier to keep the state fully strict and the output lazy.

915−--

916−-- See also: 'scanlM''

917−--

918−-- /Internal/

919−--

920−{-# INLINE smapM #-}

921−smapM :: (IsStream t, Monad m) =>

922− (s -> a -> m (s, b))

923− -> m s

924− -> t m a

925− -> t m b

926−smapM step initial stream =

927− -- XXX implement this directly instead of using scanlM'

928− -- Once we have postscanlM' with monadic initial we can use this code

929− -- let r = postscanlM'

930− -- (\(s, _) a -> step s a)

931− -- (fmap (,undefined) initial)

932− -- stream

933− let r = postscanlM'

934− (\(s, _) a -> step s a)

935− (fmap (,undefined) initial)

936− stream

937− in Serial.map snd r

938−

939−------------------------------------------------------------------------------

940−-- Maybe Streams

941−------------------------------------------------------------------------------

942−

943−-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'

944−-- elements, and return a stream of values extracted from 'Just'.

945−--

946−-- Equivalent to:

947−--

948−-- @

949−-- mapMaybe f = S.map 'fromJust' . S.filter 'isJust' . S.map f

950−-- @

951−--

952−-- @since 0.3.0

953−{-# INLINE mapMaybe #-}

954−mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b

955−mapMaybe f m = fromStreamS $ S.mapMaybe f $ toStreamS m

956−

957−-- | Like 'mapMaybe' but maps a monadic function.

958−--

959−-- Equivalent to:

960−--

961−-- @

962−-- mapMaybeM f = S.map 'fromJust' . S.filter 'isJust' . S.mapM f

963−-- @

964−--

965−-- /Concurrent (do not use with 'parallely' on infinite streams)/

966−--

967−-- @since 0.3.0

968−{-# INLINE_EARLY mapMaybeM #-}

969−mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))

970− => (a -> m (Maybe b)) -> t m a -> t m b

971−mapMaybeM f = fmap fromJust . filter isJust . K.mapM f

972−

973−{-# RULES "mapMaybeM serial" mapMaybeM = mapMaybeMSerial #-}

974−{-# INLINE mapMaybeMSerial #-}

975−mapMaybeMSerial :: Monad m => (a -> m (Maybe b)) -> SerialT m a -> SerialT m b

976−mapMaybeMSerial f m = fromStreamD $ D.mapMaybeM f $ toStreamD m

977−

978−-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.

979−--

980−-- /Internal/

981−--

982−catMaybes :: (IsStream t, Monad m, Functor (t m)) => t m (Maybe a) -> t m a

983−catMaybes = fmap fromJust . filter isJust

984−

985−------------------------------------------------------------------------------

986−-- Transformation by Reordering

987−------------------------------------------------------------------------------

988−

989−-- XXX Use a compact region list to temporarily store the list, in both reverse

990−-- as well as in reverse'.

991−--

992−-- /Note:/ 'reverse'' is much faster than this, use that when performance

993−-- matters.

994−--

995−-- > reverse = S.foldlT (flip S.cons) S.nil

996−--

997−-- | Returns the elements of the stream in reverse order. The stream must be

998−-- finite. Note that this necessarily buffers the entire stream in memory.

999−--

1000−-- /Since 0.7.0 (Monad m constraint)/

1001−--

1002−-- /Since: 0.1.1/

1003−{-# INLINE reverse #-}

1004−reverse :: (IsStream t, Monad m) => t m a -> t m a

1005−reverse s = fromStreamS $ S.reverse $ toStreamS s

1006−

1007−-- | Like 'reverse' but several times faster, requires a 'Storable' instance.

1008−--

1009−-- /Internal/

1010−{-# INLINE reverse' #-}

1011−reverse' :: (IsStream t, MonadIO m, Storable a) => t m a -> t m a

1012−reverse' s = fromStreamD $ D.reverse' $ toStreamD s

1013−

1014−------------------------------------------------------------------------------

1015−-- Transformation by Inserting

1016−------------------------------------------------------------------------------

1017−

1018−-- intersperseM = intersperseBySpan 1

1019−

1020−-- | Insert an effect and its output before consuming an element of a stream

1021−-- except the first one.

1022−--

1023−-- @

1024−-- >>> S.toList $ S.trace putChar $ S.intersperseM (putChar '.' >> return ',') $ S.fromList "hello"

1025−-- > h.,e.,l.,l.,o"h,e,l,l,o"

1026−-- @

1027−--

1028−-- @since 0.5.0

1029−{-# INLINE intersperseM #-}

1030−intersperseM :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

1031−intersperseM m = fromStreamS . S.intersperseM m . toStreamS

1032−

1033−-- | Insert a side effect before consuming an element of a stream except the

1034−-- first one.

1035−--

1036−-- @

1037−-- >>> S.drain $ S.trace putChar $ S.intersperseM_ (putChar '.') $ S.fromList "hello"

1038−-- > h.e.l.l.o

1039−-- @

1040−--

1041−-- /Internal/

1042−{-# INLINE intersperseM_ #-}

1043−intersperseM_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

1044−intersperseM_ m = fromStreamD . D.intersperseM_ m . toStreamD

1045−

1046−-- | Insert a pure value between successive elements of a stream.

1047−--

1048−-- @

1049−-- > S.toList $ S.intersperse ',' $ S.fromList "hello"

1050−-- "h,e,l,l,o"

1051−-- @

1052−--

1053−-- @since 0.7.0

1054−{-# INLINE intersperse #-}

1055−intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a

1056−intersperse a = fromStreamS . S.intersperse a . toStreamS

1057−

1058−-- | Insert an effect and its output after consuming an element of a stream.

1059−--

1060−-- @

1061−-- >>> S.toList $ S.trace putChar $ S.intersperseSuffix (putChar '.' >> return ',') $ S.fromList "hello"

1062−-- > h.,e.,l.,l.,o.,"h,e,l,l,o,"

1063−-- @

1064−--

1065−-- /Internal/

1066−{-# INLINE intersperseSuffix #-}

1067−intersperseSuffix :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

1068−intersperseSuffix m = fromStreamD . D.intersperseSuffix m . toStreamD

1069−

1070−-- | Insert a side effect after consuming an element of a stream.

1071−--

1072−-- @

1073−-- > S.mapM_ putChar $ S.intersperseSuffix_ (threadDelay 1000000) $ S.fromList "hello"

1074−-- @

1075−--

1076−-- /Internal/

1077−--

1078−{-# INLINE intersperseSuffix_ #-}

1079−intersperseSuffix_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

1080−intersperseSuffix_ m = fromStreamD . D.intersperseSuffix_ m . toStreamD

1081−

1082−-- | Insert a side effect before consuming an element of a stream.

1083−--

1084−-- @

1085−-- >>> S.toList $ S.trace putChar $ S.interspersePrefix_ (putChar '.' >> return ',') $ S.fromList "hello"

1086−-- > .h.e.l.l.o"hello"

1087−-- @

1088−--

1089−-- See also: 'trace_'

1090−--

1091−-- /Concurrent/

1092−--

1093−-- /Internal/

1094−--

1095−{-# INLINE interspersePrefix_ #-}

1096−interspersePrefix_ :: (IsStream t, MonadAsync m) => m b -> t m a -> t m a

1097−interspersePrefix_ m = mapM (\x -> void m >> return x)

1098−

1099−-- Note: delay must be serial.

1100−--

1101−-- | Introduce a delay of specified seconds before consuming an element of the

1102−-- stream except the first one.

1103−--

1104−-- @

1105−-- >>> S.mapM_ print $ S.timestamped $ S.delay 1 $ S.enumerateFromTo 1 3

1106−-- > (AbsTime (TimeSpec {sec = 2502706, nsec = 751137000}),1)

1107−-- > (AbsTime (TimeSpec {sec = 2502707, nsec = 743535000}),2)

1108−-- > (AbsTime (TimeSpec {sec = 2502708, nsec = 749758000}),3)

1109−-- @

1110−--

1111−-- /Internal/

1112−--

1113−{-# INLINE delay #-}

1114−delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

1115−delay n = intersperseM_ $ liftIO $ threadDelay $ round $ n * 1000000

1116−

1117−-- Note: delay must be serial.

1118−--

1119−-- | Introduce a delay of specified seconds after consuming an element of a

1120−-- stream.

1121−--

1122−-- @

1123−-- >>> S.mapM_ print $ S.timestamped $ S.delayPost 1 $ S.enumerateFromTo 1 3

1124−-- > (AbsTime (TimeSpec {sec = 2502826, nsec = 119030000}),1)

1125−-- > (AbsTime (TimeSpec {sec = 2502827, nsec = 111393000}),2)

1126−-- > (AbsTime (TimeSpec {sec = 2502828, nsec = 112221000}),3)

1127−-- @

1128−--

1129−-- /Internal/

1130−--

1131−{-# INLINE delayPost #-}

1132−delayPost :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

1133−delayPost n = intersperseSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000

1134−

1135−-- Note: delay must be serial, that's why 'trace_' is used.

1136−--

1137−-- | Introduce a delay of specified seconds before consuming an element of a

1138−-- stream.

1139−--

1140−-- @

1141−-- >>> S.mapM_ print $ S.timestamped $ S.delayPre 1 $ S.enumerateFromTo 1 3

1142−-- > (AbsTime (TimeSpec {sec = 2502207, nsec = 533177000}),1)

1143−-- > (AbsTime (TimeSpec {sec = 2502208, nsec = 530859000}),2)

1144−-- > (AbsTime (TimeSpec {sec = 2502209, nsec = 531619000}),3)

1145−-- @

1146−--

1147−-- /Internal/

1148−--

1149−{-# INLINE delayPre #-}

1150−delayPre :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

1151−delayPre n = trace_ $ liftIO $ threadDelay $ round $ n * 1000000

1152−

1153−-- | Like 'intersperseSuffix' but intersperses an effectful action into the

1154−-- input stream after every @n@ elements and after the last element.

1155−--

1156−-- @

1157−-- > S.toList $ S.intersperseSuffixBySpan 2 (return ',') $ S.fromList "hello"

1158−-- "he,ll,o,"

1159−-- @

1160−--

1161−-- /Internal/

1162−--

1163−{-# INLINE intersperseSuffixBySpan #-}

1164−intersperseSuffixBySpan :: (IsStream t, MonadAsync m)

1165− => Int -> m a -> t m a -> t m a

1166−intersperseSuffixBySpan n eff =

1167− fromStreamD . D.intersperseSuffixBySpan n eff . toStreamD

1168−

1169−{-

1170−-- | Intersperse a monadic action into the input stream after every @n@

1171−-- elements.

1172−--

1173−-- @

1174−-- > S.toList $ S.intersperseBySpan 2 (return ',') $ S.fromList "hello"

1175−-- "he,ll,o"

1176−-- @

1177−--

1178−-- @since 0.7.0

1179−{-# INLINE intersperseBySpan #-}

1180−intersperseBySpan :: IsStream t => Int -> m a -> t m a -> t m a

1181−intersperseBySpan _n _f _xs = undefined

1182−-}

1183−

1184−-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in

1185−-- @stream@ that is less than @elem@ when compared using @cmp@.

1186−--

1187−-- @

1188−-- insertBy cmp x = 'mergeBy' cmp ('yield' x)

1189−-- @

1190−--

1191−-- @

1192−-- > S.toList $ S.insertBy compare 2 $ S.fromList [1,3,5]

1193−-- [1,2,3,5]

1194−-- @

1195−--

1196−-- @since 0.6.0

1197−{-# INLINE insertBy #-}

1198−insertBy ::

1199− (IsStream t, Monad m) => (a -> a -> Ordering) -> a -> t m a -> t m a

1200−insertBy cmp x m = fromStreamS $ S.insertBy cmp x (toStreamS m)

1201−

1202−------------------------------------------------------------------------------

1203−-- Deleting

1204−------------------------------------------------------------------------------

1205−

1206−-- | Deletes the first occurrence of the element in the stream that satisfies

1207−-- the given equality predicate.

1208−--

1209−-- @

1210−-- > S.toList $ S.deleteBy (==) 3 $ S.fromList [1,3,3,5]

1211−-- [1,3,5]

1212−-- @

1213−--

1214−-- @since 0.6.0

1215−{-# INLINE deleteBy #-}

1216−deleteBy :: (IsStream t, Monad m) => (a -> a -> Bool) -> a -> t m a -> t m a

1217−deleteBy cmp x m = fromStreamS $ S.deleteBy cmp x (toStreamS m)

1218−

1219−------------------------------------------------------------------------------

1220−-- Zipping

1221−------------------------------------------------------------------------------

1222−

1223−-- |

1224−-- > indexed = S.postscanl' (\(i, _) x -> (i + 1, x)) (-1,undefined)

1225−-- > indexed = S.zipWith (,) (S.enumerateFrom 0)

1226−--

1227−-- Pair each element in a stream with its index, starting from index 0.

1228−--

1229−-- @

1230−-- > S.toList $ S.indexed $ S.fromList "hello"

1231−-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]

1232−-- @

1233−--

1234−-- @since 0.6.0

1235−{-# INLINE indexed #-}

1236−indexed :: (IsStream t, Monad m) => t m a -> t m (Int, a)

1237−indexed = fromStreamD . D.indexed . toStreamD

1238−

1239−-- |

1240−-- > indexedR n = S.postscanl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)

1241−-- > indexedR n = S.zipWith (,) (S.enumerateFromThen n (n - 1))

1242−--

1243−-- Pair each element in a stream with its index, starting from the

1244−-- given index @n@ and counting down.

1245−--

1246−-- @

1247−-- > S.toList $ S.indexedR 10 $ S.fromList "hello"

1248−-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]

1249−-- @

1250−--

1251−-- @since 0.6.0

1252−{-# INLINE indexedR #-}

1253−indexedR :: (IsStream t, Monad m) => Int -> t m a -> t m (Int, a)

1254−indexedR n = fromStreamD . D.indexedR n . toStreamD

1255−

1256−------------------------------------------------------------------------------

1257−-- Merge

1258−------------------------------------------------------------------------------

1259−

1260−-- | Merge two streams using a comparison function. The head elements of both

1261−-- the streams are compared and the smaller of the two elements is emitted, if

1262−-- both elements are equal then the element from the first stream is used

1263−-- first.

1264−--

1265−-- If the streams are sorted in ascending order, the resulting stream would

1266−-- also remain sorted in ascending order.

1267−--

1268−-- @

1269−-- > S.toList $ S.mergeBy compare (S.fromList [1,3,5]) (S.fromList [2,4,6,8])

1270−-- [1,2,3,4,5,6,8]

1271−-- @

1272−--

1273−-- @since 0.6.0

1274−{-# INLINABLE mergeBy #-}

1275−mergeBy ::

1276− (IsStream t, Monad m) => (a -> a -> Ordering) -> t m a -> t m a -> t m a

1277−mergeBy f m1 m2 = fromStreamS $ S.mergeBy f (toStreamS m1) (toStreamS m2)

1278−

1279−-- | Like 'mergeBy' but with a monadic comparison function.

1280−--

1281−-- Merge two streams randomly:

1282−--

1283−-- @

1284−-- > randomly _ _ = randomIO >>= \x -> return $ if x then LT else GT

1285−-- > S.toList $ S.mergeByM randomly (S.fromList [1,1,1,1]) (S.fromList [2,2,2,2])

1286−-- [2,1,2,2,2,1,1,1]

1287−-- @

1288−--

1289−-- Merge two streams in a proportion of 2:1:

1290−--

1291−-- @

1292−-- proportionately m n = do

1293−-- ref <- newIORef $ cycle $ concat [replicate m LT, replicate n GT]

1294−-- return $ \\_ _ -> do

1295−-- r <- readIORef ref

1296−-- writeIORef ref $ tail r

1297−-- return $ head r

1298−--

1299−-- main = do

1300−-- f <- proportionately 2 1

1301−-- xs <- S.toList $ S.mergeByM f (S.fromList [1,1,1,1,1,1]) (S.fromList [2,2,2])

1302−-- print xs

1303−-- @

1304−-- @

1305−-- [1,1,2,1,1,2,1,1,2]

1306−-- @

1307−--

1308−-- @since 0.6.0

1309−{-# INLINABLE mergeByM #-}

1310−mergeByM

1311− :: (IsStream t, Monad m)

1312− => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

1313−mergeByM f m1 m2 = fromStreamS $ S.mergeByM f (toStreamS m1) (toStreamS m2)

1314−

1315−{-

1316−-- | Like 'mergeByM' but stops merging as soon as any of the two streams stops.

1317−{-# INLINABLE mergeEndByAny #-}

1318−mergeEndByAny

1319− :: (IsStream t, Monad m)

1320− => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

1321−mergeEndByAny f m1 m2 = fromStreamD $

1322− D.mergeEndByAny f (toStreamD m1) (toStreamD m2)

1323−

1324−-- Like 'mergeByM' but stops merging as soon as the first stream stops.

1325−{-# INLINABLE mergeEndByFirst #-}

1326−mergeEndByFirst

1327− :: (IsStream t, Monad m)

1328− => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

1329−mergeEndByFirst f m1 m2 = fromStreamS $

1330− D.mergeEndByFirst f (toStreamD m1) (toStreamD m2)

1331−-}

1332−

1333−-- Holding this back for now, we may want to use the name "merge" differently

1334−{-

1335−-- | Same as @'mergeBy' 'compare'@.

1336−--

1337−-- @

1338−-- > S.toList $ S.merge (S.fromList [1,3,5]) (S.fromList [2,4,6,8])

1339−-- [1,2,3,4,5,6,8]

1340−-- @

1341−--

1342−-- @since 0.6.0

1343−{-# INLINABLE merge #-}

1344−merge ::

1345− (IsStream t, Monad m, Ord a) => t m a -> t m a -> t m a

1346−merge = mergeBy compare

1347−-}

1348−

1349−-- | Like 'mergeBy' but merges concurrently (i.e. both the elements being

1350−-- merged are generated concurrently).

1351−--

1352−-- @since 0.6.0

1353−{-# INLINE mergeAsyncBy #-}

1354−mergeAsyncBy :: (IsStream t, MonadAsync m)

1355− => (a -> a -> Ordering) -> t m a -> t m a -> t m a

1356−mergeAsyncBy f = mergeAsyncByM (\a b -> return $ f a b)

1357−

1358−-- | Like 'mergeByM' but merges concurrently (i.e. both the elements being

1359−-- merged are generated concurrently).

1360−--

1361−-- @since 0.6.0

1362−{-# INLINE mergeAsyncByM #-}

1363−mergeAsyncByM :: (IsStream t, MonadAsync m)

1364− => (a -> a -> m Ordering) -> t m a -> t m a -> t m a

1365−mergeAsyncByM f m1 m2 = fromStreamD $

1366− D.mergeByM f (D.mkParallelD $ toStreamD m1) (D.mkParallelD $ toStreamD m2)

1367−

1368−------------------------------------------------------------------------------

1369−-- Flattening Lists

1370−------------------------------------------------------------------------------

1371−

1372−-- | @concatMapWith merge map stream@ is a two dimensional looping combinator.

1373−-- The first argument specifies a merge or concat function that is used to

1374−-- merge the streams generated by applying the second argument i.e. the @map@

1375−-- function to each element of the input stream. The concat function could be

1376−-- 'serial', 'parallel', 'async', 'ahead' or any other zip or merge function

1377−-- and the second argument could be any stream generation function using a

1378−-- seed.

1379−--

1380−-- /Compare 'foldMapWith'/

1381−--

1382−-- /Since: 0.7.0/

1383−--

1384−-- /Since: 0.8.0 (signature change)/

1385−{-# INLINE concatMapWith #-}

1386−concatMapWith

1387− :: IsStream t

1388− => (t m b -> t m b -> t m b)

1389− -> (a -> t m b)

1390− -> t m a

1391− -> t m b

1392−concatMapWith = K.concatMapBy

1393−

1394−-- | Like 'concatMapWith' but carries a state which can be used to share

1395−-- information across multiple steps of concat.

1396−--

1397−-- @

1398−-- concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial

1399−-- @

1400−--

1401−-- /Internal/

1402−--

1403−{-# INLINE concatSmapMWith #-}

1404−concatSmapMWith

1405− :: (IsStream t, Monad m)

1406− => (t m b -> t m b -> t m b)

1407− -> (s -> a -> m (s, t m b))

1408− -> m s

1409− -> t m a

1410− -> t m b

1411−concatSmapMWith combine f initial = concatMapWith combine id . smapM f initial

310+{-# RULES "mapM serial" mapM = mapMSerial #-}

311+{-# INLINE mapMSerial #-}

312+mapMSerial :: Monad m => (a -> m b) -> SerialT m a -> SerialT m b

313+mapMSerial = Serial.mapM

1412314

1413−-- | Map a stream producing function on each element of the stream and then

1414−-- flatten the results into a single stream.

1415−--

315+-- |

1416316-- @

1417−-- concatMap f = 'concat . map f'

1418−-- concatMap = 'concatMapWith' 'Serial.serial'

1419−-- concatMap f = 'concatMapM' (return . f)

1420−-- concatMap f = 'concatUnfold' (UF.lmap f UF.fromStream)

317+-- sequence = mapM id

1421318-- @

1422319--

1423−-- @since 0.6.0

1424−{-# INLINE concatMap #-}

1425−concatMap ::(IsStream t, Monad m) => (a -> t m b) -> t m a -> t m b

1426−concatMap f m = fromStreamD $ D.concatMap (toStreamD . f) (toStreamD m)

1427−

1428−-- | Flatten a stream of streams to a single stream.

320+-- Replace the elements of a stream of monadic actions with the outputs of

321+-- those actions.

1429322--

1430323-- @

1431−-- concat = concatMap id

1432−-- @

1433−--

1434−-- /Internal/

1435−{-# INLINE concat #-}

1436−concat :: (IsStream t, Monad m) => t m (t m a) -> t m a

1437−concat = concatMap id

1438−

1439−-- | Append the outputs of two streams, yielding all the elements from the

1440−-- first stream and then yielding all the elements from the second stream.

1441−--

1442−-- IMPORTANT NOTE: This could be 100x faster than @serial/<>@ for appending a

1443−-- few (say 100) streams because it can fuse via stream fusion. However, it

1444−-- does not scale for a large number of streams (say 1000s) and becomes

1445−-- qudartically slow. Therefore use this for custom appending of a few streams

1446−-- but use 'concatMap' or 'concatMapWith serial' for appending @n@ streams or

1447−-- infinite containers of streams.

1448−--

1449−-- /Internal/

1450−{-# INLINE append #-}

1451−append ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1452−append m1 m2 = fromStreamD $ D.append (toStreamD m1) (toStreamD m2)

1453−

1454−-- XXX Same as 'wSerial'. We should perhaps rename wSerial to interleave.

1455−-- XXX Document the interleaving behavior of side effects in all the

1456−-- interleaving combinators.

1457−-- XXX Write time-domain equivalents of these. In the time domain we can

1458−-- interleave two streams such that the value of second stream is always taken

1459−-- from its last value even if no new value is being yielded, like

1460−-- zipWithLatest. It would be something like interleaveWithLatest.

1461−--

1462−-- | Interleaves the outputs of two streams, yielding elements from each stream

1463−-- alternately, starting from the first stream. If any of the streams finishes

1464−-- early the other stream continues alone until it too finishes.

324+-- > drain $ S.sequence $ S.fromList [putStr "a", putStr "b", putStrLn "c"]

325+-- abc

1465326--

1466−-- >>> :set -XOverloadedStrings

1467−-- >>> interleave "ab" ",,,," :: SerialT Identity Char

1468−-- fromList "a,b,,,"

1469−-- >>> interleave "abcd" ",," :: SerialT Identity Char

1470−-- fromList "a,b,cd"

327+-- drain $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)

328+-- & (serially . S.sequence)

1471329--

1472−-- 'interleave' is dual to 'interleaveMin', it can be called @interleaveMax@.

330+-- drain $ S.replicateM 10 (return $ threadDelay 1000000 >> print 1)

331+-- & (asyncly . S.sequence)

332+-- @

1473333--

1474−-- Do not use at scale in concatMapWith.

334+-- /Concurrent (do not use with 'parallely' on infinite streams)/

1475335--

1476−-- /Internal/

1477−{-# INLINE interleave #-}

1478−interleave ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1479−interleave m1 m2 = fromStreamD $ D.interleave (toStreamD m1) (toStreamD m2)

336+-- @since 0.1.0

337+{-# INLINE sequence #-}

338+sequence :: (IsStream t, MonadAsync m) => t m (m a) -> t m a

339+sequence m = fromStreamS $ S.sequence (toStreamS m)

1480340

1481−-- | Interleaves the outputs of two streams, yielding elements from each stream

1482−-- alternately, starting from the first stream. As soon as the first stream

1483−-- finishes, the output stops, discarding the remaining part of the second

1484−-- stream. In this case, the last element in the resulting stream would be from

1485−-- the second stream. If the second stream finishes early then the first stream

1486−-- still continues to yield elements until it finishes.

1487−--

1488−-- >>> :set -XOverloadedStrings

1489−-- >>> interleaveSuffix "abc" ",,,," :: SerialT Identity Char

1490−-- fromList "a,b,c,"

1491−-- >>> interleaveSuffix "abc" "," :: SerialT Identity Char

1492−-- fromList "a,bc"

1493−--

1494−-- 'interleaveSuffix' is a dual of 'interleaveInfix'.

1495−--

1496−-- Do not use at scale in concatMapWith.

1497−--

1498−-- /Internal/

1499−{-# INLINE interleaveSuffix #-}

1500−interleaveSuffix ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1501−interleaveSuffix m1 m2 =

1502− fromStreamD $ D.interleaveSuffix (toStreamD m1) (toStreamD m2)

341+------------------------------------------------------------------------------

342+-- Mapping side effects

343+------------------------------------------------------------------------------

1503344

1504−-- | Interleaves the outputs of two streams, yielding elements from each stream

1505−-- alternately, starting from the first stream and ending at the first stream.

1506−-- If the second stream is longer than the first, elements from the second

1507−-- stream are infixed with elements from the first stream. If the first stream

1508−-- is longer then it continues yielding elements even after the second stream

1509−-- has finished.

1510−--

1511−-- >>> :set -XOverloadedStrings

1512−-- >>> interleaveInfix "abc" ",,,," :: SerialT Identity Char

1513−-- fromList "a,b,c"

1514−-- >>> interleaveInfix "abc" "," :: SerialT Identity Char

1515−-- fromList "a,bc"

1516−--

1517−-- 'interleaveInfix' is a dual of 'interleaveSuffix'.

1518−--

1519−-- Do not use at scale in concatMapWith.

1520−--

1521−-- /Internal/

1522−{-# INLINE interleaveInfix #-}

1523−interleaveInfix ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1524−interleaveInfix m1 m2 =

1525− fromStreamD $ D.interleaveInfix (toStreamD m1) (toStreamD m2)

1526−

1527−-- | Interleaves the outputs of two streams, yielding elements from each stream

1528−-- alternately, starting from the first stream. The output stops as soon as any

1529−-- of the two streams finishes, discarding the remaining part of the other

1530−-- stream. The last element of the resulting stream would be from the longer

1531−-- stream.

1532−--

1533−-- >>> :set -XOverloadedStrings

1534−-- >>> interleaveMin "ab" ",,,," :: SerialT Identity Char

1535−-- fromList "a,b,"

1536−-- >>> interleaveMin "abcd" ",," :: SerialT Identity Char

1537−-- fromList "a,b,c"

1538−--

1539−-- 'interleaveMin' is dual to 'interleave'.

1540−--

1541−-- Do not use at scale in concatMapWith.

345+-- | Tap the data flowing through a stream into a 'Fold'. For example, you may

346+-- add a tap to log the contents flowing through the stream. The fold is used

347+-- only for effects, its result is discarded.

1542348--

1543−-- /Internal/

1544−{-# INLINE interleaveMin #-}

1545−interleaveMin ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1546−interleaveMin m1 m2 = fromStreamD $ D.interleaveMin (toStreamD m1) (toStreamD m2)

1547−

1548−-- | Schedule the execution of two streams in a fair round-robin manner,

1549−-- executing each stream once, alternately. Execution of a stream may not

1550−-- necessarily result in an output, a stream may chose to @Skip@ producing an

1551−-- element until later giving the other stream a chance to run. Therefore, this

1552−-- combinator fairly interleaves the execution of two streams rather than

1553−-- fairly interleaving the output of the two streams. This can be useful in

1554−-- co-operative multitasking without using explicit threads. This can be used

1555−-- as an alternative to `async`.

349+-- @

350+-- Fold m a b

351+-- |

352+-- -----stream m a ---------------stream m a-----

1556353--

1557−-- Do not use at scale in concatMapWith.

354+-- @

1558355--

1559−-- /Internal/

1560−{-# INLINE roundrobin #-}

1561−roundrobin ::(IsStream t, Monad m) => t m b -> t m b -> t m b

1562−roundrobin m1 m2 = fromStreamD $ D.roundRobin (toStreamD m1) (toStreamD m2)

1563−

1564−-- | Map a stream producing monadic function on each element of the stream

1565−-- and then flatten the results into a single stream. Since the stream

1566−-- generation function is monadic, unlike 'concatMap', it can produce an

1567−-- effect at the beginning of each iteration of the inner loop.

356+-- @

357+-- > S.drain $ S.tap (FL.drainBy print) (S.enumerateFromTo 1 2)

358+-- 1

359+-- 2

360+-- @

1568361--

1569−-- @since 0.6.0

1570−{-# INLINE concatMapM #-}

1571−concatMapM :: (IsStream t, Monad m) => (a -> m (t m b)) -> t m a -> t m b

1572−concatMapM f m = fromStreamD $ D.concatMapM (fmap toStreamD . f) (toStreamD m)

1573−

1574−-- | Like 'concatMap' but uses an 'Unfold' for stream generation. Unlike

1575−-- 'concatMap' this can fuse the 'Unfold' code with the inner loop and

1576−-- therefore provide many times better performance.

362+-- Compare with 'trace'.

1577363--

1578364-- @since 0.7.0

1579−{-# INLINE concatUnfold #-}

1580−concatUnfold ::(IsStream t, Monad m) => Unfold m a b -> t m a -> t m b

1581−concatUnfold u m = fromStreamD $ D.concatMapU u (toStreamD m)

1582−

1583−-- | Like 'concatUnfold' but interleaves the streams in the same way as

1584−-- 'interleave' behaves instead of appending them.

1585−--

1586−-- /Internal/

1587−{-# INLINE concatUnfoldInterleave #-}

1588−concatUnfoldInterleave ::(IsStream t, Monad m)

1589− => Unfold m a b -> t m a -> t m b

1590−concatUnfoldInterleave u m =

1591− fromStreamD $ D.concatUnfoldInterleave u (toStreamD m)

1592−

1593−-- | Like 'concatUnfold' but executes the streams in the same way as

1594−-- 'roundrobin'.

1595−--

1596−-- /Internal/

1597−{-# INLINE concatUnfoldRoundrobin #-}

1598−concatUnfoldRoundrobin ::(IsStream t, Monad m)

1599− => Unfold m a b -> t m a -> t m b

1600−concatUnfoldRoundrobin u m =

1601− fromStreamD $ D.concatUnfoldRoundrobin u (toStreamD m)

1602−

1603−-- XXX we can swap the order of arguments to gintercalate so that the

1604−-- definition of concatUnfold becomes simpler? The first stream should be

1605−-- infixed inside the second one. However, if we change the order in

1606−-- "interleave" as well similarly, then that will make it a bit unintuitive.

1607−--

1608−-- > concatUnfold unf str =

1609−-- > gintercalate unf str (UF.nilM (\_ -> return ())) (repeat ())

1610−--

1611−-- | 'interleaveInfix' followed by unfold and concat.

1612−--

1613−-- /Internal/

1614−{-# INLINE gintercalate #-}

1615−gintercalate

1616− :: (IsStream t, Monad m)

1617− => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c

1618−gintercalate unf1 str1 unf2 str2 =

1619− D.fromStreamD $ D.gintercalate

1620− unf1 (D.toStreamD str1)

1621− unf2 (D.toStreamD str2)

1622−

1623−-- XXX The order of arguments in "intercalate" is consistent with the list

1624−-- intercalate but inconsistent with gintercalate and other stream interleaving

1625−-- combinators. We can change the order of the arguments in other combinators

1626−-- but then 'interleave' combinator may become a bit unintuitive because we

1627−-- will be starting with the second stream.

1628−

1629−-- > intercalate seed unf str = gintercalate unf str unf (repeatM seed)

1630−-- > intercalate a unf str = concatUnfold unf $ intersperse a str

1631−--

1632−-- | 'intersperse' followed by unfold and concat.

1633−--

1634−-- > unwords = intercalate " " UF.fromList

1635−--

1636−-- >>> intercalate " " UF.fromList ["abc", "def", "ghi"]

1637−-- > "abc def ghi"

1638−--

1639−-- /Internal/

1640−{-# INLINE intercalate #-}

1641−intercalate :: (IsStream t, Monad m)

1642− => b -> Unfold m b c -> t m b -> t m c

1643−intercalate seed unf str = D.fromStreamD $

1644− D.concatMapU unf $ D.intersperse seed (toStreamD str)

1645−

1646−-- > interpose x unf str = gintercalate unf str UF.identity (repeat x)

1647−--

1648−-- | Unfold the elements of a stream, intersperse the given element between the

1649−-- unfolded streams and then concat them into a single stream.

1650−--

1651−-- > unwords = S.interpose ' '

1652−--

1653−-- /Internal/

1654−{-# INLINE interpose #-}

1655−interpose :: (IsStream t, Monad m)

1656− => c -> Unfold m b c -> t m b -> t m c

1657−interpose x unf str =

1658− D.fromStreamD $ D.interpose (return x) unf (D.toStreamD str)

1659−

1660−-- | 'interleaveSuffix' followed by unfold and concat.

1661−--

1662−-- /Internal/

1663−{-# INLINE gintercalateSuffix #-}

1664−gintercalateSuffix

1665− :: (IsStream t, Monad m)

1666− => Unfold m a c -> t m a -> Unfold m b c -> t m b -> t m c

1667−gintercalateSuffix unf1 str1 unf2 str2 =

1668− D.fromStreamD $ D.gintercalateSuffix

1669− unf1 (D.toStreamD str1)

1670− unf2 (D.toStreamD str2)

1671−

1672−-- > intercalateSuffix seed unf str = gintercalateSuffix unf str unf (repeatM seed)

1673−-- > intercalateSuffix a unf str = concatUnfold unf $ intersperseSuffix a str

1674−--

1675−-- | 'intersperseSuffix' followed by unfold and concat.

1676−--

1677−-- > unlines = intercalateSuffix "\n" UF.fromList

1678−--

1679−-- >>> intercalate "\n" UF.fromList ["abc", "def", "ghi"]

1680−-- > "abc\ndef\nghi\n"

1681−--

1682−-- /Internal/

1683−{-# INLINE intercalateSuffix #-}

1684−intercalateSuffix :: (IsStream t, Monad m)

1685− => b -> Unfold m b c -> t m b -> t m c

1686−intercalateSuffix seed unf str = fromStreamD $ D.concatMapU unf

1687− $ D.intersperseSuffix (return seed) (D.toStreamD str)

1688−

1689−-- interposeSuffix x unf str = gintercalateSuffix unf str UF.identity (repeat x)

1690−--

1691−-- | Unfold the elements of a stream, append the given element after each

1692−-- unfolded stream and then concat them into a single stream.

1693−--

1694−-- > unlines = S.interposeSuffix '\n'

1695−--

1696−-- /Internal/

1697−{-# INLINE interposeSuffix #-}

1698−interposeSuffix :: (IsStream t, Monad m)

1699− => c -> Unfold m b c -> t m b -> t m c

1700−interposeSuffix x unf str =

1701− D.fromStreamD $ D.interposeSuffix (return x) unf (D.toStreamD str)

1702−

1703−------------------------------------------------------------------------------

1704−-- Either streams

1705−------------------------------------------------------------------------------

365+{-# INLINE tap #-}

366+tap :: (IsStream t, Monad m) => FL.Fold m a b -> t m a -> t m a

367+tap f xs = D.fromStreamD $ D.tap f (D.toStreamD xs)

1706368

1707−-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.

1708−--

1709−-- /Internal/

369+-- | @tapOffsetEvery offset n@ taps every @n@th element in the stream

370+-- starting at @offset@. @offset@ can be between @0@ and @n - 1@. Offset 0

371+-- means start at the first element in the stream. If the offset is outside

372+-- this range then @offset `mod` n@ is used as offset.

1710373--

1711−lefts :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m a

1712−lefts = fmap (fromLeft undefined) . filter isLeft

1713−

1714−-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.

374+-- @

375+-- >>> S.drain $ S.tapOffsetEvery 0 2 (FL.mapM print FL.toList) $ S.enumerateFromTo 0 10

376+-- > [0,2,4,6,8,10]

377+-- @

1715378--

1716379-- /Internal/

1717380--

1718−rights :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m b

1719−rights = fmap (fromRight undefined) . filter isRight

1720−

1721−------------------------------------------------------------------------------

1722−-- Parsing

1723−------------------------------------------------------------------------------

1724−

1725−-- Splitting operations that take a predicate and a Fold can be

1726−-- expressed using parseMany. Operations like chunksOf, intervalsOf, split*,

1727−-- can be expressed using parseMany when used with an appropriate Parser.

1728−--

1729−-- XXX We need takeGE/takeBetween to implement "some" using "many".

381+{-# INLINE tapOffsetEvery #-}

382+tapOffsetEvery :: (IsStream t, Monad m)

383+ => Int -> Int -> FL.Fold m a b -> t m a -> t m a

384+tapOffsetEvery offset n f xs =

385+ D.fromStreamD $ D.tapOffsetEvery offset n f (D.toStreamD xs)

1730386

1731−-- | Apply a 'Fold' repeatedly on a stream and emit the parsed values in the

1732−-- output stream.

1733−--

1734−-- This is the streaming dual of the 'Streamly.Internal.Data.Fold.many'

1735−-- parse combinator.

1736−--

1737−-- >>> f = Fold.ltake 2 Fold.sum

1738−-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList [1..10]

1739−-- > [3,7,11,15,19]

1740−--

1741−-- >>> f = Fold.sliceEndWith Fold.toList

1742−-- >>> Stream.toList $ Stream.foldMany f $ Stream.fromList "hello\nworld"

1743−-- > ["hello\n","world"]

387+-- | Redirect a copy of the stream to a supplied fold and run it concurrently

388+-- in an independent thread. The fold may buffer some elements. The buffer size

389+-- is determined by the prevailing 'maxBuffer' setting.

1744390--

1745−-- /Internal/

391+-- @

392+-- Stream m a -> m b

393+-- |

394+-- -----stream m a ---------------stream m a-----

1746395--

1747−{-# INLINE foldMany #-}

1748−foldMany

1749− :: (IsStream t, Monad m)

1750− => Fold m a b

1751− -> t m a

1752− -> t m b

1753−foldMany f m = D.fromStreamD $ D.foldMany f (D.toStreamD m)

1754−

1755−-- | Apply a stream of folds to an input stream and emit the results in the

1756−-- output stream.

396+-- @

1757397--

1758−-- /Internal/

398+-- @

399+-- > S.drain $ S.tapAsync (S.mapM_ print) (S.enumerateFromTo 1 2)

400+-- 1

401+-- 2

402+-- @

1759403--

1760−{-# INLINE foldSequence #-}

1761−foldSequence

1762− :: -- (IsStream t, Monad m) =>

1763− t m (Fold m a b)

1764− -> t m a

1765− -> t m b

1766−foldSequence _f _m = undefined

1767−

1768−-- | Iterate a fold generator on a stream. The initial value @b@ is used to

1769−-- generate the first fold, the fold is applied on the stream and the result of

1770−-- the fold is used to generate the next fold and so on.

404+-- Exceptions from the concurrently running fold are propagated to the current

405+-- computation. Note that, because of buffering in the fold, exceptions may be

406+-- delayed and may not correspond to the current element being processed in the

407+-- parent stream, but we guarantee that before the parent stream stops the tap

408+-- finishes and all exceptions from it are drained.

1771409--

1772−-- >>> f x = Fold.ltake 2 (Fold.mconcatTo x)

1773−-- >>> s = Stream.map Sum $ Stream.fromList [1..10]

1774−-- >>> Stream.toList $ Stream.map getSum $ Stream.foldIterate f 0 s

1775−-- > [3,10,21,36,55,55]

1776410--

1777−-- This is the streaming equivalent of monad like sequenced application of

1778−-- folds where next fold is dependent on the previous fold.

411+-- Compare with 'tap'.

1779412--

1780413-- /Internal/

1781−--

1782−{-# INLINE foldIterate #-}

1783−foldIterate

1784− :: -- (IsStream t, Monad m) =>

1785− (b -> Fold m a b)

1786− -> b

1787− -> t m a

1788− -> t m b

1789−foldIterate _f _i _m = undefined

1790−-- D.fromStreamD $ D.foldIterate f i (D.toStreamD m)

414+{-# INLINE tapAsync #-}

415+tapAsync :: (IsStream t, MonadAsync m) => FL.Fold m a b -> t m a -> t m a

416+tapAsync f xs = D.fromStreamD $ D.tapAsync f (D.toStreamD xs)

1791417

1792−-- | Apply a 'Parser' repeatedly on a stream and emit the parsed values in the

1793−-- output stream.

418+-- | @pollCounts predicate transform fold stream@ counts those elements in the

419+-- stream that pass the @predicate@. The resulting count stream is sent to

420+-- another thread which transforms it using @transform@ and then folds it using

421+-- @fold@. The thread is automatically cleaned up if the stream stops or

422+-- aborts due to exception.

1794423--

1795−-- This is the streaming equivalent of the 'Streamly.Internal.Data.Parser.many'

1796−-- parse combinator.

424+-- For example, to print the count of elements processed every second:

1797425--

1798−-- >>> S.toList $ S.parseMany (PR.take 2 $ PR.fromFold FL.sum) $ S.fromList [1..10]

1799−-- > [3,7,11,15,19]

426+-- @

427+-- > S.drain $ S.pollCounts (const True) (S.rollingMap (-) . S.delayPost 1) (FL.drainBy print)

428+-- $ S.enumerateFrom 0

429+-- @

1800430--

1801−-- >>> S.toList $ S.parseMany (PR.line FL.toList) $ S.fromList "hello\nworld"

1802−-- > ["hello\n","world"]

431+-- Note: This may not work correctly on 32-bit machines.

1803432--

1804433-- /Internal/

1805434--

1806−{-# INLINE parseMany #-}

1807−parseMany

1808− :: (IsStream t, MonadThrow m)

1809− => Parser m a b

1810− -> t m a

1811− -> t m b

1812−parseMany p m =

1813− D.fromStreamD $ D.parseMany (PRK.fromParserK p) (D.toStreamD m)

1814−

1815−{-# INLINE parseManyD #-}

1816−parseManyD

1817− :: (IsStream t, MonadThrow m)

1818− => PRD.Parser m a b

435+{-# INLINE pollCounts #-}

436+pollCounts ::

437+ (IsStream t, MonadAsync m)

438+ => (a -> Bool)

439+ -> (t m Int -> t m Int)

440+ -> Fold m Int b

1819441 -> t m a

1820− -> t m b

1821−parseManyD p m =

1822− D.fromStreamD $ D.parseMany p (D.toStreamD m)

1823−

1824−-- | Apply a stream of parsers to an input stream and emit the results in the

1825−-- output stream.

1826−--

1827−-- /Internal/

1828−--

1829−{-# INLINE parseSequence #-}

1830−parseSequence

1831− :: -- (IsStream t, Monad m) =>

1832− t m (Parser m a b)

1833442 -> t m a

1834− -> t m b

1835−parseSequence _f _m = undefined

443+pollCounts predicate transf f xs =

444+ D.fromStreamD

445+ $ D.pollCounts predicate (D.toStreamD . transf . D.fromStreamD) f

446+ $ D.toStreamD xs

1836447

1837−-- | @parseManyTill collect test stream@ tries the parser @test@ on the input,

1838−-- if @test@ fails it backtracks and tries @collect@, after @collect@ succeeds

1839−-- @test@ is tried again and so on. The parser stops when @test@ succeeds. The

1840−-- output of @test@ is discarded and the output of @collect@ is emitted in the

1841−-- output stream. The parser fails if @collect@ fails.

1842−--

1843−-- /Unimplemented/

448+-- | Calls the supplied function with the number of elements consumed

449+-- every @n@ seconds. The given function is run in a separate thread

450+-- until the end of the stream. In case there is an exception in the

451+-- stream the thread is killed during the next major GC.

1844452--

1845−{-# INLINE parseManyTill #-}

1846−parseManyTill ::

1847− -- (IsStream t, MonadThrow m) =>

1848− Parser m a b

1849− -> Parser m a x

1850− -> t m a

1851− -> t m b

1852−parseManyTill = undefined

1853−

1854−-- | Iterate a parser generating function on a stream. The initial value @b@ is

1855−-- used to generate the first parser, the parser is applied on the stream and

1856−-- the result is used to generate the next parser and so on.

453+-- Note: The action is not guaranteed to run if the main thread exits.

1857454--

1858−-- >>> S.toList $ S.map getSum $ S.parseIterate (\b -> PR.take 2 (FL.mconcatTo b)) 0 $ S.map Sum $ S.fromList [1..10]

1859−-- > [3,10,21,36,55,55]

455+-- @

456+-- > delay n = threadDelay (round $ n * 1000000) >> return n

457+-- > S.drain $ S.tapRate 2 (\\n -> print $ show n ++ " elements processed") (delay 1 S.|: delay 0.5 S.|: delay 0.5 S.|: S.nil)

458+-- 2 elements processed

459+-- 1 elements processed

460+-- @

1860461--

1861−-- This is the streaming equivalent of monad like sequenced application of

1862−-- parsers where next parser is dependent on the previous parser.

462+-- Note: This may not work correctly on 32-bit machines.

1863463--

1864464-- /Internal/

1865−--

1866−{-# INLINE parseIterate #-}

1867−parseIterate

1868− :: (IsStream t, MonadThrow m)

1869− => (b -> Parser m a b)

1870− -> b

1871− -> t m a

1872− -> t m b

1873−parseIterate f i m = D.fromStreamD $

1874− D.parseIterate (PRK.fromParserK . f) i (D.toStreamD m)

1875−

1876−------------------------------------------------------------------------------

1877−-- Grouping/Splitting

1878−------------------------------------------------------------------------------

1879−

1880−------------------------------------------------------------------------------

1881−-- Grouping without looking at elements

1882−------------------------------------------------------------------------------

1883−--

1884−------------------------------------------------------------------------------

1885−-- Binary APIs

1886−------------------------------------------------------------------------------

1887−--

1888−

1889−------------------------------------------------------------------------------

1890−-- N-ary APIs

1891−------------------------------------------------------------------------------

1892−

1893−------------------------------------------------------------------------------

1894−-- Generalized grouping

1895−------------------------------------------------------------------------------

1896−

1897−-- This combinator is the most general grouping combinator and can be used to

1898−-- implement all other grouping combinators.

1899−--

1900−-- XXX check if this can implement the splitOn combinator i.e. we can slide in

1901−-- new elements, slide out old elements and incrementally compute the hash.

1902−-- Also, can we implement the windowed classification combinators using this?

1903−--

1904−-- In fact this is a parse. Instead of using a special return value in the fold

1905−-- we are using a mapping function.

1906−--

1907−-- Note that 'scanl'' (usually followed by a map to extract the desired value

1908−-- from the accumulator) can be used to realize many implementations e.g. a

1909−-- sliding window implementation. A scan followed by a mapMaybe is also a good

1910−-- pattern to express many problems where we want to emit a filtered output and

1911−-- not emit an output on every input.

1912−--

1913−-- Passing on of the initial accumulator value to the next fold is equivalent

1914−-- to returning the leftover concept.

1915−

1916−{-

1917−-- | @groupScan splitter fold stream@ folds the input stream using @fold@.

1918−-- @splitter@ is applied on the accumulator of the fold every time an item is

1919−-- consumed by the fold. The fold continues until @splitter@ returns a 'Just'

1920−-- value. A 'Just' result from the @splitter@ specifies a result to be emitted

1921−-- in the output stream and the initial value of the accumulator for the next

1922−-- group's fold. This allows us to control whether to start fresh for the next

1923−-- fold or to continue from the previous fold's output.

1924−--

1925−{-# INLINE groupScan #-}

1926−groupScan

1927− :: (IsStream t, Monad m)

1928− => (x -> m (Maybe (b, x))) -> Fold m a x -> t m a -> t m b

1929−groupScan split fold m = undefined

1930−-}

465+{-# INLINE tapRate #-}

466+tapRate ::

467+ (IsStream t, MonadAsync m, MonadCatch m)

468+ => Double

469+ -> (Int -> m b)

470+ -> t m a

471+ -> t m a

472+tapRate n f xs = D.fromStreamD $ D.tapRate n f $ D.toStreamD xs

1931473

1932−-- | Group the input stream into groups of @n@ elements each and then fold each

1933−-- group using the provided fold function.

474+-- | Apply a monadic function to each element flowing through the stream and

475+-- discard the results.

1934476--

1935−-- >> S.toList $ S.chunksOf 2 FL.sum (S.enumerateFromTo 1 10)

1936−-- > [3,7,11,15,19]

477+-- @

478+-- > S.drain $ S.trace print (S.enumerateFromTo 1 2)

479+-- 1

480+-- 2

481+-- @

1937482--

1938−-- This can be considered as an n-fold version of 'ltake' where we apply

1939−-- 'ltake' repeatedly on the leftover stream until the stream exhausts.

483+-- Compare with 'tap'.

1940484--

1941485-- @since 0.7.0

1942−{-# INLINE chunksOf #-}

1943−chunksOf

1944− :: (IsStream t, Monad m)

1945− => Int -> Fold m a b -> t m a -> t m b

1946−chunksOf n f = foldMany (FL.ltake n f)

1947−

1948−-- |

1949−--

1950−-- /Internal/

1951−{-# INLINE chunksOf2 #-}

1952−chunksOf2

1953− :: (IsStream t, Monad m)

1954− => Int -> m c -> Fold2 m c a b -> t m a -> t m b

1955−chunksOf2 n action f m = D.fromStreamD $ D.groupsOf2 n action f (D.toStreamD m)

486+{-# INLINE trace #-}

487+trace :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m a

488+trace f = mapM (\x -> void (f x) >> return x)

1956489

1957−-- | @arraysOf n stream@ groups the elements in the input stream into arrays of

1958−-- @n@ elements each.

490+-- | Perform a side effect before yielding each element of the stream and

491+-- discard the results.

1959492--

1960−-- Same as the following but may be more efficient:

493+-- @

494+-- > S.drain $ S.trace_ (print "got here") (S.enumerateFromTo 1 2)

495+-- "got here"

496+-- "got here"

497+-- @

1961498--

1962−-- > arraysOf n = S.chunksOf n (A.writeN n)

499+-- See also: 'trace', 'interspersePrefix_'

1963500--

1964501-- /Internal/

1965−{-# INLINE arraysOf #-}

1966−arraysOf :: (IsStream t, MonadIO m, Storable a)

1967− => Int -> t m a -> t m (Array a)

1968−arraysOf n = chunksOf n (writeNUnsafe n)

502+{-# INLINE trace_ #-}

503+trace_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

504+trace_ eff = Serial.mapM (\x -> eff >> return x)

1969505

1970506------------------------------------------------------------------------------

1971−-- N-ary APIs

507+-- Scanning with a Fold

1972508------------------------------------------------------------------------------

1973509

1974−-- | @groupsBy cmp f $ S.fromList [a,b,c,...]@ assigns the element @a@ to the

1975−-- first group, if @b \`cmp` a@ is 'True' then @b@ is also assigned to the same

1976−-- group. If @c \`cmp` a@ is 'True' then @c@ is also assigned to the same

1977−-- group and so on. When the comparison fails a new group is started. Each

1978−-- group is folded using the fold @f@ and the result of the fold is emitted in

1979−-- the output stream.

1980−--

1981−-- >>> S.toList $ S.groupsBy (>) FL.toList $ S.fromList [1,3,7,0,2,5]

1982−-- > [[1,3,7],[0,2,5]]

1983−--

1984−-- @since 0.7.0

1985−{-# INLINE groupsBy #-}

1986−groupsBy

1987− :: (IsStream t, Monad m)

1988− => (a -> a -> Bool)

1989− -> Fold m a b

1990− -> t m a

1991− -> t m b

1992−groupsBy cmp f m = D.fromStreamD $ D.groupsBy cmp f (D.toStreamD m)

1993−

1994−-- | Unlike @groupsBy@ this function performs a rolling comparison of two

1995−-- successive elements in the input stream. @groupsByRolling cmp f $ S.fromList

1996−-- [a,b,c,...]@ assigns the element @a@ to the first group, if @a \`cmp` b@ is

1997−-- 'True' then @b@ is also assigned to the same group. If @b \`cmp` c@ is

1998−-- 'True' then @c@ is also assigned to the same group and so on. When the

1999−-- comparison fails a new group is started. Each group is folded using the fold

2000−-- @f@.

2001−--

2002−-- >>> S.toList $ S.groupsByRolling (\a b -> a + 1 == b) FL.toList $ S.fromList [1,2,3,7,8,9]

2003−-- > [[1,2,3],[7,8,9]]

510+-- | Scan a stream using the given monadic fold.

2004511--

2005512-- @since 0.7.0

2006−{-# INLINE groupsByRolling #-}

2007−groupsByRolling

2008− :: (IsStream t, Monad m)

2009− => (a -> a -> Bool)

2010− -> Fold m a b

2011− -> t m a

2012− -> t m b

2013−groupsByRolling cmp f m = D.fromStreamD $ D.groupsRollingBy cmp f (D.toStreamD m)

513+{-# INLINE scan #-}

514+scan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b

515+scan = P.scanOnce

2014516

2015−-- |

2016−-- > groups = groupsBy (==)

2017−-- > groups = groupsByRolling (==)

2018−--

2019−-- Groups contiguous spans of equal elements together in individual groups.

2020−--

2021−-- >>> S.toList $ S.groups FL.toList $ S.fromList [1,1,2,2]

2022−-- > [[1,1],[2,2]]

517+-- | Postscan a stream using the given monadic fold.

2023518--

2024519-- @since 0.7.0

2025−{-# INLINE groups #-}

2026−groups :: (IsStream t, Monad m, Eq a) => Fold m a b -> t m a -> t m b

2027−groups = groupsBy (==)

520+{-# INLINE postscan #-}

521+postscan :: (IsStream t, Monad m) => Fold m a b -> t m a -> t m b

522+postscan = P.postscanOnce

2028523

2029524------------------------------------------------------------------------------

2030−-- N-ary split on a predicate

525+-- Scanning - Transformation by Folding

2031526------------------------------------------------------------------------------

2032527

2033−-- TODO: Use a Splitter configuration similar to the "split" package to make it

2034−-- possible to express all splitting combinations. In general, we can have

2035−-- infix/suffix/prefix/condensing of separators, dropping both leading/trailing

2036−-- separators. We can have a single split operation taking the splitter config

2037−-- as argument.

2038−

2039−-- | Split on an infixed separator element, dropping the separator. Splits the

2040−-- stream on separator elements determined by the supplied predicate, separator

2041−-- is considered as infixed between two segments, if one side of the separator

2042−-- is missing then it is parsed as an empty stream. The supplied 'Fold' is

2043−-- applied on the split segments. With '-' representing non-separator elements

2044−-- and '.' as separator, 'splitOn' splits as follows:

2045−--

2046−-- @

2047−-- "--.--" => "--" "--"

2048−-- "--." => "--" ""

2049−-- ".--" => "" "--"

2050−-- @

528+-- XXX It may be useful to have a version of scan where we can keep the

529+-- accumulator independent of the value emitted. So that we do not necessarily

530+-- have to keep a value in the accumulator which we are not using. We can pass

531+-- an extraction function that will take the accumulator and the current value

532+-- of the element and emit the next value in the stream. That will also make it

533+-- possible to modify the accumulator after using it. In fact, the step function

534+-- can return new accumulator and the value to be emitted. The signature would

535+-- be more like mapAccumL. Or we can change the signature of scanx to

536+-- accommodate this.

2051537--

2052−-- @splitOn (== x)@ is an inverse of @intercalate (S.yield x)@

538+-- | Strict left scan with an extraction function. Like 'scanl'', but applies a

539+-- user supplied extraction function (the third argument) at each step. This is

540+-- designed to work with the @foldl@ library. The suffix @x@ is a mnemonic for

541+-- extraction.

2053542--

2054−-- Let's use the following definition for illustration:

543+-- /Since 0.2.0/

2055544--

2056−-- > splitOn' p xs = S.toList $ S.splitOn p (FL.toList) (S.fromList xs)

545+-- /Since: 0.7.0 (Monad m constraint)/

546+{-# DEPRECATED scanx "Please use scanl followed by map instead." #-}

547+{-# INLINE scanx #-}

548+scanx :: (IsStream t, Monad m) => (x -> a -> x) -> x -> (x -> b) -> t m a -> t m b

549+scanx = P.scanlx'

550+

551+-- XXX this needs to be concurrent

552+-- XXX because of the use of D.cons for appending, scanlM' has quadratic

553+-- complexity when iterated over a stream. We should use StreamK style scanlM'

554+-- for linear performance on iteration.

2057555--

2058−-- >>> splitOn' (== '.') ""

2059−-- [""]

556+-- | Like 'scanl'' but with a monadic step function and a monadic seed.

2060557--

2061−-- >>> splitOn' (== '.') "."

2062−-- ["",""]

558+-- /Since: 0.4.0/

2063559--

2064−-- >>> splitOn' (== '.') ".a"

2065−-- > ["","a"]

560+-- /Since: 0.8.0 (signature change)/

561+{-# INLINE scanlM' #-}

562+scanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

563+scanlM' step begin m = fromStreamD $ D.scanlM' step begin $ toStreamD m

564+

565+-- XXX because of the use of D.cons for appending, scanl' has quadratic

566+-- complexity when iterated over a stream. We should use StreamK style scanlM'

567+-- for linear performance on iteration.

568+

569+-- | Strict left scan. Like 'map', 'scanl'' too is a one to one transformation,

570+-- however it adds an extra element.

2066571--

2067−-- >>> splitOn' (== '.') "a."

2068−-- > ["a",""]

572+-- @

573+-- > S.toList $ S.scanl' (+) 0 $ fromList [1,2,3,4]

574+-- [0,1,3,6,10]

575+-- @

2069576--

2070−-- >>> splitOn' (== '.') "a.b"

2071−-- > ["a","b"]

577+-- @

578+-- > S.toList $ S.scanl' (flip (:)) [] $ S.fromList [1,2,3,4]

579+-- [[],[1],[2,1],[3,2,1],[4,3,2,1]]

580+-- @

2072581--

2073−-- >>> splitOn' (== '.') "a..b"

2074−-- > ["a","","b"]

582+-- The output of 'scanl'' is the initial value of the accumulator followed by

583+-- all the intermediate steps and the final result of 'foldl''.

2075584--

2076−-- @since 0.7.0

2077−

2078−-- This can be considered as an n-fold version of 'breakOn' where we apply

2079−-- 'breakOn' successively on the input stream, dropping the first element

2080−-- of the second segment after each break.

585+-- By streaming the accumulated state after each fold step, we can share the

586+-- state across multiple stages of stream composition. Each stage can modify or

587+-- extend the state, do some processing with it and emit it for the next stage,

588+-- thus modularizing the stream processing. This can be useful in

589+-- stateful or event-driven programming.

2081590--

2082−{-# INLINE splitOn #-}

2083−splitOn

2084− :: (IsStream t, Monad m)

2085− => (a -> Bool) -> Fold m a b -> t m a -> t m b

2086−splitOn predicate f = foldMany (FL.sliceSepBy predicate f)

2087−

2088−-- | Like 'splitOn' but the separator is considered as suffixed to the segments

2089−-- in the stream. A missing suffix at the end is allowed. A separator at the

2090−-- beginning is parsed as empty segment. With '-' representing elements and

2091−-- '.' as separator, 'splitOnSuffix' splits as follows:

591+-- Consider the following monolithic example, computing the sum and the product

592+-- of the elements in a stream in one go using a @foldl'@:

2092593--

2093594-- @

2094−-- "--.--." => "--" "--"

2095−-- "--.--" => "--" "--"

2096−-- ".--." => "" "--"

595+-- > S.foldl' (\\(s, p) x -> (s + x, p * x)) (0,1) $ S.fromList \[1,2,3,4]

596+-- (10,24)

2097597-- @

2098598--

2099−-- > splitOnSuffix' p xs = S.toList $ S.splitSuffixBy p (FL.toList) (S.fromList xs)

2100−--

2101−-- >>> splitOnSuffix' (== '.') ""

2102−-- []

599+-- Using @scanl'@ we can make it modular by computing the sum in the first

600+-- stage and passing it down to the next stage for computing the product:

2103601--

2104−-- >>> splitOnSuffix' (== '.') "."

2105−-- [""]

602+-- @

603+-- > S.foldl' (\\(_, p) (s, x) -> (s, p * x)) (0,1)

604+-- $ S.scanl' (\\(s, _) x -> (s + x, x)) (0,1)

605+-- $ S.fromList \[1,2,3,4]

606+-- (10,24)

607+-- @

2106608--

2107−-- >>> splitOnSuffix' (== '.') "a"

2108−-- ["a"]

609+-- IMPORTANT: 'scanl'' evaluates the accumulator to WHNF. To avoid building

610+-- lazy expressions inside the accumulator, it is recommended that a strict

611+-- data structure is used for accumulator.

2109612--

2110−-- >>> splitOnSuffix' (== '.') ".a"

2111−-- > ["","a"]

613+-- See also: 'usingStateT'

2112614--

2113−-- >>> splitOnSuffix' (== '.') "a."

2114−-- > ["a"]

615+-- @since 0.2.0

616+{-# INLINE scanl' #-}

617+scanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

618+scanl' step z m = fromStreamS $ S.scanl' step z $ toStreamS m

619+

620+-- | Like 'scanl'' but does not stream the initial value of the accumulator.

2115621--

2116−-- >>> splitOnSuffix' (== '.') "a.b"

2117−-- > ["a","b"]

622+-- > postscanl' f z xs = S.drop 1 $ S.scanl' f z xs

2118623--

2119−-- >>> splitOnSuffix' (== '.') "a.b."

2120−-- > ["a","b"]

624+-- @since 0.7.0

625+{-# INLINE postscanl' #-}

626+postscanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

627+postscanl' step z m = fromStreamD $ D.postscanl' step z $ toStreamD m

628+

629+-- XXX prescanl does not sound very useful, enable only if there is a

630+-- compelling use case.

2121631--

2122−-- >>> splitOnSuffix' (== '.') "a..b.."

2123−-- > ["a","","b",""]

632+-- | Like scanl' but does not stream the final value of the accumulator.

2124633--

2125−-- > lines = splitOnSuffix (== '\n')

634+-- /Internal/

635+{-# INLINE prescanl' #-}

636+prescanl' :: (IsStream t, Monad m) => (b -> a -> b) -> b -> t m a -> t m b

637+prescanl' step z m = fromStreamD $ D.prescanl' step z $ toStreamD m

638+

639+-- XXX this needs to be concurrent

640+-- | Like prescanl' but with a monadic step function and a monadic seed.

2126641--

2127−-- @since 0.7.0

642+-- /Internal/

643+{-# INLINE prescanlM' #-}

644+prescanlM' :: (IsStream t, Monad m) => (b -> a -> m b) -> m b -> t m a -> t m b

645+prescanlM' step z m = fromStreamD $ D.prescanlM' step z $ toStreamD m

2128646

2129−-- This can be considered as an n-fold version of 'breakPost' where we apply

2130−-- 'breakPost' successively on the input stream, dropping the first element

2131−-- of the second segment after each break.

647+-- XXX this needs to be concurrent

648+-- | Like 'scanl1'' but with a monadic step function.

2132649--

2133−{-# INLINE splitOnSuffix #-}

2134−splitOnSuffix

2135− :: (IsStream t, Monad m)

2136− => (a -> Bool) -> Fold m a b -> t m a -> t m b

2137−splitOnSuffix predicate f m =

2138− D.fromStreamD $ D.foldMany1 (FL.sliceSepBy predicate f) (D.toStreamD m)

650+-- @since 0.6.0

651+{-# INLINE scanl1M' #-}

652+scanl1M' :: (IsStream t, Monad m) => (a -> a -> m a) -> t m a -> t m a

653+scanl1M' step m = fromStreamD $ D.scanl1M' step $ toStreamD m

2139654

2140−-- | Like 'splitOn' after stripping leading, trailing, and repeated separators.

2141−-- Therefore, @".a..b."@ with '.' as the separator would be parsed as

2142−-- @["a","b"]@. In other words, its like parsing words from whitespace

2143−-- separated text.

655+-- | Like 'scanl'' but for a non-empty stream. The first element of the stream

656+-- is used as the initial value of the accumulator. Does nothing if the stream

657+-- is empty.

658+--

659+-- @

660+-- > S.toList $ S.scanl1 (+) $ fromList [1,2,3,4]

661+-- [1,3,6,10]

662+-- @

2144663--

2145−-- > wordsBy' p xs = S.toList $ S.wordsBy p (FL.toList) (S.fromList xs)

664+-- @since 0.6.0

665+{-# INLINE scanl1' #-}

666+scanl1' :: (IsStream t, Monad m) => (a -> a -> a) -> t m a -> t m a

667+scanl1' step m = fromStreamD $ D.scanl1' step $ toStreamD m

668+

669+------------------------------------------------------------------------------

670+-- Filtering

671+------------------------------------------------------------------------------

672+

673+-- | Include only those elements that pass a predicate.

2146674--

2147−-- >>> wordsBy' (== ',') ""

2148−-- > []

675+-- @since 0.1.0

676+{-# INLINE filter #-}

677+#if __GLASGOW_HASKELL__ != 802

678+-- GHC 8.2.2 crashes with this code, when used with "stack"

679+filter :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

680+filter p m = fromStreamS $ S.filter p $ toStreamS m

681+#else

682+filter :: IsStream t => (a -> Bool) -> t m a -> t m a

683+filter = K.filter

684+#endif

685+

686+-- | Same as 'filter' but with a monadic predicate.

2149687--

2150−-- >>> wordsBy' (== ',') ","

2151−-- > []

688+-- @since 0.4.0

689+{-# INLINE filterM #-}

690+filterM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

691+filterM p m = fromStreamD $ D.filterM p $ toStreamD m

692+

693+-- | Drop repeated elements that are adjacent to each other.

2152694--

2153−-- >>> wordsBy' (== ',') ",a,,b,"

2154−-- > ["a","b"]

695+-- @since 0.6.0

696+{-# INLINE uniq #-}

697+uniq :: (Eq a, IsStream t, Monad m) => t m a -> t m a

698+uniq = fromStreamD . D.uniq . toStreamD

699+

700+-- | Deletes the first occurrence of the element in the stream that satisfies

701+-- the given equality predicate.

2155702--

2156−-- > words = wordsBy isSpace

703+-- @

704+-- > S.toList $ S.deleteBy (==) 3 $ S.fromList [1,3,3,5]

705+-- [1,3,5]

706+-- @

2157707--

2158−-- @since 0.7.0

708+-- @since 0.6.0

709+{-# INLINE deleteBy #-}

710+deleteBy :: (IsStream t, Monad m) => (a -> a -> Bool) -> a -> t m a -> t m a

711+deleteBy cmp x m = fromStreamS $ S.deleteBy cmp x (toStreamS m)

2159712

2160−-- It is equivalent to splitting in any of the infix/prefix/suffix styles

2161−-- followed by removal of empty segments.

2162−{-# INLINE wordsBy #-}

2163−wordsBy

2164− :: (IsStream t, Monad m)

2165− => (a -> Bool) -> Fold m a b -> t m a -> t m b

2166−wordsBy predicate f m =

2167− D.fromStreamD $ D.wordsBy predicate f (D.toStreamD m)

713+------------------------------------------------------------------------------

714+-- Trimming

715+------------------------------------------------------------------------------

2168716

2169−-- | Like 'splitOnSuffix' but keeps the suffix attached to the resulting

2170−-- splits.

717+-- | Same as 'takeWhile' but with a monadic predicate.

2171718--

2172−-- > splitWithSuffix' p xs = S.toList $ S.splitWithSuffix p (FL.toList) (S.fromList xs)

719+-- @since 0.4.0

720+{-# INLINE takeWhileM #-}

721+takeWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

722+takeWhileM p m = fromStreamD $ D.takeWhileM p $ toStreamD m

723+

724+-- | @takeByTime duration@ yields stream elements upto specified time

725+-- @duration@. The duration starts when the stream is evaluated for the first

726+-- time, before the first element is yielded. The time duration is checked

727+-- before generating each element, if the duration has expired the stream

728+-- stops.

2173729--

2174−-- >>> splitWithSuffix' (== '.') ""

2175−-- []

730+-- The total time taken in executing the stream is guaranteed to be /at least/

731+-- @duration@, however, because the duration is checked before generating an

732+-- element, the upper bound is indeterminate and depends on the time taken in

733+-- generating and processing the last element.

2176734--

2177−-- >>> splitWithSuffix' (== '.') "."

2178−-- ["."]

735+-- No element is yielded if the duration is zero. At least one element is

736+-- yielded if the duration is non-zero.

2179737--

2180−-- >>> splitWithSuffix' (== '.') "a"

2181−-- ["a"]

738+-- /Internal/

2182739--

2183−-- >>> splitWithSuffix' (== '.') ".a"

2184−-- > [".","a"]

740+{-# INLINE takeByTime #-}

741+takeByTime ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a

742+takeByTime d = fromStreamD . D.takeByTime d . toStreamD

743+

744+-- | Drop elements in the stream as long as the predicate succeeds and then

745+-- take the rest of the stream.

2185746--

2186−-- >>> splitWithSuffix' (== '.') "a."

2187−-- > ["a."]

747+-- @since 0.1.0

748+{-# INLINE dropWhile #-}

749+dropWhile :: (IsStream t, Monad m) => (a -> Bool) -> t m a -> t m a

750+dropWhile p m = fromStreamS $ S.dropWhile p $ toStreamS m

751+

752+-- | Same as 'dropWhile' but with a monadic predicate.

2188753--

2189−-- >>> splitWithSuffix' (== '.') "a.b"

2190−-- > ["a.","b"]

754+-- @since 0.4.0

755+{-# INLINE dropWhileM #-}

756+dropWhileM :: (IsStream t, Monad m) => (a -> m Bool) -> t m a -> t m a

757+dropWhileM p m = fromStreamD $ D.dropWhileM p $ toStreamD m

758+

759+-- | @dropByTime duration@ drops stream elements until specified @duration@ has

760+-- passed. The duration begins when the stream is evaluated for the first

761+-- time. The time duration is checked /after/ generating a stream element, the

762+-- element is yielded if the duration has expired otherwise it is dropped.

2191763--

2192−-- >>> splitWithSuffix' (== '.') "a.b."

2193−-- > ["a.","b."]

764+-- The time elapsed before starting to generate the first element is /at most/

765+-- @duration@, however, because the duration expiry is checked after the

766+-- element is generated, the lower bound is indeterminate and depends on the

767+-- time taken in generating an element.

2194768--

2195−-- >>> splitWithSuffix' (== '.') "a..b.."

2196−-- > ["a.",".","b.","."]

769+-- All elements are yielded if the duration is zero.

2197770--

2198−-- @since 0.7.0

2199−

2200−-- This can be considered as an n-fold version of 'breakPost' where we apply

2201−-- 'breakPost' successively on the input stream.

771+-- /Internal/

2202772--

2203−{-# INLINE splitWithSuffix #-}

2204−splitWithSuffix

2205− :: (IsStream t, Monad m)

2206− => (a -> Bool) -> Fold m a b -> t m a -> t m b

2207−splitWithSuffix predicate f m =

2208− D.fromStreamD $ D.foldMany1 (FL.sliceEndWith predicate f) (D.toStreamD m)

773+{-# INLINE dropByTime #-}

774+dropByTime ::(MonadIO m, IsStream t, TimeUnit64 d) => d -> t m a -> t m a

775+dropByTime d = fromStreamD . D.dropByTime d . toStreamD

2209776

2210777------------------------------------------------------------------------------

2211−-- Split on a delimiter sequence

778+-- Inserting Elements

2212779------------------------------------------------------------------------------

2213780

2214−-- Int list examples for splitOn:

2215−--

2216−-- >>> splitList [] [1,2,3,3,4]

2217−-- > [[1],[2],[3],[3],[4]]

2218−--

2219−-- >>> splitList [5] [1,2,3,3,4]

2220−-- > [[1,2,3,3,4]]

2221−--

2222−-- >>> splitList [1] [1,2,3,3,4]

2223−-- > [[],[2,3,3,4]]

2224−--

2225−-- >>> splitList [4] [1,2,3,3,4]

2226−-- > [[1,2,3,3],[]]

2227−--

2228−-- >>> splitList [2] [1,2,3,3,4]

2229−-- > [[1],[3,3,4]]

781+-- | @insertBy cmp elem stream@ inserts @elem@ before the first element in

782+-- @stream@ that is less than @elem@ when compared using @cmp@.

2230783--

2231−-- >>> splitList [3] [1,2,3,3,4]

2232−-- > [[1,2],[],[4]]

784+-- @

785+-- insertBy cmp x = 'mergeBy' cmp ('yield' x)

786+-- @

2233787--

2234−-- >>> splitList [3,3] [1,2,3,3,4]

2235−-- > [[1,2],[4]]

788+-- @

789+-- > S.toList $ S.insertBy compare 2 $ S.fromList [1,3,5]

790+-- [1,2,3,5]

791+-- @

2236792--

2237−-- >>> splitList [1,2,3,3,4] [1,2,3,3,4]

2238−-- > [[],[]]

793+-- @since 0.6.0

794+{-# INLINE insertBy #-}

795+insertBy ::

796+ (IsStream t, Monad m) => (a -> a -> Ordering) -> a -> t m a -> t m a

797+insertBy cmp x m = fromStreamS $ S.insertBy cmp x (toStreamS m)

2239798

2240−-- | Like 'splitOn' but the separator is a sequence of elements instead of a

2241−-- single element.

2242−--

2243−-- For illustration, let's define a function that operates on pure lists:

799+-- | Insert a pure value between successive elements of a stream.

2244800--

2245801-- @

2246−-- splitOnSeq' pat xs = S.toList $ S.splitOnSeq (A.fromList pat) (FL.toList) (S.fromList xs)

802+-- > S.toList $ S.intersperse ',' $ S.fromList "hello"

803+-- "h,e,l,l,o"

2247804-- @

2248805--

2249−-- >>> splitOnSeq' "" "hello"

2250−-- > ["h","e","l","l","o"]

2251−--

2252−-- >>> splitOnSeq' "hello" ""

2253−-- > [""]

2254−--

2255−-- >>> splitOnSeq' "hello" "hello"

2256−-- > ["",""]

2257−--

2258−-- >>> splitOnSeq' "x" "hello"

2259−-- > ["hello"]

2260−--

2261−-- >>> splitOnSeq' "h" "hello"

2262−-- > ["","ello"]

2263−--

2264−-- >>> splitOnSeq' "o" "hello"

2265−-- > ["hell",""]

2266−--

2267−-- >>> splitOnSeq' "e" "hello"

2268−-- > ["h","llo"]

2269−--

2270−-- >>> splitOnSeq' "l" "hello"

2271−-- > ["he","","o"]

2272−--

2273−-- >>> splitOnSeq' "ll" "hello"

2274−-- > ["he","o"]

2275−--

2276−-- 'splitOnSeq' is an inverse of 'intercalate'. The following law always holds:

2277−--

2278−-- > intercalate . splitOn == id

2279−--

2280−-- The following law holds when the separator is non-empty and contains none of

2281−-- the elements present in the input lists:

2282−--

2283−-- > splitOn . intercalate == id

2284−--

2285−-- /Internal/

2286−

2287−-- XXX We can use a polymorphic vector implemented by Array# to represent the

2288−-- sequence, that way we can avoid the Storable constraint. If we still need

2289−-- Storable Array for performance, we can use a separate splitOnArray API for

2290−-- that. We can also have an API where the sequence itself is a lazy stream, so

2291−-- that we can search files in files for example.

2292−{-# INLINE splitOnSeq #-}

2293−splitOnSeq

2294− :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

2295− => Array a -> Fold m a b -> t m a -> t m b

2296−splitOnSeq patt f m = D.fromStreamD $ D.splitOnSeq patt f (D.toStreamD m)

2297−

2298−{-

2299−-- This can be implemented easily using Rabin Karp

2300−-- | Split on any one of the given patterns.

2301−{-# INLINE splitOnAny #-}

2302−splitOnAny

2303− :: (IsStream t, Monad m, Storable a, Integral a)

2304− => [Array a] -> Fold m a b -> t m a -> t m b

2305−splitOnAny subseq f m = undefined -- D.fromStreamD $ D.splitOnAny f subseq (D.toStreamD m)

2306−-}

806+-- @since 0.7.0

807+{-# INLINE intersperse #-}

808+intersperse :: (IsStream t, MonadAsync m) => a -> t m a -> t m a

809+intersperse a = fromStreamS . S.intersperse a . toStreamS

2307810

2308−-- | Like 'splitSuffixBy' but the separator is a sequence of elements, instead

2309−-- of a predicate for a single element.

2310−--

2311−-- > splitOnSuffixSeq_ pat xs = S.toList $ S.splitOnSuffixSeq (A.fromList pat) (FL.toList) (S.fromList xs)

2312−--

2313−-- >>> splitOnSuffixSeq_ "." ""

2314−-- []

2315−--

2316−-- >>> splitOnSuffixSeq_ "." "."

2317−-- [""]

2318−--

2319−-- >>> splitOnSuffixSeq_ "." "a"

2320−-- ["a"]

2321−--

2322−-- >>> splitOnSuffixSeq_ "." ".a"

2323−-- > ["","a"]

2324−--

2325−-- >>> splitOnSuffixSeq_ "." "a."

2326−-- > ["a"]

2327−--

2328−-- >>> splitOnSuffixSeq_ "." "a.b"

2329−-- > ["a","b"]

2330−--

2331−-- >>> splitOnSuffixSeq_ "." "a.b."

2332−-- > ["a","b"]

2333−--

2334−-- >>> splitOnSuffixSeq_ "." "a..b.."

2335−-- > ["a","","b",""]

2336−--

2337−-- > lines = splitOnSuffixSeq "\n"

2338−--

2339−-- 'splitOnSuffixSeq' is an inverse of 'intercalateSuffix'. The following law

2340−-- always holds:

2341−--

2342−-- > intercalateSuffix . splitOnSuffixSeq == id

2343−--

2344−-- The following law holds when the separator is non-empty and contains none of

2345−-- the elements present in the input lists:

811+-- | Insert a side effect before consuming an element of a stream except the

812+-- first one.

2346813--

2347−-- > splitSuffixOn . intercalateSuffix == id

814+-- @

815+-- >>> S.drain $ S.trace putChar $ S.intersperseM_ (putChar '.') $ S.fromList "hello"

816+-- > h.e.l.l.o

817+-- @

2348818--

2349819-- /Internal/

2350−{-# INLINE splitOnSuffixSeq #-}

2351−splitOnSuffixSeq

2352− :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

2353− => Array a -> Fold m a b -> t m a -> t m b

2354−splitOnSuffixSeq patt f m =

2355− D.fromStreamD $ D.splitOnSuffixSeq False patt f (D.toStreamD m)

820+{-# INLINE intersperseM_ #-}

821+intersperseM_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

822+intersperseM_ m = fromStreamD . D.intersperseM_ m . toStreamD

2356823

2357824{-

2358−-- | Like 'splitOn' but drops any empty splits.

825+-- | Intersperse a monadic action into the input stream after every @n@

826+-- elements.

827+--

828+-- @

829+-- > S.toList $ S.intersperseBySpan 2 (return ',') $ S.fromList "hello"

830+-- "he,ll,o"

831+-- @

2359832--

2360−{-# INLINE wordsOn #-}

2361−wordsOn

2362− :: (IsStream t, Monad m, Storable a, Eq a)

2363− => Array a -> Fold m a b -> t m a -> t m b

2364−wordsOn subseq f m = undefined -- D.fromStreamD $ D.wordsOn f subseq (D.toStreamD m)

833+-- @since 0.7.0

834+{-# INLINE intersperseBySpan #-}

835+intersperseBySpan :: IsStream t => Int -> m a -> t m a -> t m a

836+intersperseBySpan _n _f _xs = undefined

2365837-}

2366838

2367−-- | Like 'splitOnSuffixSeq' but keeps the suffix intact in the splits.

2368−--

2369−-- > splitWithSuffixSeq'_ pat xs = S.toList $ S.splitWithSuffixSeq (A.fromList pat) (FL.toList) (S.fromList xs)

2370−--

2371−-- >>> splitWithSuffixSeq' "." ""

2372−-- [""]

2373−--

2374−-- >>> splitWithSuffixSeq' "." "."

2375−-- ["."]

839+-- | Insert an effect and its output after consuming an element of a stream.

2376840--

2377−-- >>> splitWithSuffixSeq' "." "a"

2378−-- ["a"]

841+-- @

842+-- >>> S.toList $ S.trace putChar $ S.intersperseSuffix (putChar '.' >> return ',') $ S.fromList "hello"

843+-- > h.,e.,l.,l.,o.,"h,e,l,l,o,"

844+-- @

2379845--

2380−-- >>> splitWithSuffixSeq' "." ".a"

2381−-- > [".","a"]

846+-- /Internal/

847+{-# INLINE intersperseSuffix #-}

848+intersperseSuffix :: (IsStream t, MonadAsync m) => m a -> t m a -> t m a

849+intersperseSuffix m = fromStreamD . D.intersperseSuffix m . toStreamD

850+

851+-- | Insert a side effect after consuming an element of a stream.

2382852--

2383−-- >>> splitWithSuffixSeq' "." "a."

2384−-- > ["a."]

853+-- @

854+-- > S.mapM_ putChar $ S.intersperseSuffix_ (threadDelay 1000000) $ S.fromList "hello"

855+-- @

2385856--

2386−-- >>> splitWithSuffixSeq' "." "a.b"

2387−-- > ["a.","b"]

857+-- /Internal/

2388858--

2389−-- >>> splitWithSuffixSeq' "." "a.b."

2390−-- > ["a.","b."]

859+{-# INLINE intersperseSuffix_ #-}

860+intersperseSuffix_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

861+intersperseSuffix_ m = fromStreamD . D.intersperseSuffix_ m . toStreamD

862+

863+-- | Like 'intersperseSuffix' but intersperses an effectful action into the

864+-- input stream after every @n@ elements and after the last element.

2391865--

2392−-- >>> splitWithSuffixSeq' "." "a..b.."

2393−-- > ["a.",".","b.","."]

866+-- @

867+-- > S.toList $ S.intersperseSuffixBySpan 2 (return ',') $ S.fromList "hello"

868+-- "he,ll,o,"

869+-- @

2394870--

2395871-- /Internal/

2396−{-# INLINE splitWithSuffixSeq #-}

2397−splitWithSuffixSeq

2398− :: (IsStream t, MonadIO m, Storable a, Enum a, Eq a)

2399− => Array a -> Fold m a b -> t m a -> t m b

2400−splitWithSuffixSeq patt f m =

2401− D.fromStreamD $ D.splitOnSuffixSeq True patt f (D.toStreamD m)

2402−

2403−{-

2404−-- This can be implemented easily using Rabin Karp

2405−-- | Split post any one of the given patterns.

2406−{-# INLINE splitOnSuffixSeqAny #-}

2407−splitOnSuffixSeqAny

2408− :: (IsStream t, Monad m, Storable a, Integral a)

2409− => [Array a] -> Fold m a b -> t m a -> t m b

2410−splitOnSuffixSeqAny subseq f m = undefined

2411− -- D.fromStreamD $ D.splitPostAny f subseq (D.toStreamD m)

2412−-}

2413−

2414−------------------------------------------------------------------------------

2415−-- Nested Split

2416−------------------------------------------------------------------------------

872+--

873+{-# INLINE intersperseSuffixBySpan #-}

874+intersperseSuffixBySpan :: (IsStream t, MonadAsync m)

875+ => Int -> m a -> t m a -> t m a

876+intersperseSuffixBySpan n eff =

877+ fromStreamD . D.intersperseSuffixBySpan n eff . toStreamD

2417878

2418−-- | @splitInnerBy splitter joiner stream@ splits the inner containers @f a@ of

2419−-- an input stream @t m (f a)@ using the @splitter@ function. Container

2420−-- elements @f a@ are collected until a split occurs, then all the elements

2421−-- before the split are joined using the @joiner@ function.

879+-- | Insert a side effect before consuming an element of a stream.

880+--

881+-- @

882+-- >>> S.toList $ S.trace putChar $ S.interspersePrefix_ (putChar '.' >> return ',') $ S.fromList "hello"

883+-- > .h.e.l.l.o"hello"

884+-- @

2422885--

2423−-- For example, if we have a stream of @Array Word8@, we may want to split the

2424−-- stream into arrays representing lines separated by '\n' byte such that the

2425−-- resulting stream after a split would be one array for each line.

886+-- See also: 'trace_'

2426887--

2427−-- CAUTION! This is not a true streaming function as the container size after

2428−-- the split and merge may not be bounded.

888+-- /Concurrent/

2429889--

2430890-- /Internal/

2431−{-# INLINE splitInnerBy #-}

2432−splitInnerBy

2433− :: (IsStream t, Monad m)

2434− => (f a -> m (f a, Maybe (f a))) -- splitter

2435− -> (f a -> f a -> m (f a)) -- joiner

2436− -> t m (f a)

2437− -> t m (f a)

2438−splitInnerBy splitter joiner xs =

2439− D.fromStreamD $ D.splitInnerBy splitter joiner $ D.toStreamD xs

2440−

2441−-- | Like 'splitInnerBy' but splits assuming the separator joins the segment in

2442−-- a suffix style.

2443891--

2444−-- /Internal/

2445−{-# INLINE splitInnerBySuffix #-}

2446−splitInnerBySuffix

2447− :: (IsStream t, Monad m, Eq (f a), Monoid (f a))

2448− => (f a -> m (f a, Maybe (f a))) -- splitter

2449− -> (f a -> f a -> m (f a)) -- joiner

2450− -> t m (f a)

2451− -> t m (f a)

2452−splitInnerBySuffix splitter joiner xs =

2453− D.fromStreamD $ D.splitInnerBySuffix splitter joiner $ D.toStreamD xs

2454−

2455−------------------------------------------------------------------------------

2456−-- Reorder in sequence

2457−------------------------------------------------------------------------------

2458−

2459−{-

2460−-- Buffer until the next element in sequence arrives. The function argument

2461−-- determines the difference in sequence numbers. This could be useful in

2462−-- implementing sequenced streams, for example, TCP reassembly.

2463−{-# INLINE reassembleBy #-}

2464−reassembleBy

2465− :: (IsStream t, Monad m)

2466− => Fold m a b

2467− -> (a -> a -> Int)

2468− -> t m a

2469− -> t m b

2470−reassembleBy = undefined

2471−-}

892+{-# INLINE interspersePrefix_ #-}

893+interspersePrefix_ :: (IsStream t, MonadAsync m) => m b -> t m a -> t m a

894+interspersePrefix_ m = mapM (\x -> void m >> return x)

2472895

2473896------------------------------------------------------------------------------

2474−-- Distributing

897+-- Inserting Time

2475898------------------------------------------------------------------------------

2476899

2477−-- | Tap the data flowing through a stream into a 'Fold'. For example, you may

2478−-- add a tap to log the contents flowing through the stream. The fold is used

2479−-- only for effects, its result is discarded.

2480−--

2481−-- @

2482−-- Fold m a b

2483−-- |

2484−-- -----stream m a ---------------stream m a-----

900+-- Note: delay must be serial.

2485901--

2486−-- @

902+-- | Introduce a delay of specified seconds before consuming an element of the

903+-- stream except the first one.

2487904--

2488905-- @

2489−-- > S.drain $ S.tap (FL.drainBy print) (S.enumerateFromTo 1 2)

2490−-- 1

2491−-- 2

906+-- >>> S.mapM_ print $ S.timestamped $ S.delay 1 $ S.enumerateFromTo 1 3

907+-- > (AbsTime (TimeSpec {sec = 2502706, nsec = 751137000}),1)

908+-- > (AbsTime (TimeSpec {sec = 2502707, nsec = 743535000}),2)

909+-- > (AbsTime (TimeSpec {sec = 2502708, nsec = 749758000}),3)

2492910-- @

2493911--

2494−-- Compare with 'trace'.

912+-- /Internal/

2495913--

2496−-- @since 0.7.0

2497−{-# INLINE tap #-}

2498−tap :: (IsStream t, Monad m) => FL.Fold m a b -> t m a -> t m a

2499−tap f xs = D.fromStreamD $ D.tap f (D.toStreamD xs)

914+{-# INLINE delay #-}

915+delay :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

916+delay n = intersperseM_ $ liftIO $ threadDelay $ round $ n * 1000000

2500917

2501−-- | @tapOffsetEvery offset n@ taps every @n@th element in the stream

2502−-- starting at @offset@. @offset@ can be between @0@ and @n - 1@. Offset 0

2503−-- means start at the first element in the stream. If the offset is outside

2504−-- this range then @offset `mod` n@ is used as offset.

918+-- Note: delay must be serial.

919+--

920+-- | Introduce a delay of specified seconds after consuming an element of a

921+-- stream.

2505922--

2506923-- @

2507−-- >>> S.drain $ S.tapOffsetEvery 0 2 (FL.mapM print FL.toList) $ S.enumerateFromTo 0 10

2508−-- > [0,2,4,6,8,10]

924+-- >>> S.mapM_ print $ S.timestamped $ S.delayPost 1 $ S.enumerateFromTo 1 3

925+-- > (AbsTime (TimeSpec {sec = 2502826, nsec = 119030000}),1)

926+-- > (AbsTime (TimeSpec {sec = 2502827, nsec = 111393000}),2)

927+-- > (AbsTime (TimeSpec {sec = 2502828, nsec = 112221000}),3)

2509928-- @

2510929--

2511930-- /Internal/

2512931--

2513−{-# INLINE tapOffsetEvery #-}

2514−tapOffsetEvery :: (IsStream t, Monad m)

2515− => Int -> Int -> FL.Fold m a b -> t m a -> t m a

2516−tapOffsetEvery offset n f xs =

2517− D.fromStreamD $ D.tapOffsetEvery offset n f (D.toStreamD xs)

932+{-# INLINE delayPost #-}

933+delayPost :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

934+delayPost n = intersperseSuffix_ $ liftIO $ threadDelay $ round $ n * 1000000

2518935

2519−-- | Redirect a copy of the stream to a supplied fold and run it concurrently

2520−-- in an independent thread. The fold may buffer some elements. The buffer size

2521−-- is determined by the prevailing 'maxBuffer' setting.

2522−--

2523−-- @

2524−-- Stream m a -> m b

2525−-- |

2526−-- -----stream m a ---------------stream m a-----

936+-- Note: delay must be serial, that's why 'trace_' is used.

2527937--

2528−-- @

938+-- | Introduce a delay of specified seconds before consuming an element of a

939+-- stream.

2529940--

2530941-- @

2531−-- > S.drain $ S.tapAsync (S.mapM_ print) (S.enumerateFromTo 1 2)

2532−-- 1

2533−-- 2

942+-- >>> S.mapM_ print $ S.timestamped $ S.delayPre 1 $ S.enumerateFromTo 1 3

943+-- > (AbsTime (TimeSpec {sec = 2502207, nsec = 533177000}),1)

944+-- > (AbsTime (TimeSpec {sec = 2502208, nsec = 530859000}),2)

945+-- > (AbsTime (TimeSpec {sec = 2502209, nsec = 531619000}),3)

2534946-- @

2535947--

2536−-- Exceptions from the concurrently running fold are propagated to the current

2537−-- computation. Note that, because of buffering in the fold, exceptions may be

2538−-- delayed and may not correspond to the current element being processed in the

2539−-- parent stream, but we guarantee that before the parent stream stops the tap

2540−-- finishes and all exceptions from it are drained.

948+-- /Internal/

2541949--

950+{-# INLINE delayPre #-}

951+delayPre :: (IsStream t, MonadIO m) => Double -> t m a -> t m a

952+delayPre n = trace_ $ liftIO $ threadDelay $ round $ n * 1000000

953+

954+------------------------------------------------------------------------------

955+-- Reorder in sequence

956+------------------------------------------------------------------------------

957+

958+-- | Buffer until the next element in sequence arrives. The function argument

959+-- determines the difference in sequence numbers. This could be useful in

960+-- implementing sequenced streams, for example, TCP reassembly.

2542961--

2543−-- Compare with 'tap'.

962+-- /Unimplemented/

2544963--

2545−-- /Internal/

2546−{-# INLINE tapAsync #-}

2547−tapAsync :: (IsStream t, MonadAsync m) => FL.Fold m a b -> t m a -> t m a

2548−tapAsync f xs = D.fromStreamD $ D.tapAsync f (D.toStreamD xs)

2549−

2550−-- | @pollCounts predicate transform fold stream@ counts those elements in the

2551−-- stream that pass the @predicate@. The resulting count stream is sent to

2552−-- another thread which transforms it using @transform@ and then folds it using

2553−-- @fold@. The thread is automatically cleaned up if the stream stops or

2554−-- aborts due to exception.

964+{-# INLINE reassembleBy #-}

965+reassembleBy

966+ :: -- (IsStream t, Monad m) =>

967+ Fold m a b

968+ -> (a -> a -> Int)

969+ -> t m a

970+ -> t m b

971+reassembleBy = undefined

972+

973+------------------------------------------------------------------------------

974+-- Position Indexing

975+------------------------------------------------------------------------------

976+

977+-- |

978+-- > indexed = S.postscanl' (\(i, _) x -> (i + 1, x)) (-1,undefined)

979+-- > indexed = S.zipWith (,) (S.enumerateFrom 0)

2555980--

2556−-- For example, to print the count of elements processed every second:

981+-- Pair each element in a stream with its index, starting from index 0.

2557982--

2558983-- @

2559−-- > S.drain $ S.pollCounts (const True) (S.rollingMap (-) . S.delayPost 1) (FL.drainBy print)

2560−-- $ S.enumerateFrom 0

984+-- > S.toList $ S.indexed $ S.fromList "hello"

985+-- [(0,'h'),(1,'e'),(2,'l'),(3,'l'),(4,'o')]

2561986-- @

2562987--

2563−-- Note: This may not work correctly on 32-bit machines.

988+-- @since 0.6.0

989+{-# INLINE indexed #-}

990+indexed :: (IsStream t, Monad m) => t m a -> t m (Int, a)

991+indexed = fromStreamD . D.indexed . toStreamD

992+

993+-- |

994+-- > indexedR n = S.postscanl' (\(i, _) x -> (i - 1, x)) (n + 1,undefined)

995+-- > indexedR n = S.zipWith (,) (S.enumerateFromThen n (n - 1))

2564996--

2565−-- /Internal/

997+-- Pair each element in a stream with its index, starting from the

998+-- given index @n@ and counting down.

2566999--

2567−{-# INLINE pollCounts #-}

2568−pollCounts ::

2569− (IsStream t, MonadAsync m)

2570− => (a -> Bool)

2571− -> (t m Int -> t m Int)

2572− -> Fold m Int b

2573− -> t m a

2574− -> t m a

2575−pollCounts predicate transf f xs =

2576− D.fromStreamD

2577− $ D.pollCounts predicate (D.toStreamD . transf . D.fromStreamD) f

2578− $ D.toStreamD xs

1000+-- @

1001+-- > S.toList $ S.indexedR 10 $ S.fromList "hello"

1002+-- [(10,'h'),(9,'e'),(8,'l'),(7,'l'),(6,'o')]

1003+-- @

1004+--

1005+-- @since 0.6.0

1006+{-# INLINE indexedR #-}

1007+indexedR :: (IsStream t, Monad m) => Int -> t m a -> t m (Int, a)

1008+indexedR n = fromStreamD . D.indexedR n . toStreamD

25791009

2580−-- | Calls the supplied function with the number of elements consumed

2581−-- every @n@ seconds. The given function is run in a separate thread

2582−-- until the end of the stream. In case there is an exception in the

2583−-- stream the thread is killed during the next major GC.

1010+-------------------------------------------------------------------------------

1011+-- Time Indexing

1012+-------------------------------------------------------------------------------

1013+

1014+-- Note: The timestamp stream must be the second stream in the zip so that the

1015+-- timestamp is generated after generating the stream element and not before.

1016+-- If we do not do that then the following example will generate the same

1017+-- timestamp for first two elements:

25841018--

2585−-- Note: The action is not guaranteed to run if the main thread exits.

1019+-- S.mapM_ print $ S.timestamped $ S.delay $ S.enumerateFromTo 1 3

1020+--

1021+-- | Pair each element in a stream with an absolute timestamp, using a clock of

1022+-- specified granularity. The timestamp is generated just before the element

1023+-- is consumed.

25861024--

25871025-- @

2588−-- > delay n = threadDelay (round $ n * 1000000) >> return n

2589−-- > S.drain $ S.tapRate 2 (\\n -> print $ show n ++ " elements processed") (delay 1 S.|: delay 0.5 S.|: delay 0.5 S.|: S.nil)

2590−-- 2 elements processed

2591−-- 1 elements processed

1026+-- >>> S.mapM_ print $ S.timestampWith 0.01 $ S.delay 1 $ S.enumerateFromTo 1 3

25921027-- @

25931028--

2594−-- Note: This may not work correctly on 32-bit machines.

1029+-- /Internal/

1030+--

1031+{-# INLINE timestampWith #-}

1032+timestampWith :: (IsStream t, MonadAsync m, Functor (t m))

1033+ => Double -> t m a -> t m (AbsTime, a)

1034+timestampWith g stream = Z.zipWith (flip (,)) stream (absTimesWith g)

1035+

1036+-- TBD: check performance vs a custom implementation without using zipWith.

25951037--

25961038-- /Internal/

2597−{-# INLINE tapRate #-}

2598−tapRate ::

2599− (IsStream t, MonadAsync m, MonadCatch m)

2600− => Double

2601− -> (Int -> m b)

2602− -> t m a

2603− -> t m a

2604−tapRate n f xs = D.fromStreamD $ D.tapRate n f $ D.toStreamD xs

1039+--

1040+{-# INLINE timestamped #-}

1041+timestamped :: (IsStream t, MonadAsync m, Functor (t m))

1042+ => t m a -> t m (AbsTime, a)

1043+timestamped = timestampWith 0.01

26051044

2606−-- | Apply a monadic function to each element flowing through the stream and

2607−-- discard the results.

1045+-- | Pair each element in a stream with relative times starting from 0, using a

1046+-- clock with the specified granularity. The time is measured just before the

1047+-- element is consumed.

26081048--

26091049-- @

2610−-- > S.drain $ S.trace print (S.enumerateFromTo 1 2)

2611−-- 1

2612−-- 2

1050+-- >>> S.mapM_ print $ S.timeIndexWith 0.01 $ S.delay 1 $ S.enumerateFromTo 1 3

26131051-- @

26141052--

2615−-- Compare with 'tap'.

1053+-- /Internal/

26161054--

2617−-- @since 0.7.0

2618−{-# INLINE trace #-}

2619−trace :: (IsStream t, MonadAsync m) => (a -> m b) -> t m a -> t m a

2620−trace f = mapM (\x -> void (f x) >> return x)

1055+{-# INLINE timeIndexWith #-}

1056+timeIndexWith :: (IsStream t, MonadAsync m, Functor (t m))

1057+ => Double -> t m a -> t m (RelTime64, a)

1058+timeIndexWith g stream = Z.zipWith (flip (,)) stream (relTimesWith g)

26211059

2622−-- | Perform a side effect before yielding each element of the stream and

2623−-- discard the results.

1060+-- | Pair each element in a stream with relative times starting from 0, using a

1061+-- 10 ms granularity clock. The time is measured just before the element is

1062+-- consumed.

26241063--

26251064-- @

2626−-- > S.drain $ S.trace_ (print "got here") (S.enumerateFromTo 1 2)

2627−-- "got here"

2628−-- "got here"

1065+-- >>> S.mapM_ print $ S.timeIndexed $ S.delay 1 $ S.enumerateFromTo 1 3

1066+-- (RelTime64 (NanoSecond64 0),1)

1067+-- (RelTime64 (NanoSecond64 996239000),2)

1068+-- (RelTime64 (NanoSecond64 1996712000),3)

26291069-- @

26301070--

2631−-- See also: 'trace', 'interspersePrefix_'

2632−--

26331071-- /Internal/

2634−{-# INLINE trace_ #-}

2635−trace_ :: (IsStream t, Monad m) => m b -> t m a -> t m a

2636−trace_ eff = Serial.mapM (\x -> eff >> return x)

1072+--

1073+{-# INLINE timeIndexed #-}

1074+timeIndexed :: (IsStream t, MonadAsync m, Functor (t m))

1075+ => t m a -> t m (RelTime64, a)

1076+timeIndexed = timeIndexWith 0.01

26371077

26381078------------------------------------------------------------------------------

2639−-- Folding transformations

1079+-- Searching

26401080------------------------------------------------------------------------------

26411081

2642−-- | Right fold to a streaming monad.

2643−--

2644−-- > foldrS S.cons S.nil === id

2645−--

2646−-- 'foldrS' can be used to perform stateless stream to stream transformations

2647−-- like map and filter in general. It can be coupled with a scan to perform

2648−-- stateful transformations. However, note that the custom map and filter

2649−-- routines can be much more efficient than this due to better stream fusion.

2650−--

2651−-- >>> S.toList $ S.foldrS S.cons S.nil $ S.fromList [1..5]

2652−-- > [1,2,3,4,5]

2653−--

2654−-- Find if any element in the stream is 'True':

2655−--

2656−-- >>> S.toList $ S.foldrS (\x xs -> if odd x then return True else xs) (return False) $ (S.fromList (2:4:5:undefined) :: SerialT IO Int)

2657−-- > [True]

1082+-- | Find all the indices where the value of the element in the stream is equal

1083+-- to the given value.

26581084--

2659−-- Map (+2) on odd elements and filter out the even elements:

1085+-- > elemIndices a = findIndices (== a)

26601086--

2661−-- >>> S.toList $ S.foldrS (\x xs -> if odd x then (x + 2) `S.cons` xs else xs) S.nil $ (S.fromList [1..5] :: SerialT IO Int)

2662−-- > [3,5,7]

1087+-- @since 0.5.0

1088+{-# INLINE elemIndices #-}

1089+elemIndices :: (IsStream t, Eq a, Monad m) => a -> t m a -> t m Int

1090+elemIndices a = findIndices (== a)

1091+

1092+------------------------------------------------------------------------------

1093+-- Rolling map

1094+------------------------------------------------------------------------------

1095+

1096+-- XXX this is not a one-to-one map so calling it map may not be right.

1097+-- We can perhaps call it zipWithTail or rollWith.

26631098--

2664−-- 'foldrM' can also be represented in terms of 'foldrS', however, the former

2665−-- is much more efficient:

1099+-- | Apply a function on every two successive elements of a stream. If the

1100+-- stream consists of a single element the output is an empty stream.

26661101--

2667−-- > foldrM f z s = runIdentityT $ foldrS (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s

1102+-- This is the stream equivalent of the list idiom @zipWith f xs (tail xs)@.

26681103--

26691104-- /Internal/

2670−{-# INLINE foldrS #-}

2671−foldrS :: IsStream t => (a -> t m b -> t m b) -> t m b -> t m a -> t m b

2672−foldrS = K.foldrS

2673−

2674−-- | Right fold to a transformer monad. This is the most general right fold

2675−-- function. 'foldrS' is a special case of 'foldrT', however 'foldrS'

2676−-- implementation can be more efficient:

2677−--

2678−-- > foldrS = foldrT

2679−-- > foldrM f z s = runIdentityT $ foldrT (\x xs -> lift $ f x (runIdentityT xs)) (lift z) s

26801105--

2681−-- 'foldrT' can be used to translate streamly streams to other transformer

2682−-- monads e.g. to a different streaming type.

1106+{-# INLINE rollingMap #-}

1107+rollingMap :: (IsStream t, Monad m) => (a -> a -> b) -> t m a -> t m b

1108+rollingMap f m = fromStreamD $ D.rollingMap f $ toStreamD m

1109+

1110+-- | Like 'rollingMap' but with an effectful map function.

26831111--

26841112-- /Internal/

2685−{-# INLINE foldrT #-}

2686−foldrT :: (IsStream t, Monad m, Monad (s m), MonadTrans s)

2687− => (a -> s m b -> s m b) -> s m b -> t m a -> s m b

2688−foldrT f z s = S.foldrT f z (toStreamS s)

1113+--

1114+{-# INLINE rollingMapM #-}

1115+rollingMapM :: (IsStream t, Monad m) => (a -> a -> m b) -> t m a -> t m b

1116+rollingMapM f m = fromStreamD $ D.rollingMapM f $ toStreamD m

26891117

26901118------------------------------------------------------------------------------

2691−-- Generalize the underlying monad

1119+-- Maybe Streams

26921120------------------------------------------------------------------------------

26931121

2694−-- | Transform the inner monad of a stream using a natural transformation.

1122+-- | Map a 'Maybe' returning function to a stream, filter out the 'Nothing'

1123+-- elements, and return a stream of values extracted from 'Just'.

1124+--

1125+-- Equivalent to:

26951126--

2696−-- / Internal/

1127+-- @

1128+-- mapMaybe f = S.map 'fromJust' . S.filter 'isJust' . S.map f

1129+-- @

26971130--

2698−{-# INLINE hoist #-}

2699−hoist :: (Monad m, Monad n)

2700− => (forall x. m x -> n x) -> SerialT m a -> SerialT n a

2701−hoist f xs = fromStreamS $ S.hoist f (toStreamS xs)

1131+-- @since 0.3.0

1132+{-# INLINE mapMaybe #-}

1133+mapMaybe :: (IsStream t, Monad m) => (a -> Maybe b) -> t m a -> t m b

1134+mapMaybe f m = fromStreamS $ S.mapMaybe f $ toStreamS m

27021135

2703−-- | Generalize the inner monad of the stream from 'Identity' to any monad.

1136+-- | Like 'mapMaybe' but maps a monadic function.

1137+--

1138+-- Equivalent to:

1139+--

1140+-- @

1141+-- mapMaybeM f = S.map 'fromJust' . S.filter 'isJust' . S.mapM f

1142+-- @

27041143--

2705−-- / Internal/

1144+-- /Concurrent (do not use with 'parallely' on infinite streams)/

27061145--

2707−{-# INLINE generally #-}

2708−generally :: (IsStream t, Monad m) => t Identity a -> t m a

2709−generally xs = fromStreamS $ S.hoist (return . runIdentity) (toStreamS xs)

1146+-- @since 0.3.0

1147+{-# INLINE_EARLY mapMaybeM #-}

1148+mapMaybeM :: (IsStream t, MonadAsync m, Functor (t m))

1149+ => (a -> m (Maybe b)) -> t m a -> t m b

1150+mapMaybeM f = fmap fromJust . filter isJust . K.mapM f

27101151

2711−------------------------------------------------------------------------------

2712−-- Add and remove a monad transformer

2713−------------------------------------------------------------------------------

1152+{-# RULES "mapMaybeM serial" mapMaybeM = mapMaybeMSerial #-}

1153+{-# INLINE mapMaybeMSerial #-}

1154+mapMaybeMSerial :: Monad m => (a -> m (Maybe b)) -> SerialT m a -> SerialT m b

1155+mapMaybeMSerial f m = fromStreamD $ D.mapMaybeM f $ toStreamD m

27141156

2715−-- | Lift the inner monad @m@ of a stream @t m a@ to @tr m@ using the monad

2716−-- transformer @tr@.

1157+-- | In a stream of 'Maybe's, discard 'Nothing's and unwrap 'Just's.

27171158--

2718−-- / Internal/

1159+-- /Internal/

27191160--

2720−{-# INLINE liftInner #-}

2721−liftInner :: (Monad m, IsStream t, MonadTrans tr, Monad (tr m))

2722− => t m a -> t (tr m) a

2723−liftInner xs = fromStreamD $ D.liftInner (toStreamD xs)

1161+catMaybes :: (IsStream t, Monad m, Functor (t m)) => t m (Maybe a) -> t m a

1162+catMaybes = fmap fromJust . filter isJust

27241163

27251164------------------------------------------------------------------------------

2726−-- Sharing read only state in a stream

1165+-- Either streams

27271166------------------------------------------------------------------------------

27281167

2729−-- | Evaluate the inner monad of a stream as 'ReaderT'.

1168+-- | Discard 'Right's and unwrap 'Left's in an 'Either' stream.

27301169--

2731−-- / Internal/

1170+-- /Internal/

27321171--

2733−{-# INLINE runReaderT #-}

2734−runReaderT :: (IsStream t, Monad m) => m s -> t (ReaderT s m) a -> t m a

2735−runReaderT s xs = fromStreamD $ D.runReaderT s (toStreamD xs)

1172+lefts :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m a

1173+lefts = fmap (fromLeft undefined) . filter isLeft

27361174

2737−-- | Run a stream transformation using a given environment.

2738−--

2739−-- See also: 'Serial.map'

1175+-- | Discard 'Left's and unwrap 'Right's in an 'Either' stream.

27401176--

2741−-- / Internal/

1177+-- /Internal/

27421178--

2743−{-# INLINE usingReaderT #-}

2744−usingReaderT

2745− :: (Monad m, IsStream t)

2746− => m r

2747− -> (t (ReaderT r m) a -> t (ReaderT r m) a)

2748− -> t m a

2749− -> t m a

2750−usingReaderT r f xs = runReaderT r $ f $ liftInner xs

1179+rights :: (IsStream t, Monad m, Functor (t m)) => t m (Either a b) -> t m b

1180+rights = fmap (fromRight undefined) . filter isRight

27511181

27521182------------------------------------------------------------------------------

2753−-- Sharing read write state in a stream

1183+-- Concurrent Application

27541184------------------------------------------------------------------------------

27551185

2756−-- | Evaluate the inner monad of a stream as 'StateT'.

1186+-- | Parallel transform application operator; applies a stream transformation

1187+-- function @t m a -> t m b@ to a stream @t m a@ concurrently; the input stream

1188+-- is evaluated asynchronously in an independent thread yielding elements to a

1189+-- buffer and the transformation function runs in another thread consuming the

1190+-- input from the buffer. '|$' is just like regular function application

1191+-- operator '$' except that it is concurrent.

27571192--

2758−-- This is supported only for 'SerialT' as concurrent state updation may not be

2759−-- safe.

1193+-- If you read the signature as @(t m a -> t m b) -> (t m a -> t m b)@ you can

1194+-- look at it as a transformation that converts a transform function to a

1195+-- buffered concurrent transform function.

27601196--

2761−-- / Internal/

1197+-- The following code prints a value every second even though each stage adds a

1198+-- 1 second delay.

27621199--

2763−{-# INLINE evalStateT #-}

2764−evalStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m a

2765−evalStateT s xs = fromStreamD $ D.evalStateT s (toStreamD xs)

2766−

2767−-- | Run a stateful (StateT) stream transformation using a given state.

27681200--

2769−-- This is supported only for 'SerialT' as concurrent state updation may not be

2770−-- safe.

1201+-- @

1202+-- drain $

1203+-- S.mapM (\\x -> threadDelay 1000000 >> print x)

1204+-- |$ S.repeatM (threadDelay 1000000 >> return 1)

1205+-- @

1206+--

1207+-- /Concurrent/

1208+--

1209+-- /Since: 0.3.0 ("Streamly")/

27711210--

2772−-- See also: 'scanl''

1211+-- @since 0.8.0

1212+{-# INLINE (|$) #-}

1213+(|$) :: (IsStream t, MonadAsync m) => (t m a -> t m b) -> (t m a -> t m b)

1214+-- (|$) f = f . Async.mkAsync

1215+(|$) f = f . D.mkParallel

1216+

1217+infixr 0 |$

1218+

1219+-- | Same as '|$'.

27731220--

2774−-- / Internal/

1221+-- /Internal/

27751222--

2776−{-# INLINE usingStateT #-}

2777−usingStateT

2778− :: Monad m

2779− => m s

2780− -> (SerialT (StateT s m) a -> SerialT (StateT s m) a)

2781− -> SerialT m a

2782− -> SerialT m a

2783−usingStateT s f xs = evalStateT s $ f $ liftInner xs

1223+{-# INLINE applyAsync #-}

1224+applyAsync :: (IsStream t, MonadAsync m)

1225+ => (t m a -> t m b) -> (t m a -> t m b)

1226+applyAsync = (|$)

27841227

2785−-- | Evaluate the inner monad of a stream as 'StateT' and emit the resulting

2786−-- state and value pair after each step.

1228+-- | Parallel reverse function application operator for streams; just like the

1229+-- regular reverse function application operator '&' except that it is

1230+-- concurrent.

1231+--

1232+-- @

1233+-- drain $

1234+-- S.repeatM (threadDelay 1000000 >> return 1)

1235+-- |& S.mapM (\\x -> threadDelay 1000000 >> print x)

1236+-- @

27871237--

2788−-- This is supported only for 'SerialT' as concurrent state updation may not be

2789−-- safe.

1238+-- /Concurrent/

27901239--

2791−-- / Internal/

1240+-- /Since: 0.3.0 ("Streamly")/

27921241--

2793−{-# INLINE runStateT #-}

2794−runStateT :: Monad m => m s -> SerialT (StateT s m) a -> SerialT m (s, a)

2795−runStateT s xs = fromStreamD $ D.runStateT s (toStreamD xs)

1242+-- @since 0.8.0

1243+{-# INLINE (|&) #-}

1244+(|&) :: (IsStream t, MonadAsync m) => t m a -> (t m a -> t m b) -> t m b

1245+x |& f = f |$ x

1246+

1247+infixl 1 |&

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

@@ -3,9 +3,7 @@

33-- |

44-- Module : Streamly.Internal.Data.Stream.StreamD

6−-- (c) Roman Leshchinskiy 2008-2010

7−-- (c) The University of Glasgow, 2009

8−-- License : BSD3

6+-- License : BSD-3-Clause

97-- Maintainer : streamly@composewell.com

108-- Stability : experimental

119-- Portability : GHC

@@ -307,10 +305,12 @@ import Prelude hiding

307305 , notElem, null, head, tail, zipWith, lookup, foldr1, sequence

308306 , (!!), scanl, scanl1, concatMap, replicate, enumFromTo, concat

309307 , reverse, iterate, splitAt)

308+

309+-- XXX We could just export these modules directly

310310import Streamly.Internal.Data.Stream.StreamD.Type

311311import Streamly.Internal.Data.Stream.StreamD.Generate

312312import Streamly.Internal.Data.Stream.StreamD.Eliminate

313313import Streamly.Internal.Data.Stream.StreamD.Exception

314+import Streamly.Internal.Data.Stream.StreamD.Lift

314315import Streamly.Internal.Data.Stream.StreamD.Nesting

315−

316316import Streamly.Internal.Data.Stream.StreamD.Transform

src/Streamly/Internal/Data/Stream/StreamD/Eliminate.hs+42−46

@@ -1,37 +1,42 @@

1−#include "inline.hs"

2−

31-- |

42-- Module : Streamly.Internal.Data.Stream.StreamD.Eliminate

64-- (c) Roman Leshchinskiy 2008-2010

7−-- (c) The University of Glasgow, 2009

8−-- License : BSD3

5+-- License : BSD-3-Clause

96-- Maintainer : streamly@composewell.com

107-- Stability : experimental

118-- Portability : GHC

129

10+-- A few functions in this module have been adapted from the vector package

11+-- (c) Roman Leshchinskiy.

12+--

1313module Streamly.Internal.Data.Stream.StreamD.Eliminate

1414 (

15− -- * Elimination

16− -- ** General Folds

17− foldrM

18− , foldrMx

15+ -- * Running a 'Fold'

16+ foldOnce -- XXX rename to "fold"

17+

18+ -- -- * Running a 'Parser'

19+ -- , parse

20+

21+ -- * Stream Deconstruction

22+ , uncons

23+

24+ -- * Right Folds

25+ , foldrM

1926 , foldr

27+ , foldrMx

2028 , foldr1

2129

22− , foldl'

30+ -- * Left Folds

2331 , foldlM'

24− , toList

25− , toListRev

26−

27− , foldlx'

32+ , foldl'

2833 , foldlMx'

29− , foldOnce

30−

34+ , foldlx'

3135 , parselMx'

3236

33− -- ** Specialized Folds

37+ -- * Specific Fold Functions

3438 , drain

39+ , mapM_ -- Map and Fold

3540 , null

3641 , head

3742 , headElse

@@ -45,30 +50,33 @@ module Streamly.Internal.Data.Stream.StreamD.Eliminate

4550 , maximumBy

4651 , minimum

4752 , minimumBy

48− , findIndices

4953 , lookup

5054 , findM

5155 , find

5256 , (!!)

57+ , the

58+

59+ -- * To containers

60+ , toList

61+ , toListRev

5362 , toSVarParallel

5463

64+ -- * Multi-Stream Folds

5565 -- ** Comparisons

66+ -- | These should probably be expressed using zipping operations.

5667 , eqBy

5768 , cmpBy

5869

59− -- ** Transformation comprehensions

60− , the

61−

6270 -- ** Substreams

71+ -- | These should probably be expressed using parsers.

6372 , isPrefixOf

6473 , isSubsequenceOf

6574 , stripPrefix

66−

67− -- ** Map and Fold

68− , mapM_

6975 )

7076where

7177

78+#include "inline.hs"

79+

7280import Control.Exception (assert)

7381import Control.Monad.Catch (MonadThrow, throwM)

7482import GHC.Exts (SpecConstrAnnotation(..))

@@ -100,7 +108,7 @@ foldr1 f m = do

100108 Just (h, t) -> fmap Just (foldr f h t)

101109

102110------------------------------------------------------------------------------

103−-- Parses

111+-- Parsers

104112------------------------------------------------------------------------------

105113

106114-- Inlined definition. Without the inline "serially/parser/take" benchmark

@@ -381,18 +389,6 @@ findM p m = foldrM (\x xs -> p x >>= \r -> if r then return (Just x) else xs)

381389find :: Monad m => (a -> Bool) -> Stream m a -> m (Maybe a)

382390find p = findM (return . p)

383391

384−{-# INLINE_NORMAL findIndices #-}

385−findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int

386−findIndices p (Stream step state) = Stream step' (state, 0)

387− where

388− {-# INLINE_LATE step' #-}

389− step' gst (st, i) = i `seq` do

390− r <- step (adaptState gst) st

391− return $ case r of

392− Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)

393− Skip s -> Skip (s, i)

394− Stop -> Stop

395−

396392{-# INLINE toListRev #-}

397393toListRev :: Monad m => Stream m a -> m [a]

398394toListRev = foldl' (flip (:)) []

@@ -420,7 +416,16 @@ the (Stream step state) = go state

420416 Stop -> return (Just n)

421417

422418------------------------------------------------------------------------------

423−-- Substreams

419+-- Map and Fold

420+------------------------------------------------------------------------------

421+

422+-- | Execute a monadic action for each element of the 'Stream'

423+{-# INLINE_NORMAL mapM_ #-}

424+mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()

425+mapM_ m = drain . mapM m

426+

427+------------------------------------------------------------------------------

428+-- Multi-stream folds

424429------------------------------------------------------------------------------

425430

426431{-# INLINE_NORMAL isPrefixOf #-}

@@ -487,12 +492,3 @@ stripPrefix (Stream stepa ta) (Stream stepb tb) = go (ta, tb, Nothing)

487492 else return Nothing

488493 Skip sb' -> go (sa, sb', Just x)

489494 Stop -> return Nothing

490−

491−------------------------------------------------------------------------------

492−-- Map and Fold

493−------------------------------------------------------------------------------

494−

495−-- | Execute a monadic action for each element of the 'Stream'

496−{-# INLINE_NORMAL mapM_ #-}

497−mapM_ :: Monad m => (a -> m b) -> Stream m a -> m ()

498−mapM_ m = drain . mapM m

src/Streamly/Internal/Data/Stream/StreamD/Exception.hs+62−70

@@ -1,8 +1,6 @@

1−#include "inline.hs"

2−

31-- |

42-- Module : Streamly.Internal.Data.Stream.StreamD.Exception

64-- License : BSD-3-Clause

75-- Maintainer : streamly@composewell.com

86-- Stability : experimental

@@ -10,10 +8,12 @@

108

119module Streamly.Internal.Data.Stream.StreamD.Exception

1210 (

13− -- * Exceptions

11+ -- * Finalizers

1412 newFinalizedIORef

1513 , runIORefFinalizer

1614 , withIORefFinalizer

15+

16+ -- * Combinators

1717 , gbracket_

1818 , gbracket

1919 , before

@@ -29,9 +29,9 @@ module Streamly.Internal.Data.Stream.StreamD.Exception

2929 )

3030where

3131

32+#include "inline.hs"

3233

33−import Control.Exception

34− (Exception, SomeException, mask_)

34+import Control.Exception (Exception, SomeException, mask_)

3535import Control.Monad (void)

3636import Control.Monad.Catch (MonadCatch)

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

@@ -40,72 +40,9 @@ import Data.IORef (newIORef, readIORef, mkWeakIORef, writeIORef, IORef)

4040

4141import qualified Control.Monad.Catch as MC

4242

43−import Prelude hiding

44− ( map, mapM, mapM_, repeat, foldr, last, take, filter

45− , takeWhile, drop, dropWhile, all, any, maximum, minimum, elem

46− , notElem, null, head, tail, zipWith, lookup, foldr1, sequence

47− , (!!), scanl, scanl1, concatMap, replicate, enumFromTo, concat

48− , reverse, iterate, splitAt)

4943import Streamly.Internal.Data.Stream.StreamD.Type

5044import Streamly.Internal.Data.SVar

5145

52−------------------------------------------------------------------------------

53−-- Exceptions

54−------------------------------------------------------------------------------

55−

56−data GbracketState s1 s2 v

57− = GBracketInit

58− | GBracketNormal s1 v

59− | GBracketException s2

60−

61−-- | Like 'gbracket' but with following differences:

62−--

63−-- * alloc action @m c@ runs with async exceptions enabled

64−-- * cleanup action @c -> m d@ won't run if the stream is garbage collected

65−-- after partial evaluation.

66−-- * does not require a 'MonadAsync' constraint.

67−--

68−-- /Inhibits stream fusion/

69−--

70−-- /Internal/

71−--

72−{-# INLINE_NORMAL gbracket_ #-}

73−gbracket_

74− :: Monad m

75− => m c -- ^ before

76− -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)

77− -> (c -> m d) -- ^ after, on normal stop

78− -> (c -> e -> Stream m b -> Stream m b) -- ^ on exception

79− -> (c -> Stream m b) -- ^ stream generator

80− -> Stream m b

81−gbracket_ bef exc aft fexc fnormal =

82− Stream step GBracketInit

83−

84− where

85−

86− {-# INLINE_LATE step #-}

87− step _ GBracketInit = do

88− r <- bef

89− return $ Skip $ GBracketNormal (fnormal r) r

90−

91− step gst (GBracketNormal (UnStream step1 st) v) = do

92− res <- exc $ step1 gst st

93− case res of

94− Right r -> case r of

95− Yield x s ->

96− return $ Yield x (GBracketNormal (Stream step1 s) v)

97− Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)

98− Stop -> aft v >> return Stop

99− -- XXX Do not handle async exceptions, just rethrow them.

100− Left e ->

101− return $ Skip (GBracketException (fexc v e (UnStream step1 st)))

102− step gst (GBracketException (UnStream step1 st)) = do

103− res <- step1 gst st

104− case res of

105− Yield x s -> return $ Yield x (GBracketException (Stream step1 s))

106− Skip s -> return $ Skip (GBracketException (Stream step1 s))

107− Stop -> return Stop

108−

10946------------------------------------------------------------------------------

11047-- Finalizers

11148------------------------------------------------------------------------------

@@ -172,6 +109,61 @@ withIORefFinalizer ref action = do

172109 runinio action

173110

174111------------------------------------------------------------------------------

112+-- Exception handling combinators.

113+------------------------------------------------------------------------------

114+

115+data GbracketState s1 s2 v

116+ = GBracketInit

117+ | GBracketNormal s1 v

118+ | GBracketException s2

119+

120+-- | Like 'gbracket' but with following differences:

121+--

122+-- * alloc action @m c@ runs with async exceptions enabled

123+-- * cleanup action @c -> m d@ won't run if the stream is garbage collected

124+-- after partial evaluation.

125+-- * does not require a 'MonadAsync' constraint.

126+--

127+-- /Inhibits stream fusion/

128+--

129+-- /Internal/

130+--

131+{-# INLINE_NORMAL gbracket_ #-}

132+gbracket_

133+ :: Monad m

134+ => m c -- ^ before

135+ -> (forall s. m s -> m (Either e s)) -- ^ try (exception handling)

136+ -> (c -> m d) -- ^ after, on normal stop

137+ -> (c -> e -> Stream m b -> Stream m b) -- ^ on exception

138+ -> (c -> Stream m b) -- ^ stream generator

139+ -> Stream m b

140+gbracket_ bef exc aft fexc fnormal =

141+ Stream step GBracketInit

142+

143+ where

144+

145+ {-# INLINE_LATE step #-}

146+ step _ GBracketInit = do

147+ r <- bef

148+ return $ Skip $ GBracketNormal (fnormal r) r

149+

150+ step gst (GBracketNormal (UnStream step1 st) v) = do

151+ res <- exc $ step1 gst st

152+ case res of

153+ Right r -> case r of

154+ Yield x s ->

155+ return $ Yield x (GBracketNormal (Stream step1 s) v)

156+ Skip s -> return $ Skip (GBracketNormal (Stream step1 s) v)

157+ Stop -> aft v >> return Stop

158+ -- XXX Do not handle async exceptions, just rethrow them.

159+ Left e ->

160+ return $ Skip (GBracketException (fexc v e (UnStream step1 st)))

161+ step gst (GBracketException (UnStream step1 st)) = do

162+ res <- step1 gst st

163+ case res of

164+ Yield x s -> return $ Yield x (GBracketException (Stream step1 s))

165+ Skip s -> return $ Skip (GBracketException (Stream step1 s))

166+ Stop -> return Stop

175167

176168data GbracketIOState s1 s2 v wref

177169 = GBracketIOInit

@@ -250,7 +242,7 @@ gbracket bef exc aft fexc fnormal =

250242 Skip s -> return $ Skip (GBracketIOException (Stream step1 s))

251243 Stop -> return Stop

252244

253−-- | See 'Streamly.Internal.Data.Stream.IsStream.after_'.

245+-- | See 'Streamly.Internal.Data.Stream.IsStream.before'.

254246--

255247{-# INLINE_NORMAL before #-}

256248before :: Monad m => m b -> Stream m a -> Stream m a

src/Streamly/Internal/Data/Stream/StreamD/Generate.hs+105−55

@@ -1,41 +1,51 @@

1−#include "inline.hs"

2−

31-- |

42-- Module : Streamly.Internal.Data.Stream.StreamD.Generate

4+-- (c) Roman Leshchinskiy 2008-2010

65-- License : BSD-3-Clause

76-- Maintainer : streamly@composewell.com

87-- Stability : experimental

98-- Portability : GHC

9+--

10+-- Prefer unfolds ("Streamly.Internal.Data.Unfold") over the combinators in

11+-- this module. They are more powerful and efficient as they can be transformed

12+-- and composed on the input side efficiently and they can fuse in nested

13+-- operations (e.g. concatUnfold). All the combinators in this module can be

14+-- expressed using unfolds with the same efficiency.

15+--

16+-- Operations in this module that are not in "Streamly.Internal.Data.Unfold":

17+-- generate, times, fromPrimIORef.

18+--

19+-- We should plan to replace this module with "Streamly.Internal.Data.Unfold"

20+-- in future.

1021

22+-- A few combinators in this module have been adapted from the vector package

23+-- (c) Roman Leshchinskiy. See the notes in specific combinators.

24+--

1125module Streamly.Internal.Data.Stream.StreamD.Generate

1226 (

13− -- * Construction

27+ -- * Primitives

1428 nil

1529 , nilM

1630 , cons

1731 , consM

1832

19− -- * Generation

20− -- ** Unfolds

33+ -- * From 'Unfold'

34+ , unfold

35+

36+ -- * Unfolding

2137 , unfoldr

2238 , unfoldrM

23− , unfold

2439

25− -- ** Specialized Generation

26− -- | Generate a monadic stream from a seed.

40+ -- * From Values

41+ , yield

42+ , yieldM

2743 , repeat

2844 , repeatM

2945 , replicate

3046 , replicateM

31− , fromIndices

32− , fromIndicesM

33− , generate

34− , generateM

35− , iterate

36− , iterateM

3747

38− -- ** Enumerations

48+ -- * Enumeration

3949 , enumerateFromStepIntegral

4050 , enumerateFromIntegral

4151 , enumerateFromThenIntegral

@@ -48,33 +58,48 @@ module Streamly.Internal.Data.Stream.StreamD.Generate

4858 , enumerateFromToFractional

4959 , enumerateFromThenToFractional

5060

51− -- ** Time

61+ -- * Time Enumeration

5262 , times

5363

54− -- ** Conversions

64+ -- * From Generators

65+ -- | Generate a monadic stream from a seed.

66+ , fromIndices

67+ , fromIndicesM

68+ , generate

69+ , generateM

70+

71+ -- * Iteration

72+ , iterate

73+ , iterateM

74+

75+ -- * From Containers

5576 -- | Transform an input structure into a stream.

56− -- | Direct style stream does not support @fromFoldable@.

57− , yield

58− , yieldM

77+

78+ -- Note: Direct style stream does not support @fromFoldable@.

5979 , fromList

6080 , fromListM

61− , fromStreamK

62− , fromStreamD

6381 , fromPrimIORef

6482 , fromProducer

6583 , fromSVar

66− , toStreamD

6784

85+ -- * Callbacks

6886 , newCallbackStream

87+

88+ -- * Conversions

89+ , fromStreamK

90+ , toStreamK

91+ , fromStreamD

92+ , toStreamD

6993 )

7094where

7195

96+#include "inline.hs"

97+

7298import Control.Concurrent (myThreadId, threadDelay)

7399import Control.Monad (void, forever)

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

75101import Data.Int (Int64)

76−import Streamly.Internal.Data.Time.Units

77− (toRelTime64, RelTime64)

102+import Streamly.Internal.Data.Time.Units (toRelTime64, RelTime64)

78103import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)

79104import Streamly.Internal.Data.Time.Units

80105 (MicroSecond64(..), fromAbsTime, toAbsTime, AbsTime)

@@ -88,7 +113,7 @@ import Streamly.Internal.Data.Stream.StreamD.Type

88113import Streamly.Internal.Data.SVar

89114

90115------------------------------------------------------------------------------

91−-- Construction

116+-- Primitives

92117------------------------------------------------------------------------------

93118

94119-- | An empty 'Stream'.

@@ -115,24 +140,9 @@ cons x (Stream step state) = Stream step1 Nothing

115140 Stop -> Stop

116141

117142------------------------------------------------------------------------------

118−-- Generation by unfold

143+-- From 'Unfold'

119144------------------------------------------------------------------------------

120145

121−{-# INLINE_NORMAL unfoldrM #-}

122−unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a

123−unfoldrM next state = Stream step state

124− where

125− {-# INLINE_LATE step #-}

126− step _ st = do

127− r <- next st

128− return $ case r of

129− Just (x, s) -> Yield x s

130− Nothing -> Stop

131−

132−{-# INLINE_LATE unfoldr #-}

133−unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a

134−unfoldr f = unfoldrM (return . f)

135−

136146data UnfoldState s = UnfoldNothing | UnfoldJust s

137147

138148-- | Convert an 'Unfold' into a 'Stream' by supplying it a seed.

@@ -151,7 +161,27 @@ unfold (Unfold ustep inject) seed = Stream step UnfoldNothing

151161 Stop -> Stop

152162

153163------------------------------------------------------------------------------

154−-- Specialized Generation

164+-- Unfolding

165+------------------------------------------------------------------------------

166+

167+-- Adapted from vector package

168+{-# INLINE_NORMAL unfoldrM #-}

169+unfoldrM :: Monad m => (s -> m (Maybe (a, s))) -> s -> Stream m a

170+unfoldrM next state = Stream step state

171+ where

172+ {-# INLINE_LATE step #-}

173+ step _ st = do

174+ r <- next st

175+ return $ case r of

176+ Just (x, s) -> Yield x s

177+ Nothing -> Stop

178+

179+{-# INLINE_LATE unfoldr #-}

180+unfoldr :: Monad m => (s -> Maybe (a, s)) -> s -> Stream m a

181+unfoldr f = unfoldrM (return . f)

182+

183+------------------------------------------------------------------------------

184+-- From values

155185------------------------------------------------------------------------------

156186

157187{-# INLINE_NORMAL repeatM #-}

@@ -162,14 +192,7 @@ repeatM x = Stream (\_ _ -> x >>= \r -> return $ Yield r ()) ()

162192repeat :: Monad m => a -> Stream m a

163193repeat x = Stream (\_ _ -> return $ Yield x ()) ()

164194

165−{-# INLINE_NORMAL iterateM #-}

166−iterateM :: Monad m => (a -> m a) -> m a -> Stream m a

167−iterateM step = Stream (\_ st -> st >>= \x -> return $ Yield x (step x))

168−

169−{-# INLINE_NORMAL iterate #-}

170−iterate :: Monad m => (a -> a) -> a -> Stream m a

171−iterate step st = iterateM (return . step) (return st)

172−

195+-- Adapted from the vector package

173196{-# INLINE_NORMAL replicateM #-}

174197replicateM :: forall m a. Monad m => Int -> m a -> Stream m a

175198replicateM n p = Stream step n

@@ -185,6 +208,10 @@ replicateM n p = Stream step n

185208replicate :: Monad m => Int -> a -> Stream m a

186209replicate n x = replicateM n (return x)

187210

211+------------------------------------------------------------------------------

212+-- Enumeration

213+------------------------------------------------------------------------------

214+

188215-- This would not work properly for floats, therefore we put an Integral

189216-- constraint.

190217-- | Can be used to enumerate unbounded integrals. This does not check for

@@ -323,6 +350,10 @@ numFrom from = enumerateFromStepNum from 1

323350numFromThen :: (Monad m, Num a) => a -> a -> Stream m a

324351numFromThen from next = enumerateFromStepNum from (next - from)

325352

353+------------------------------------------------------------------------------

354+-- Time Enumeration

355+------------------------------------------------------------------------------

356+

326357{-# INLINE updateTimeVar #-}

327358updateTimeVar :: Prim.IORef Int64 -> IO ()

328359updateTimeVar timeVar = do

@@ -348,8 +379,6 @@ updateWithDelay precision timeVar = do

348379

349380 g' = g * 10 ^ (6 :: Int)

350381

351−-- The take/drop combinators above should be moved to filtering section.

352−

353382{-# INLINE_NORMAL times #-}

354383times :: MonadAsync m => Double -> Stream m (AbsTime, RelTime64)

355384times g = Stream step Nothing

@@ -376,7 +405,7 @@ times g = Stream step Nothing

376405 (toRelTime64 (MicroSecond64 (a - t0)))) s

377406

378407-------------------------------------------------------------------------------

379−-- Generation by Conversion

408+-- From Generators

380409-------------------------------------------------------------------------------

381410

382411{-# INLINE_NORMAL fromIndicesM #-}

@@ -392,6 +421,7 @@ fromIndicesM gen = Stream step 0

392421fromIndices :: Monad m => (Int -> a) -> Stream m a

393422fromIndices gen = fromIndicesM (return . gen)

394423

424+-- Adapted from the vector package

395425{-# INLINE_NORMAL generateM #-}

396426generateM :: Monad m => Int -> (Int -> m a) -> Stream m a

397427generateM n gen = n `seq` Stream step 0

@@ -406,6 +436,22 @@ generateM n gen = n `seq` Stream step 0

406436generate :: Monad m => Int -> (Int -> a) -> Stream m a

407437generate n gen = generateM n (return . gen)

408438

439+-------------------------------------------------------------------------------

440+-- Iteration

441+-------------------------------------------------------------------------------

442+

443+{-# INLINE_NORMAL iterateM #-}

444+iterateM :: Monad m => (a -> m a) -> m a -> Stream m a

445+iterateM step = Stream (\_ st -> st >>= \x -> return $ Yield x (step x))

446+

447+{-# INLINE_NORMAL iterate #-}

448+iterate :: Monad m => (a -> a) -> a -> Stream m a

449+iterate step st = iterateM (return . step) (return st)

450+

451+-------------------------------------------------------------------------------

452+-- From containers

453+-------------------------------------------------------------------------------

454+

409455-- XXX we need the MonadAsync constraint because of a rewrite rule.

410456-- | Convert a list of monadic actions to a 'Stream'

411457{-# INLINE_LATE fromListM #-}

@@ -416,6 +462,10 @@ fromListM = Stream step

416462 step _ (m:ms) = m >>= \x -> return $ Yield x ms

417463 step _ [] = return Stop

418464

465+-------------------------------------------------------------------------------

466+-- From callback

467+-------------------------------------------------------------------------------

468+

419469-- Note: we can use another API with two callbacks stop and yield if we want

420470-- the callback to be able to indicate end of stream.

421471--

src/Streamly/Internal/Data/Stream/StreamD/Lift.hsnew file+112

@@ -0,0 +1,112 @@

1+-- |

2+-- Module : Streamly.Internal.Data.Stream.StreamD.Lift

4+-- License : BSD-3-Clause

5+-- Maintainer : streamly@composewell.com

6+-- Stability : experimental

7+-- Portability : GHC

8+--

9+-- Transform the underlying monad of a stream.

10+

11+module Streamly.Internal.Data.Stream.StreamD.Lift

12+ (

13+ -- * Generalize Inner Monad

14+ hoist

15+ , generally -- XXX generalize

16+

17+ -- * Transform Inner Monad

18+ , liftInner

19+ , runReaderT

20+ , evalStateT

21+ , runStateT

22+ )

23+where

24+

25+#include "inline.hs"

26+

27+import Control.Monad.Trans.Class (MonadTrans(lift))

28+import Control.Monad.Trans.Reader (ReaderT)

29+import Control.Monad.Trans.State.Strict (StateT)

30+import Data.Functor.Identity (Identity(..))

31+import Streamly.Internal.Data.SVar (adaptState)

32+

33+import qualified Control.Monad.Trans.Reader as Reader

34+import qualified Control.Monad.Trans.State.Strict as State

35+

36+import Streamly.Internal.Data.Stream.StreamD.Type

37+

38+-------------------------------------------------------------------------------

39+-- Generalize Inner Monad

40+-------------------------------------------------------------------------------

41+

42+{-# INLINE_NORMAL hoist #-}

43+hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a

44+hoist f (Stream step state) = (Stream step' state)

45+ where

46+ {-# INLINE_LATE step' #-}

47+ step' gst st = do

48+ r <- f $ step (adaptState gst) st

49+ return $ case r of

50+ Yield x s -> Yield x s

51+ Skip s -> Skip s

52+ Stop -> Stop

53+

54+{-# INLINE generally #-}

55+generally :: Monad m => Stream Identity a -> Stream m a

56+generally = hoist (return . runIdentity)

57+

58+-------------------------------------------------------------------------------

59+-- Transform Inner Monad

60+-------------------------------------------------------------------------------

61+

62+{-# INLINE_NORMAL liftInner #-}

63+liftInner :: (Monad m, MonadTrans t, Monad (t m))

64+ => Stream m a -> Stream (t m) a

65+liftInner (Stream step state) = Stream step' state

66+ where

67+ {-# INLINE_LATE step' #-}

68+ step' gst st = do

69+ r <- lift $ step (adaptState gst) st

70+ return $ case r of

71+ Yield x s -> Yield x s

72+ Skip s -> Skip s

73+ Stop -> Stop

74+

75+{-# INLINE_NORMAL runReaderT #-}

76+runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a

77+runReaderT env (Stream step state) = Stream step' (state, env)

78+ where

79+ {-# INLINE_LATE step' #-}

80+ step' gst (st, action) = do

81+ sv <- action

82+ r <- Reader.runReaderT (step (adaptState gst) st) sv

83+ return $ case r of

84+ Yield x s -> Yield x (s, return sv)

85+ Skip s -> Skip (s, return sv)

86+ Stop -> Stop

87+

88+{-# INLINE_NORMAL evalStateT #-}

89+evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a

90+evalStateT initial (Stream step state) = Stream step' (state, initial)

91+ where

92+ {-# INLINE_LATE step' #-}

93+ step' gst (st, action) = do

94+ sv <- action

95+ (r, sv') <- State.runStateT (step (adaptState gst) st) sv

96+ return $ case r of

97+ Yield x s -> Yield x (s, return sv')

98+ Skip s -> Skip (s, return sv')

99+ Stop -> Stop

100+

101+{-# INLINE_NORMAL runStateT #-}

102+runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)

103+runStateT initial (Stream step state) = Stream step' (state, initial)

104+ where

105+ {-# INLINE_LATE step' #-}

106+ step' gst (st, action) = do

107+ sv <- action

108+ (r, sv') <- State.runStateT (step (adaptState gst) st) sv

109+ return $ case r of

110+ Yield x s -> Yield (sv', x) (s, return sv')

111+ Skip s -> Skip (s, return sv')

112+ Stop -> Stop

src/Streamly/Internal/Data/Stream/StreamD/Nesting.hs+1868−1550

@@ -1,64 +1,151 @@

1−#include "inline.hs"

2−

31-- |

42-- Module : Streamly.Internal.Data.Stream.StreamD.Nesting

64-- (c) Roman Leshchinskiy 2008-2010

7−-- (c) The University of Glasgow, 2009

8−-- License : BSD3

5+-- License : BSD-3-Clause

96-- Maintainer : streamly@composewell.com

107-- Stability : experimental

118-- Portability : GHC

9+--

10+-- This module contains transformations involving multiple streams, unfolds or

11+-- folds. There are two types of transformations generational or eliminational.

12+-- Generational transformations are like the "Generate" module but they

13+-- generate a stream by combining streams instead of elements. Eliminational

14+-- transformations are like the "Eliminate" module but they transform a stream

15+-- by eliminating parts of the stream instead of eliminating the whole stream.

16+--

17+-- These combinators involve transformation, generation, elimination so can be

18+-- classified under any of those.

19+--

20+-- Ultimately these operations should be supported by Unfolds, Pipes and Folds,

21+-- and this module may become redundant.

1222

23+-- The zipWithM combinator in this module has been adapted from the vector

24+-- package (c) Roman Leshchinskiy.

25+--

1326module Streamly.Internal.Data.Stream.StreamD.Nesting

1427 (

15− -- * Zipping

16− indexed

17− , indexedR

28+ -- * Generate

29+ -- | Combining streams to generate streams.

30+

31+ -- ** Combine Two Streams

32+ -- | Functions ending in the shape:

33+ --

34+ -- @t m a -> t m a -> t m a@.

35+

36+ -- *** Appending

37+ -- | Append a stream after another. A special case of concatMap or

38+ -- concatUnfold.

39+ AppendState(..)

40+ , append

41+

42+ -- *** Interleaving

43+ -- | Interleave elements from two streams alternately. A special case of

44+ -- concatUnfoldInterleave.

45+ , InterleaveState(..)

46+ , interleave

47+ , interleaveMin

48+ , interleaveSuffix

49+ , interleaveInfix

50+

51+ -- *** Scheduling

52+ -- | Execute streams alternately irrespective of whether they generate

53+ -- elements or not. Note 'interleave' would execute a stream until it

54+ -- yields an element. A special case of concatUnfoldRoundrobin.

55+ , roundRobin -- interleaveFair?/ParallelFair

56+

57+ -- *** Zipping

58+ -- | Zip corresponding elements of two streams.

1859 , zipWith

1960 , zipWithM

2061

21− -- * Merging

62+ -- *** Merging

63+ -- | Interleave elements from two streams based on a condition.

2264 , mergeBy

2365 , mergeByM

2466

67+ -- ** Combine N Streams

68+ -- | Functions generally ending in these shapes:

69+ --

70+ -- @

71+ -- concat: f (t m a) -> t m a

72+ -- concatMap: (a -> t m b) -> t m a -> t m b

73+ -- concatUnfold: Unfold m a b -> t m a -> t m b

74+ -- @

75+

76+ -- *** ConcatMap

77+ -- | Generate streams by mapping a stream generator on each element of an

78+ -- input stream, append the resulting streams and flatten.

79+ , concatMap

80+ , concatMapM

81+

82+ -- *** ConcatUnfold

83+ -- | Generate streams by using an unfold on each element of an input

84+ -- stream, append the resulting streams and flatten. A special case of

85+ -- gintercalate.

86+ , ConcatMapUState (..)

87+ , concatMapU

88+ , ConcatUnfoldInterleaveState (..)

89+ , concatUnfoldInterleave

90+ , concatUnfoldRoundrobin

91+

92+ -- *** Interpose

93+ -- | Like concatUnfold but intersperses an effect between the streams. A

94+ -- special case of gintercalate.

95+ , interpose

96+ , interposeSuffix

97+

98+ -- *** Intercalate

99+ -- | Like concatUnfold but intersperses streams from another source between

100+ -- the streams from the first source.

101+ , gintercalate

102+ , gintercalateSuffix

103+

104+ -- * Eliminate

105+ -- | Folding and Parsing chunks of streams to eliminate nested streams.

106+ -- Functions generally ending in these shapes:

107+ --

108+ -- @

109+ -- f (Fold m a b) -> t m a -> t m b

110+ -- f (Parser m a b) -> t m a -> t m b

111+ -- @

112+

113+ -- ** Folding

114+ -- | Apply folds on a stream.

115+ , foldMany

116+

117+ -- ** Parsing

118+ -- | Parsing is opposite to flattening. 'parseMany' is dual to concatMap or

119+ -- concatUnfold. concatMap generates a stream from single values in a

120+ -- stream and flattens, parseMany does the opposite of flattening by

121+ -- splitting the stream and then folds each such split to single value in

122+ -- the output stream.

123+ , parseMany

124+ , parseIterate

125+

25126 -- ** Grouping

127+ -- | Group segments of a stream and fold. Special case of parsing.

26128 , groupsOf2

27129 , groupsBy

28130 , groupsRollingBy

29131

30132 -- ** Splitting

133+ -- | A special case of parsing.

31134 , wordsBy

32−

33135 , splitOnSeq

34136 , splitOnSuffixSeq

35137

138+ -- * Transform (Nested Containers)

139+ -- | Opposite to compact in ArrayStream

36140 , splitInnerBy

37141 , splitInnerBySuffix

38−

39− -- ** Flattening nested streams

40− , concatMapM

41− , concatMap

42− , ConcatMapUState (..)

43− , concatMapU

44− , ConcatUnfoldInterleaveState (..)

45− , concatUnfoldInterleave

46− , concatUnfoldRoundrobin

47− , AppendState(..)

48− , append

49− , InterleaveState(..)

50− , interleave

51− , interleaveMin

52− , interleaveSuffix

53− , interleaveInfix

54− , roundRobin -- interleaveFair?/ParallelFair

55− , gintercalateSuffix

56− , interposeSuffix

57− , gintercalate

58− , interpose

59142 )

60143where

61144

145+#include "inline.hs"

146+

147+import Control.Exception (assert)

148+import Control.Monad.Catch (MonadThrow, throwM)

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

63150import Data.Bits (shiftR, shiftL, (.|.), (.&.))

64151#if __GLASGOW_HASKELL__ >= 801

@@ -71,10 +158,13 @@ import GHC.Types (SPEC(..))

71158

72159import Streamly.Internal.Data.Array.Storable.Foreign.Types (Array(..))

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

161+import Streamly.Internal.Data.Parser (ParseError(..))

74162import Streamly.Internal.Data.Unfold.Types (Unfold(..))

75163

76164import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as A

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

166+import qualified Streamly.Internal.Data.Parser as PR

167+import qualified Streamly.Internal.Data.Parser.ParserD as PRD

78168import qualified Streamly.Memory.Ring as RB

79169

80170import Streamly.Internal.Data.Stream.StreamD.Type

@@ -83,1783 +173,2011 @@ import Streamly.Internal.Data.SVar

83173import Prelude hiding (concatMap, mapM, zipWith)

84174

85175------------------------------------------------------------------------------

86−-- Zipping

176+-- Appending

87177------------------------------------------------------------------------------

88178

89−{-# INLINE_NORMAL indexed #-}

90−indexed :: Monad m => Stream m a -> Stream m (Int, a)

91−indexed (Stream step state) = Stream step' (state, 0)

92− where

93− {-# INLINE_LATE step' #-}

94− step' gst (st, i) = i `seq` do

95− r <- step (adaptState gst) st

96− case r of

97− Yield x s -> return $ Yield (i, x) (s, i+1)

98− Skip s -> return $ Skip (s, i)

99− Stop -> return Stop

100−

101−{-# INLINE_NORMAL indexedR #-}

102−indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)

103−indexedR m (Stream step state) = Stream step' (state, m)

104− where

105− {-# INLINE_LATE step' #-}

106− step' gst (st, i) = i `seq` do

107− r <- step (adaptState gst) st

108− case r of

109− Yield x s -> let i' = i - 1

110− in return $ Yield (i, x) (s, i')

111− Skip s -> return $ Skip (s, i)

112− Stop -> return Stop

179+data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2

113180

114−{-# INLINE_NORMAL zipWithM #-}

115−zipWithM :: Monad m

116− => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c

117−zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)

118− where

119− {-# INLINE_LATE step #-}

120− step gst (sa, sb, Nothing) = do

121− r <- stepa (adaptState gst) sa

122− return $

123− case r of

124− Yield x sa' -> Skip (sa', sb, Just x)

125− Skip sa' -> Skip (sa', sb, Nothing)

126− Stop -> Stop

181+-- Note that this could be much faster compared to the CPS stream. However, as

182+-- the number of streams being composed increases this may become expensive.

183+-- Need to see where the breaking point is between the two.

184+--

185+{-# INLINE_NORMAL append #-}

186+append :: Monad m => Stream m a -> Stream m a -> Stream m a

187+append (Stream step1 state1) (Stream step2 state2) =

188+ Stream step (AppendFirst state1)

127189

128− step gst (sa, sb, Just x) = do

129− r <- stepb (adaptState gst) sb

130− case r of

131− Yield y sb' -> do

132− z <- f x y

133− return $ Yield z (sa, sb', Nothing)

134− Skip sb' -> return $ Skip (sa, sb', Just x)

135− Stop -> return Stop

190+ where

136191

137−#if __GLASGOW_HASKELL__ >= 801

138−{-# RULES "zipWithM xs xs"

139− forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}

140−#endif

192+ {-# INLINE_LATE step #-}

193+ step gst (AppendFirst st) = do

194+ r <- step1 gst st

195+ return $ case r of

196+ Yield a s -> Yield a (AppendFirst s)

197+ Skip s -> Skip (AppendFirst s)

198+ Stop -> Skip (AppendSecond state2)

141199

142−{-# INLINE zipWith #-}

143−zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c

144−zipWith f = zipWithM (\a b -> return (f a b))

200+ step gst (AppendSecond st) = do

201+ r <- step2 gst st

202+ return $ case r of

203+ Yield a s -> Yield a (AppendSecond s)

204+ Skip s -> Skip (AppendSecond s)

205+ Stop -> Stop

145206

146207------------------------------------------------------------------------------

147−-- Merging

208+-- Interleaving

148209------------------------------------------------------------------------------

149210

150−{-# INLINE_NORMAL mergeByM #-}

151−mergeByM

152− :: (Monad m)

153− => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a

154−mergeByM cmp (Stream stepa ta) (Stream stepb tb) =

155− Stream step (Just ta, Just tb, Nothing, Nothing)

156− where

211+data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2

212+ | InterleaveSecondOnly s2 | InterleaveFirstOnly s1

213+

214+{-# INLINE_NORMAL interleave #-}

215+interleave :: Monad m => Stream m a -> Stream m a -> Stream m a

216+interleave (Stream step1 state1) (Stream step2 state2) =

217+ Stream step (InterleaveFirst state1 state2)

218+

219+ where

220+

157221 {-# INLINE_LATE step #-}

222+ step gst (InterleaveFirst st1 st2) = do

223+ r <- step1 gst st1

224+ return $ case r of

225+ Yield a s -> Yield a (InterleaveSecond s st2)

226+ Skip s -> Skip (InterleaveFirst s st2)

227+ Stop -> Skip (InterleaveSecondOnly st2)

158228

159− -- one of the values is missing, and the corresponding stream is running

160− step gst (Just sa, sb, Nothing, b) = do

161− r <- stepa gst sa

229+ step gst (InterleaveSecond st1 st2) = do

230+ r <- step2 gst st2

162231 return $ case r of

163− Yield a sa' -> Skip (Just sa', sb, Just a, b)

164− Skip sa' -> Skip (Just sa', sb, Nothing, b)

165− Stop -> Skip (Nothing, sb, Nothing, b)

232+ Yield a s -> Yield a (InterleaveFirst st1 s)

233+ Skip s -> Skip (InterleaveSecond st1 s)

234+ Stop -> Skip (InterleaveFirstOnly st1)

166235

167− step gst (sa, Just sb, a, Nothing) = do

168− r <- stepb gst sb

236+ step gst (InterleaveFirstOnly st1) = do

237+ r <- step1 gst st1

169238 return $ case r of

170− Yield b sb' -> Skip (sa, Just sb', a, Just b)

171− Skip sb' -> Skip (sa, Just sb', a, Nothing)

172− Stop -> Skip (sa, Nothing, a, Nothing)

239+ Yield a s -> Yield a (InterleaveFirstOnly s)

240+ Skip s -> Skip (InterleaveFirstOnly s)

241+ Stop -> Stop

173242

174− -- both the values are available

175− step _ (sa, sb, Just a, Just b) = do

176− res <- cmp a b

177− return $ case res of

178− GT -> Yield b (sa, sb, Just a, Nothing)

179− _ -> Yield a (sa, sb, Nothing, Just b)

243+ step gst (InterleaveSecondOnly st2) = do

244+ r <- step2 gst st2

245+ return $ case r of

246+ Yield a s -> Yield a (InterleaveSecondOnly s)

247+ Skip s -> Skip (InterleaveSecondOnly s)

248+ Stop -> Stop

180249

181− -- one of the values is missing, corresponding stream is done

182− step _ (Nothing, sb, Nothing, Just b) =

183− return $ Yield b (Nothing, sb, Nothing, Nothing)

250+{-# INLINE_NORMAL interleaveMin #-}

251+interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a

252+interleaveMin (Stream step1 state1) (Stream step2 state2) =

253+ Stream step (InterleaveFirst state1 state2)

184254

185− step _ (sa, Nothing, Just a, Nothing) =

186− return $ Yield a (sa, Nothing, Nothing, Nothing)

255+ where

187256

188− step _ (Nothing, Nothing, Nothing, Nothing) = return Stop

257+ {-# INLINE_LATE step #-}

258+ step gst (InterleaveFirst st1 st2) = do

259+ r <- step1 gst st1

260+ return $ case r of

261+ Yield a s -> Yield a (InterleaveSecond s st2)

262+ Skip s -> Skip (InterleaveFirst s st2)

263+ Stop -> Stop

189264

190−{-# INLINE mergeBy #-}

191−mergeBy

192− :: (Monad m)

193− => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a

194−mergeBy cmp = mergeByM (\a b -> return $ cmp a b)

265+ step gst (InterleaveSecond st1 st2) = do

266+ r <- step2 gst st2

267+ return $ case r of

268+ Yield a s -> Yield a (InterleaveFirst st1 s)

269+ Skip s -> Skip (InterleaveSecond st1 s)

270+ Stop -> Stop

195271

196−------------------------------------------------------------------------------

197−-- Grouping/Splitting

198−------------------------------------------------------------------------------

272+ step _ (InterleaveFirstOnly _) = undefined

273+ step _ (InterleaveSecondOnly _) = undefined

199274

200−{-# INLINE_NORMAL groupsBy #-}

201−groupsBy :: Monad m

202− => (a -> a -> Bool)

203− -> Fold m a b

204− -> Stream m a

205− -> Stream m b

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

275+{-# INLINE_NORMAL interleaveSuffix #-}

276+interleaveSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a

277+interleaveSuffix (Stream step1 state1) (Stream step2 state2) =

278+ Stream step (InterleaveFirst state1 state2)

207279

208280 where

209281

210− {-# INLINE_LATE stepOuter #-}

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

212− res <- step (adaptState gst) st

213− case res of

214− Yield x s -> do

215− fs <- initial

216− r <- fstep fs x

217− case r of

218− FL.Partial fs1 -> go SPEC x s fs1

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

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

221− Stop -> return Stop

282+ {-# INLINE_LATE step #-}

283+ step gst (InterleaveFirst st1 st2) = do

284+ r <- step1 gst st1

285+ return $ case r of

286+ Yield a s -> Yield a (InterleaveSecond s st2)

287+ Skip s -> Skip (InterleaveFirst s st2)

288+ Stop -> Stop

222289

223− where

290+ step gst (InterleaveSecond st1 st2) = do

291+ r <- step2 gst st2

292+ return $ case r of

293+ Yield a s -> Yield a (InterleaveFirst st1 s)

294+ Skip s -> Skip (InterleaveSecond st1 s)

295+ Stop -> Skip (InterleaveFirstOnly st1)

224296

225− go !_ prev stt !acc = do

226− res <- step (adaptState gst) stt

227− case res of

228− Yield x s -> do

229− if cmp x prev

230− then do

231− r <- fstep acc x

232− case r of

233− FL.Partial fs1 -> go SPEC prev s fs1

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

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

236− Skip s -> go SPEC prev s acc

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

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

239− fs <- initial

240− r <- fstep fs prev

241− case r of

242− FL.Partial fs1 -> go SPEC st fs1

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

297+ step gst (InterleaveFirstOnly st1) = do

298+ r <- step1 gst st1

299+ return $ case r of

300+ Yield a s -> Yield a (InterleaveFirstOnly s)

301+ Skip s -> Skip (InterleaveFirstOnly s)

302+ Stop -> Stop

244303

245− where

304+ step _ (InterleaveSecondOnly _) = undefined

246305

247− -- XXX code duplicated from the previous equation

248− go !_ stt !acc = do

249− res <- step (adaptState gst) stt

250− case res of

251− Yield x s -> do

252− if cmp x prev

253− then do

254− r <- fstep acc x

255− case r of

256− FL.Partial fs1 -> go SPEC s fs1

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

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

259− Skip s -> go SPEC s acc

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

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

306+data InterleaveInfixState s1 s2 a

307+ = InterleaveInfixFirst s1 s2

308+ | InterleaveInfixSecondBuf s1 s2

309+ | InterleaveInfixSecondYield s1 s2 a

310+ | InterleaveInfixFirstYield s1 s2 a

311+ | InterleaveInfixFirstOnly s1

262312

263−{-# INLINE_NORMAL groupsRollingBy #-}

264−groupsRollingBy :: Monad m

265− => (a -> a -> Bool)

266− -> Fold m a b

267− -> Stream m a

268− -> Stream m b

269−groupsRollingBy cmp f (Stream step state) =

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

313+{-# INLINE_NORMAL interleaveInfix #-}

314+interleaveInfix :: Monad m => Stream m a -> Stream m a -> Stream m a

315+interleaveInfix (Stream step1 state1) (Stream step2 state2) =

316+ Stream step (InterleaveInfixFirst state1 state2)

271317

272318 where

273319

274− {-# INLINE_LATE stepOuter #-}

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

276− res <- step (adaptState gst) st

277− case res of

278− Yield x s -> do

279− fs <- initial

280− r <- fstep fs x

281− case r of

282− FL.Partial fs1 -> go SPEC x s fs1

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

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

285− Stop -> return Stop

320+ {-# INLINE_LATE step #-}

321+ step gst (InterleaveInfixFirst st1 st2) = do

322+ r <- step1 gst st1

323+ return $ case r of

324+ Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)

325+ Skip s -> Skip (InterleaveInfixFirst s st2)

326+ Stop -> Stop

286327

287− where

328+ step gst (InterleaveInfixSecondBuf st1 st2) = do

329+ r <- step2 gst st2

330+ return $ case r of

331+ Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)

332+ Skip s -> Skip (InterleaveInfixSecondBuf st1 s)

333+ Stop -> Skip (InterleaveInfixFirstOnly st1)

288334

289− go !_ prev stt !acc = do

290− res <- step (adaptState gst) stt

291− case res of

292− Yield x s -> do

293− if cmp prev x

294− then do

295− r <- fstep acc x

296− case r of

297− FL.Partial fs1 -> go SPEC x s fs1

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

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

300− Skip s -> go SPEC prev s acc

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

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

303− fs <- initial

304− r <- fstep fs prev'

305− case r of

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

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

335+ step gst (InterleaveInfixSecondYield st1 st2 x) = do

336+ r <- step1 gst st1

337+ return $ case r of

338+ Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)

339+ Skip s -> Skip (InterleaveInfixSecondYield s st2 x)

340+ Stop -> Stop

308341

309− where

342+ step _ (InterleaveInfixFirstYield st1 st2 x) = do

343+ return $ Yield x (InterleaveInfixSecondBuf st1 st2)

310344

311− go !_ prevv stt !acc = do

312− res <- step (adaptState gst) stt

313− case res of

314− Yield x s -> do

315− if cmp prevv x

316− then do

317− r <- fstep acc x

318− case r of

319− FL.Partial fs1 -> go SPEC x s fs1

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

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

322− Skip s -> go SPEC prevv s acc

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

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

345+ step gst (InterleaveInfixFirstOnly st1) = do

346+ r <- step1 gst st1

347+ return $ case r of

348+ Yield a s -> Yield a (InterleaveInfixFirstOnly s)

349+ Skip s -> Skip (InterleaveInfixFirstOnly s)

350+ Stop -> Stop

325351

326−data WordsByState s = WordsByJust s | WordsByNothing

352+------------------------------------------------------------------------------

353+-- Scheduling

354+------------------------------------------------------------------------------

327355

328−{-# INLINE_NORMAL wordsBy #-}

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

330−wordsBy predicate f (Stream step state) =

331− Stream (stepOuter f) (WordsByJust state)

356+{-# INLINE_NORMAL roundRobin #-}

357+roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a

358+roundRobin (Stream step1 state1) (Stream step2 state2) =

359+ Stream step (InterleaveFirst state1 state2)

332360

333361 where

334362

335− {-# INLINE_LATE stepOuter #-}

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

337− res <- step (adaptState gst) st

338− case res of

339− Yield x s -> do

340− if predicate x

341− then return $ Skip (WordsByJust s)

342− else do

343− fs <- initial

344− r <- fstep fs x

345− case r of

346− FL.Partial fs1 -> go SPEC s fs1

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

348−

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

350− Stop -> return Stop

363+ {-# INLINE_LATE step #-}

364+ step gst (InterleaveFirst st1 st2) = do

365+ r <- step1 gst st1

366+ return $ case r of

367+ Yield a s -> Yield a (InterleaveSecond s st2)

368+ Skip s -> Skip (InterleaveSecond s st2)

369+ Stop -> Skip (InterleaveSecondOnly st2)

351370

352− where

371+ step gst (InterleaveSecond st1 st2) = do

372+ r <- step2 gst st2

373+ return $ case r of

374+ Yield a s -> Yield a (InterleaveFirst st1 s)

375+ Skip s -> Skip (InterleaveFirst st1 s)

376+ Stop -> Skip (InterleaveFirstOnly st1)

353377

354− go !_ stt !acc = do

355− res <- step (adaptState gst) stt

356− case res of

357− Yield x s -> do

358− if predicate x

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

360− else do

361− r <- fstep acc x

362− case r of

363− FL.Partial fs1 -> go SPEC s fs1

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

365− Skip s -> go SPEC s acc

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

378+ step gst (InterleaveSecondOnly st2) = do

379+ r <- step2 gst st2

380+ return $ case r of

381+ Yield a s -> Yield a (InterleaveSecondOnly s)

382+ Skip s -> Skip (InterleaveSecondOnly s)

383+ Stop -> Stop

367384

368− stepOuter _ _ WordsByNothing = return Stop

385+ step gst (InterleaveFirstOnly st1) = do

386+ r <- step1 gst st1

387+ return $ case r of

388+ Yield a s -> Yield a (InterleaveFirstOnly s)

389+ Skip s -> Skip (InterleaveFirstOnly s)

390+ Stop -> Stop

369391

370−-- String search algorithms:

371−-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html

392+------------------------------------------------------------------------------

393+-- Zipping

394+------------------------------------------------------------------------------

372395

373−{-

374−-- TODO can we unify the splitting operations using a splitting configuration

375−-- like in the split package.

376−--

377−data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)

378−data SplitOptions = SplitOptions

379− { style :: SplitStyle

380− , withSep :: Bool -- ^ keep the separators in output

381− -- , compact :: Bool -- ^ treat multiple consecutive separators as one

382− -- , trimHead :: Bool -- ^ drop blank at head

383− -- , trimTail :: Bool -- ^ drop blank at tail

384− }

385−-}

396+{-# INLINE_NORMAL zipWithM #-}

397+zipWithM :: Monad m

398+ => (a -> b -> m c) -> Stream m a -> Stream m b -> Stream m c

399+zipWithM f (Stream stepa ta) (Stream stepb tb) = Stream step (ta, tb, Nothing)

400+ where

401+ {-# INLINE_LATE step #-}

402+ step gst (sa, sb, Nothing) = do

403+ r <- stepa (adaptState gst) sa

404+ return $

405+ case r of

406+ Yield x sa' -> Skip (sa', sb, Just x)

407+ Skip sa' -> Skip (sa', sb, Nothing)

408+ Stop -> Stop

386409

387−{-# ANN type SplitOnSeqState Fuse #-}

388−data SplitOnSeqState rb rh ck w fs s b x =

389− SplitOnSeqInit

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

391− | SplitOnSeqDone

410+ step gst (sa, sb, Just x) = do

411+ r <- stepb (adaptState gst) sb

412+ case r of

413+ Yield y sb' -> do

414+ z <- f x y

415+ return $ Yield z (sa, sb', Nothing)

416+ Skip sb' -> return $ Skip (sa, sb', Just x)

417+ Stop -> return Stop

392418

393− | SplitOnSeqEmpty s

419+#if __GLASGOW_HASKELL__ >= 801

420+{-# RULES "zipWithM xs xs"

421+ forall f xs. zipWithM @Identity f xs xs = mapM (\x -> f x x) xs #-}

422+#endif

394423

395− | SplitOnSeqSingle !fs s x

424+{-# INLINE zipWith #-}

425+zipWith :: Monad m => (a -> b -> c) -> Stream m a -> Stream m b -> Stream m c

426+zipWith f = zipWithM (\a b -> return (f a b))

396427

397− | SplitOnSeqWordInit s

398− | SplitOnSeqWordLoop !w s !fs

399− | SplitOnSeqWordDone Int !fs !w

428+------------------------------------------------------------------------------

429+-- Merging

430+------------------------------------------------------------------------------

400431

401− | SplitOnSeqKRInit Int s rb !rh

402− | SplitOnSeqKRLoop fs s rb !rh !ck

403− | SplitOnSeqKRCheck fs s rb !rh

404− | SplitOnSeqKRDone Int !fs rb !rh

432+{-# INLINE_NORMAL mergeByM #-}

433+mergeByM

434+ :: (Monad m)

435+ => (a -> a -> m Ordering) -> Stream m a -> Stream m a -> Stream m a

436+mergeByM cmp (Stream stepa ta) (Stream stepb tb) =

437+ Stream step (Just ta, Just tb, Nothing, Nothing)

438+ where

439+ {-# INLINE_LATE step #-}

405440

406−{-# INLINE_NORMAL splitOnSeq #-}

407−splitOnSeq

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

409− => Array a

410− -> Fold m a b

411− -> Stream m a

412− -> Stream m b

413−splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

414− Stream stepOuter SplitOnSeqInit

415−

416− where

441+ -- one of the values is missing, and the corresponding stream is running

442+ step gst (Just sa, sb, Nothing, b) = do

443+ r <- stepa gst sa

444+ return $ case r of

445+ Yield a sa' -> Skip (Just sa', sb, Just a, b)

446+ Skip sa' -> Skip (Just sa', sb, Nothing, b)

447+ Stop -> Skip (Nothing, sb, Nothing, b)

417448

418− patLen = A.length patArr

419− maxIndex = patLen - 1

420− elemBits = sizeOf (undefined :: a) * 8

449+ step gst (sa, Just sb, a, Nothing) = do

450+ r <- stepb gst sb

451+ return $ case r of

452+ Yield b sb' -> Skip (sa, Just sb', a, Just b)

453+ Skip sb' -> Skip (sa, Just sb', a, Nothing)

454+ Stop -> Skip (sa, Nothing, a, Nothing)

421455

422− -- For word pattern case

423− wordMask :: Word

424− wordMask = (1 `shiftL` (elemBits * patLen)) - 1

456+ -- both the values are available

457+ step _ (sa, sb, Just a, Just b) = do

458+ res <- cmp a b

459+ return $ case res of

460+ GT -> Yield b (sa, sb, Just a, Nothing)

461+ _ -> Yield a (sa, sb, Nothing, Just b)

425462

426− elemMask :: Word

427− elemMask = (1 `shiftL` elemBits) - 1

463+ -- one of the values is missing, corresponding stream is done

464+ step _ (Nothing, sb, Nothing, Just b) =

465+ return $ Yield b (Nothing, sb, Nothing, Nothing)

428466

429− wordPat :: Word

430− wordPat = wordMask .&. A.foldl' addToWord 0 patArr

467+ step _ (sa, Nothing, Just a, Nothing) =

468+ return $ Yield a (sa, Nothing, Nothing, Nothing)

431469

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

470+ step _ (Nothing, Nothing, Nothing, Nothing) = return Stop

433471

434− -- For Rabin-Karp search

435− k = 2891336453 :: Word32

436− coeff = k ^ patLen

472+{-# INLINE mergeBy #-}

473+mergeBy

474+ :: (Monad m)

475+ => (a -> a -> Ordering) -> Stream m a -> Stream m a -> Stream m a

476+mergeBy cmp = mergeByM (\a b -> return $ cmp a b)

437477

438− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

478+------------------------------------------------------------------------------

479+-- Combine N Streams - concatUnfold

480+------------------------------------------------------------------------------

439481

440− deltaCksum cksum old new =

441− addCksum cksum new - coeff * fromIntegral (fromEnum old)

482+-- Define a unique structure to use in inspection testing

483+data ConcatMapUState o i =

484+ ConcatMapUOuter o

485+ | ConcatMapUInner o i

442486

443− -- XXX shall we use a random starting hash or 1 instead of 0?

444− patHash = A.foldl' addCksum 0 patArr

487+-- | @concatMapU unfold stream@ uses @unfold@ to map the input stream elements

488+-- to streams and then flattens the generated streams into a single output

489+-- stream.

445490

446− skip = return . Skip

491+-- This is like 'concatMap' but uses an unfold with an explicit state to

492+-- generate the stream instead of a 'Stream' type generator. This allows better

493+-- optimization via fusion. This can be many times more efficient than

494+-- 'concatMap'.

447495

448− {-# INLINE_LATE stepOuter #-}

449− stepOuter _ SplitOnSeqInit =

450− if patLen == 0

451− then return $ Skip $ SplitOnSeqEmpty state

452− else if patLen == 1

453− then do

454− acc <- initial

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

456− return $ Skip $ SplitOnSeqSingle acc state pat

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

458− <= sizeOf (undefined :: Word)

459− then return $ Skip $ SplitOnSeqWordInit state

460− else do

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

462− skip $ SplitOnSeqKRInit 0 state rb rhead

496+{-# INLINE_NORMAL concatMapU #-}

497+concatMapU :: Monad m => Unfold m a b -> Stream m a -> Stream m b

498+concatMapU (Unfold istep inject) (Stream ostep ost) =

499+ Stream step (ConcatMapUOuter ost)

500+ where

501+ {-# INLINE_LATE step #-}

502+ step gst (ConcatMapUOuter o) = do

503+ r <- ostep (adaptState gst) o

504+ case r of

505+ Yield a o' -> do

506+ i <- inject a

507+ i `seq` return (Skip (ConcatMapUInner o' i))

508+ Skip o' -> return $ Skip (ConcatMapUOuter o')

509+ Stop -> return $ Stop

463510

464− stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next

511+ step _ (ConcatMapUInner o i) = do

512+ r <- istep i

513+ return $ case r of

514+ Yield x i' -> Yield x (ConcatMapUInner o i')

515+ Skip i' -> Skip (ConcatMapUInner o i')

516+ Stop -> Skip (ConcatMapUOuter o)

465517

466− ---------------------------

467− -- Empty pattern

468− ---------------------------

518+data ConcatUnfoldInterleaveState o i =

519+ ConcatUnfoldInterleaveOuter o [i]

520+ | ConcatUnfoldInterleaveInner o [i]

521+ | ConcatUnfoldInterleaveInnerL [i] [i]

522+ | ConcatUnfoldInterleaveInnerR [i] [i]

469523

470− stepOuter gst (SplitOnSeqEmpty st) = do

471− res <- step (adaptState gst) st

472− case res of

473− Yield x s -> do

474− fs <- initial

475− r <- fstep fs x

476− case r of

477− FL.Partial fs1 -> do

478− b <- done fs1

479− skip $ SplitOnSeqYield b (SplitOnSeqEmpty s)

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

524+-- XXX use arrays to store state instead of lists.

525+-- XXX In general we can use different scheduling strategies e.g. how to

526+-- schedule the outer vs inner loop or assigning weights to different streams

527+-- or outer and inner loops.

481528

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

483− Stop -> return Stop

529+-- After a yield, switch to the next stream. Do not switch streams on Skip.

530+-- Yield from outer stream switches to the inner stream.

531+--

532+-- There are two choices here, (1) exhaust the outer stream first and then

533+-- start yielding from the inner streams, this is much simpler to implement,

534+-- (2) yield at least one element from an inner stream before going back to

535+-- outer stream and opening the next stream from it.

536+--

537+-- Ideally, we need some scheduling bias to inner streams vs outer stream.

538+-- Maybe we can configure the behavior.

539+--

540+{-# INLINE_NORMAL concatUnfoldInterleave #-}

541+concatUnfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b

542+concatUnfoldInterleave (Unfold istep inject) (Stream ostep ost) =

543+ Stream step (ConcatUnfoldInterleaveOuter ost [])

544+ where

545+ {-# INLINE_LATE step #-}

546+ step gst (ConcatUnfoldInterleaveOuter o ls) = do

547+ r <- ostep (adaptState gst) o

548+ case r of

549+ Yield a o' -> do

550+ i <- inject a

551+ i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))

552+ Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)

553+ Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

484554

485− -----------------

486− -- Done

487− -----------------

555+ step _ (ConcatUnfoldInterleaveInner _ []) = undefined

556+ step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do

557+ r <- istep st

558+ return $ case r of

559+ Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))

560+ Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))

561+ Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)

488562

489− stepOuter _ SplitOnSeqDone = return Stop

563+ step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop

564+ step _ (ConcatUnfoldInterleaveInnerL [] rs) =

565+ return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)

490566

491− -----------------

492− -- Single Pattern

493− -----------------

567+ step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do

568+ r <- istep st

569+ return $ case r of

570+ Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))

571+ Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)

572+ Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)

494573

495− stepOuter gst (SplitOnSeqSingle fs st pat) = do

496− res <- step (adaptState gst) st

497− case res of

498− Yield x s -> do

499− if pat == x

500− then do

501− r <- done fs

502− fs1 <- initial

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

504− else do

505− r <- fstep fs x

506− case r of

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

508− FL.Done b -> do

509− fs1 <- initial

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

511− Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

512− Stop -> do

513− r <- done fs

514− return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

574+ step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop

575+ step _ (ConcatUnfoldInterleaveInnerR ls []) =

576+ return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

515577

516− ---------------------------

517− -- Short Pattern - Shift Or

518− ---------------------------

578+ step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do

579+ r <- istep st

580+ return $ case r of

581+ Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)

582+ Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))

583+ Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)

519584

520− stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

521− r <- done fs

522− skip $ SplitOnSeqYield r SplitOnSeqDone

523− stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

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

525− r <- fstep fs (toEnum $ fromIntegral old)

585+-- XXX In general we can use different scheduling strategies e.g. how to

586+-- schedule the outer vs inner loop or assigning weights to different streams

587+-- or outer and inner loops.

588+--

589+-- This could be inefficient if the tasks are too small.

590+--

591+-- Compared to concatUnfoldInterleave this one switches streams on Skips.

592+--

593+{-# INLINE_NORMAL concatUnfoldRoundrobin #-}

594+concatUnfoldRoundrobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b

595+concatUnfoldRoundrobin (Unfold istep inject) (Stream ostep ost) =

596+ Stream step (ConcatUnfoldInterleaveOuter ost [])

597+ where

598+ {-# INLINE_LATE step #-}

599+ step gst (ConcatUnfoldInterleaveOuter o ls) = do

600+ r <- ostep (adaptState gst) o

526601 case r of

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

528− FL.Done b -> do

529− fs1 <- initial

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

531− skip $ SplitOnSeqYield b next

532−

533− stepOuter gst (SplitOnSeqWordInit st0) =

534− go SPEC 0 0 st0

602+ Yield a o' -> do

603+ i <- inject a

604+ i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))

605+ Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)

606+ Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

535607

536− where

608+ step _ (ConcatUnfoldInterleaveInner o []) =

609+ return $ Skip (ConcatUnfoldInterleaveOuter o [])

537610

538− {-# INLINE go #-}

539− go !_ !idx !wrd !st = do

540− res <- step (adaptState gst) st

541− case res of

542− Yield x s -> do

543− let wrd1 = addToWord wrd x

544− if idx == maxIndex

545− then do

546− fs <- initial

547− if wrd1 .&. wordMask == wordPat

548− then do

549− r <- done fs

550− let next = SplitOnSeqWordInit s

551− skip $ SplitOnSeqYield r next

552− else skip $ SplitOnSeqWordLoop wrd1 s fs

553− else go SPEC (idx + 1) wrd1 s

554− Skip s -> go SPEC idx wrd s

555− Stop -> do

556− fs <- initial

557− if idx /= 0

558− then skip $ SplitOnSeqWordDone idx fs wrd

559− else do

560− r <- done fs

561− skip $ SplitOnSeqYield r SplitOnSeqDone

562−

563− stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

564− go SPEC wrd0 st0 fs0

611+ step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do

612+ r <- istep st

613+ return $ case r of

614+ Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))

615+ Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))

616+ Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)

565617

566− where

618+ step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop

619+ step _ (ConcatUnfoldInterleaveInnerL [] rs) =

620+ return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)

567621

568− {-# INLINE go #-}

569− go !_ !wrd !st !fs = do

570− res <- step (adaptState gst) st

571− case res of

572− Yield x s -> do

573− let wrd1 = addToWord wrd x

574− old = (wordMask .&. wrd)

575− `shiftR` (elemBits * (patLen - 1))

576− r <- fstep fs (toEnum $ fromIntegral old)

577− case r of

578− FL.Partial fs1 -> do

579− if wrd1 .&. wordMask == wordPat

580− then do

581− b <- done fs1

582− let next = SplitOnSeqWordInit s

583− skip $ SplitOnSeqYield b next

584− else go SPEC wrd1 s fs1

585− FL.Done b ->

586− let next = SplitOnSeqWordInit s

587− in skip $ SplitOnSeqYield b next

588− Skip s -> go SPEC wrd s fs

589− Stop -> skip $ SplitOnSeqWordDone patLen fs wrd

622+ step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do

623+ r <- istep st

624+ return $ case r of

625+ Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))

626+ Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))

627+ Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)

590628

591− -------------------------------

592− -- General Pattern - Karp Rabin

593− -------------------------------

629+ step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop

630+ step _ (ConcatUnfoldInterleaveInnerR ls []) =

631+ return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

594632

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

596− res <- step (adaptState gst) st

597− case res of

598− Yield x s -> do

599− rh1 <- liftIO $ RB.unsafeInsert rb rh x

600− if idx == maxIndex

601− then do

602− let fold = RB.unsafeFoldRing (RB.ringBound rb)

603− let !ringHash = fold addCksum 0 rb

604− fs <- initial

605− if ringHash == patHash

606− then skip $ SplitOnSeqKRCheck fs s rb rh1

607− else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash

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

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

610− Stop -> do

611− fs <- initial

612− skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)

633+ step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do

634+ r <- istep st

635+ return $ case r of

636+ Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)

637+ Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)

638+ Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)

613639

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

615− -- code commented out below. Perhaps its more efficient because of

616− -- factoring out "rb" outside the loop.

617− --

618− stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =

619− go SPEC fs0 st0 rh0 cksum0

640+------------------------------------------------------------------------------

641+-- Combine N Streams - interpose

642+------------------------------------------------------------------------------

620643

621− where

644+{-# ANN type InterposeSuffixState Fuse #-}

645+data InterposeSuffixState s1 i1 =

646+ InterposeSuffixFirst s1

647+ -- | InterposeSuffixFirstYield s1 i1

648+ | InterposeSuffixFirstInner s1 i1

649+ | InterposeSuffixSecond s1

622650

623− go !_ !fs !st !rh !cksum = do

624− res <- step (adaptState gst) st

625− case res of

626− Yield x s -> do

627− old <- liftIO $ peek rh

628− let cksum1 = deltaCksum cksum old x

629− r <- fstep fs old

630− case r of

631− FL.Partial fs1 -> do

632− rh1 <- liftIO (RB.unsafeInsert rb rh x)

633− if cksum1 == patHash

634− then skip $ SplitOnSeqKRCheck fs1 s rb rh1

635− else go SPEC fs1 s rh1 cksum1

636− FL.Done b ->

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

638− in skip $ SplitOnSeqYield b next

639− Skip s -> go SPEC fs s rh cksum

640− Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh

651+-- Note that if an unfolded layer turns out to be nil we still emit the

652+-- separator effect. An alternate behavior could be to emit the separator

653+-- effect only if at least one element has been yielded by the unfolding.

654+-- However, that becomes a bit complicated, so we have chosen the former

655+-- behvaior for now.

656+{-# INLINE_NORMAL interposeSuffix #-}

657+interposeSuffix

658+ :: Monad m

659+ => m c -> Unfold m b c -> Stream m b -> Stream m c

660+interposeSuffix

661+ action

662+ (Unfold istep1 inject1) (Stream step1 state1) =

663+ Stream step (InterposeSuffixFirst state1)

641664

642− -- XXX The following code is 5 times slower compared to the recursive loop

643− -- based code above. Need to investigate why. One possibility is that the

644− -- go loop above does not thread around the ring buffer (rb). This code may

645− -- be causing the state to bloat and getting allocated on each iteration.

646− -- We can check the cmm/asm code to confirm. If so a good GHC solution to

647− -- such problem is needed. One way to avoid this could be to use unboxed

648− -- mutable state?

649− {-

650− stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do

651− res <- step (adaptState gst) st

652− case res of

653− Yield x s -> do

654− old <- liftIO $ peek rh

655− let cksum1 = deltaCksum cksum old x

656− fs1 <- fstep fs old

657− if (cksum1 == patHash)

658− then do

659− r <- done fs1

660− skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh

661− else do

662− rh1 <- liftIO (RB.unsafeInsert rb rh x)

663− skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1

664− Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum

665− Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh

666− -}

665+ where

667666

668− stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

669− if RB.unsafeEqArray rb rh patArr

670− then do

671− r <- done fs

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

673− skip $ SplitOnSeqYield r next

674− else skip $ SplitOnSeqKRLoop fs st rb rh patHash

675− stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

676− r <- done fs

677− skip $ SplitOnSeqYield r SplitOnSeqDone

678− stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

679− old <- liftIO $ peek rh

680− let rh1 = RB.advance rb rh

681− r <- fstep fs old

667+ {-# INLINE_LATE step #-}

668+ step gst (InterposeSuffixFirst s1) = do

669+ r <- step1 (adaptState gst) s1

682670 case r of

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

684− FL.Done b -> do

685− fs1 <- initial

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

687− skip $ SplitOnSeqYield b next

688−

689−{-# ANN type SplitOnSuffixSeqState Fuse #-}

690−data SplitOnSuffixSeqState rb rh ck w fs s b x =

691− SplitOnSuffixSeqInit

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

693− | SplitOnSuffixSeqDone

671+ Yield a s -> do

672+ i <- inject1 a

673+ i `seq` return (Skip (InterposeSuffixFirstInner s i))

674+ -- i `seq` return (Skip (InterposeSuffixFirstYield s i))

675+ Skip s -> return $ Skip (InterposeSuffixFirst s)

676+ Stop -> return Stop

694677

695− | SplitOnSuffixSeqEmpty s

678+ {-

679+ step _ (InterposeSuffixFirstYield s1 i1) = do

680+ r <- istep1 i1

681+ return $ case r of

682+ Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')

683+ Skip i' -> Skip (InterposeSuffixFirstYield s1 i')

684+ Stop -> Skip (InterposeSuffixFirst s1)

685+ -}

696686

697− | SplitOnSuffixSeqSingleInit s x

698− | SplitOnSuffixSeqSingle !fs s x

687+ step _ (InterposeSuffixFirstInner s1 i1) = do

688+ r <- istep1 i1

689+ return $ case r of

690+ Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')

691+ Skip i' -> Skip (InterposeSuffixFirstInner s1 i')

692+ Stop -> Skip (InterposeSuffixSecond s1)

699693

700− | SplitOnSuffixSeqWordInit s

701− | SplitOnSuffixSeqWordLoop !w s !fs

702− | SplitOnSuffixSeqWordDone Int !fs !w

694+ step _ (InterposeSuffixSecond s1) = do

695+ r <- action

696+ return $ Yield r (InterposeSuffixFirst s1)

703697

704− | SplitOnSuffixSeqKRInit Int s rb !rh

705− | SplitOnSuffixSeqKRInit1 !fs s rb !rh

706− | SplitOnSuffixSeqKRLoop fs s rb !rh !ck

707− | SplitOnSuffixSeqKRCheck fs s rb !rh

708− | SplitOnSuffixSeqKRDone Int !fs rb !rh

698+{-# ANN type InterposeState Fuse #-}

699+data InterposeState s1 i1 a =

700+ InterposeFirst s1

701+ -- | InterposeFirstYield s1 i1

702+ | InterposeFirstInner s1 i1

703+ | InterposeFirstInject s1

704+ -- | InterposeFirstBuf s1 i1

705+ | InterposeSecondYield s1 i1

706+ -- -- | InterposeSecondYield s1 i1 a

707+ -- -- | InterposeFirstResume s1 i1 a

709708

710−{-# INLINE_NORMAL splitOnSuffixSeq #-}

711−splitOnSuffixSeq

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

713− => Bool

714− -> Array a

715− -> Fold m a b

716− -> Stream m a

717− -> Stream m b

718−splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

719− Stream stepOuter SplitOnSuffixSeqInit

709+-- Note that this only interposes the pure values, we may run many effects to

710+-- generate those values as some effects may not generate anything (Skip).

711+{-# INLINE_NORMAL interpose #-}

712+interpose :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c

713+interpose

714+ action

715+ (Unfold istep1 inject1) (Stream step1 state1) =

716+ Stream step (InterposeFirst state1)

720717

721718 where

722719

723− patLen = A.length patArr

724− maxIndex = patLen - 1

725− elemBits = sizeOf (undefined :: a) * 8

726−

727− -- For word pattern case

728− wordMask :: Word

729− wordMask = (1 `shiftL` (elemBits * patLen)) - 1

730−

731− elemMask :: Word

732− elemMask = (1 `shiftL` elemBits) - 1

733−

734− wordPat :: Word

735− wordPat = wordMask .&. A.foldl' addToWord 0 patArr

720+ {-# INLINE_LATE step #-}

721+ step gst (InterposeFirst s1) = do

722+ r <- step1 (adaptState gst) s1

723+ case r of

724+ Yield a s -> do

725+ i <- inject1 a

726+ i `seq` return (Skip (InterposeFirstInner s i))

727+ -- i `seq` return (Skip (InterposeFirstYield s i))

728+ Skip s -> return $ Skip (InterposeFirst s)

729+ Stop -> return Stop

736730

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

731+ {-

732+ step _ (InterposeFirstYield s1 i1) = do

733+ r <- istep1 i1

734+ return $ case r of

735+ Yield x i' -> Yield x (InterposeFirstInner s1 i')

736+ Skip i' -> Skip (InterposeFirstYield s1 i')

737+ Stop -> Skip (InterposeFirst s1)

738+ -}

738739

739− -- For single element pattern case

740− {-# INLINE processYieldSingle #-}

741− processYieldSingle pat x s fs =

742− if pat == x

743− then do

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

745− case r of

746− FL.Partial fs1 -> do

747− b <- done fs1

748− let next = SplitOnSuffixSeqSingleInit s pat

749− skip $ SplitOnSuffixSeqYield b next

750− FL.Done b ->

751− let next = SplitOnSuffixSeqSingleInit s pat

752− in skip $ SplitOnSuffixSeqYield b next

753− else do

754− r <- fstep fs x

755− case r of

756− FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat

757− FL.Done b ->

758− let next = SplitOnSuffixSeqSingleInit s pat

759− in skip $ SplitOnSuffixSeqYield b next

740+ step _ (InterposeFirstInner s1 i1) = do

741+ r <- istep1 i1

742+ return $ case r of

743+ Yield x i' -> Yield x (InterposeFirstInner s1 i')

744+ Skip i' -> Skip (InterposeFirstInner s1 i')

745+ Stop -> Skip (InterposeFirstInject s1)

760746

761− -- For Rabin-Karp search

762− k = 2891336453 :: Word32

763− coeff = k ^ patLen

747+ step gst (InterposeFirstInject s1) = do

748+ r <- step1 (adaptState gst) s1

749+ case r of

750+ Yield a s -> do

751+ i <- inject1 a

752+ -- i `seq` return (Skip (InterposeFirstBuf s i))

753+ i `seq` return (Skip (InterposeSecondYield s i))

754+ Skip s -> return $ Skip (InterposeFirstInject s)

755+ Stop -> return Stop

764756

765− addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

757+ {-

758+ step _ (InterposeFirstBuf s1 i1) = do

759+ r <- istep1 i1

760+ return $ case r of

761+ Yield x i' -> Skip (InterposeSecondYield s1 i' x)

762+ Skip i' -> Skip (InterposeFirstBuf s1 i')

763+ Stop -> Stop

764+ -}

766765

767− deltaCksum cksum old new =

768− addCksum cksum new - coeff * fromIntegral (fromEnum old)

766+ {-

767+ step _ (InterposeSecondYield s1 i1 v) = do

768+ r <- action

769+ return $ Yield r (InterposeFirstResume s1 i1 v)

770+ -}

771+ step _ (InterposeSecondYield s1 i1) = do

772+ r <- action

773+ return $ Yield r (InterposeFirstInner s1 i1)

769774

770− -- XXX shall we use a random starting hash or 1 instead of 0?

771− patHash = A.foldl' addCksum 0 patArr

775+ {-

776+ step _ (InterposeFirstResume s1 i1 v) = do

777+ return $ Yield v (InterposeFirstInner s1 i1)

778+ -}

772779

773− skip = return . Skip

780+------------------------------------------------------------------------------

781+-- Combine N Streams - intercalate

782+------------------------------------------------------------------------------

774783

775− {-# INLINE_LATE stepOuter #-}

776− stepOuter _ SplitOnSuffixSeqInit =

777− if patLen == 0

778− then skip $ SplitOnSuffixSeqEmpty state

779− else if patLen == 1

780− then do

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

782− skip $ SplitOnSuffixSeqSingleInit state pat

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

784− <= sizeOf (undefined :: Word)

785− then skip $ SplitOnSuffixSeqWordInit state

786− else do

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

788− skip $ SplitOnSuffixSeqKRInit 0 state rb rhead

784+data ICUState s1 s2 i1 i2 =

785+ ICUFirst s1 s2

786+ | ICUSecond s1 s2

787+ | ICUSecondOnly s2

788+ | ICUFirstOnly s1

789+ | ICUFirstInner s1 s2 i1

790+ | ICUSecondInner s1 s2 i2

791+ | ICUFirstOnlyInner s1 i1

792+ | ICUSecondOnlyInner s2 i2

789793

790− stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next

794+-- | Interleave streams (full streams, not the elements) unfolded from two

795+-- input streams and concat. Stop when the first stream stops. If the second

796+-- stream ends before the first one then first stream still keeps running alone

797+-- without any interleaving with the second stream.

798+--

799+-- [a1, a2, ... an] [b1, b2 ...]

800+-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]

801+-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]

802+-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]

803+--

804+{-# INLINE_NORMAL gintercalateSuffix #-}

805+gintercalateSuffix

806+ :: Monad m

807+ => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c

808+gintercalateSuffix

809+ (Unfold istep1 inject1) (Stream step1 state1)

810+ (Unfold istep2 inject2) (Stream step2 state2) =

811+ Stream step (ICUFirst state1 state2)

791812

792− ---------------------------

793− -- Empty pattern

794− ---------------------------

813+ where

795814

796− stepOuter gst (SplitOnSuffixSeqEmpty st) = do

797− res <- step (adaptState gst) st

798− case res of

799− Yield x s -> do

800− acc <- initial

801− r <- fstep acc x

802− case r of

803− FL.Partial fs -> do

804− b <- done fs

805− skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

806− FL.Done b ->

807− skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

808− Skip s -> skip (SplitOnSuffixSeqEmpty s)

815+ {-# INLINE_LATE step #-}

816+ step gst (ICUFirst s1 s2) = do

817+ r <- step1 (adaptState gst) s1

818+ case r of

819+ Yield a s -> do

820+ i <- inject1 a

821+ i `seq` return (Skip (ICUFirstInner s s2 i))

822+ Skip s -> return $ Skip (ICUFirst s s2)

809823 Stop -> return Stop

810824

811− -----------------

812− -- Done

813− -----------------

814−

815− stepOuter _ SplitOnSuffixSeqDone = return Stop

816−

817− -----------------

818− -- Single Pattern

819− -----------------

820−

821− stepOuter gst (SplitOnSuffixSeqSingleInit st pat) = do

822− res <- step (adaptState gst) st

823− case res of

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

825− Skip s -> skip $ SplitOnSuffixSeqSingleInit s pat

825+ step gst (ICUFirstOnly s1) = do

826+ r <- step1 (adaptState gst) s1

827+ case r of

828+ Yield a s -> do

829+ i <- inject1 a

830+ i `seq` return (Skip (ICUFirstOnlyInner s i))

831+ Skip s -> return $ Skip (ICUFirstOnly s)

826832 Stop -> return Stop

827833

828− stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

829− res <- step (adaptState gst) st

830− case res of

831− Yield x s -> processYieldSingle pat x s fs

832− Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat

833− Stop -> do

834− r <- done fs

835− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

834+ step _ (ICUFirstInner s1 s2 i1) = do

835+ r <- istep1 i1

836+ return $ case r of

837+ Yield x i' -> Yield x (ICUFirstInner s1 s2 i')

838+ Skip i' -> Skip (ICUFirstInner s1 s2 i')

839+ Stop -> Skip (ICUSecond s1 s2)

836840

837− ---------------------------

838− -- Short Pattern - Shift Or

839− ---------------------------

841+ step _ (ICUFirstOnlyInner s1 i1) = do

842+ r <- istep1 i1

843+ return $ case r of

844+ Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')

845+ Skip i' -> Skip (ICUFirstOnlyInner s1 i')

846+ Stop -> Skip (ICUFirstOnly s1)

840847

841− stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do

842− r <- done fs

843− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

844− stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do

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

846− r <- fstep fs (toEnum $ fromIntegral old)

848+ step gst (ICUSecond s1 s2) = do

849+ r <- step2 (adaptState gst) s2

847850 case r of

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

849− FL.Done b -> do

850− fs1 <- initial

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

852− skip $ SplitOnSuffixSeqYield b next

851+ Yield a s -> do

852+ i <- inject2 a

853+ i `seq` return (Skip (ICUSecondInner s1 s i))

854+ Skip s -> return $ Skip (ICUSecond s1 s)

855+ Stop -> return $ Skip (ICUFirstOnly s1)

853856

854− stepOuter gst (SplitOnSuffixSeqWordInit st0) = do

855− res <- step (adaptState gst) st0

856− case res of

857− Yield x s -> do

858− fs <- initial

859− let wrd = addToWord 0 x

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

861− case r of

862− FL.Partial fs1 -> go SPEC 1 wrd s fs1

863− FL.Done b -> do

864− let next = SplitOnSuffixSeqWordInit s

865− in skip $ SplitOnSuffixSeqYield b next

866− Skip s -> skip (SplitOnSuffixSeqWordInit s)

867− Stop -> return Stop

857+ step _ (ICUSecondInner s1 s2 i2) = do

858+ r <- istep2 i2

859+ return $ case r of

860+ Yield x i' -> Yield x (ICUSecondInner s1 s2 i')

861+ Skip i' -> Skip (ICUSecondInner s1 s2 i')

862+ Stop -> Skip (ICUFirst s1 s2)

868863

869− where

864+ step _ (ICUSecondOnly _s2) = undefined

865+ step _ (ICUSecondOnlyInner _s2 _i2) = undefined

870866

871− {-# INLINE go #-}

872− go !_ !idx !wrd !st !fs = do

873− res <- step (adaptState gst) st

874− case res of

875− Yield x s -> do

876− let wrd1 = addToWord wrd x

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

878− case r of

879− FL.Partial fs1 ->

880− if idx /= maxIndex

881− then go SPEC (idx + 1) wrd1 s fs1

882− else if wrd1 .&. wordMask /= wordPat

883− then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

884− else do

885− b <- done fs

886− let next = SplitOnSuffixSeqWordInit s

887− skip $ SplitOnSuffixSeqYield b next

888− FL.Done b ->

889− let next = SplitOnSuffixSeqWordInit s

890− in skip $ SplitOnSuffixSeqYield b next

891− Skip s -> go SPEC idx wrd s fs

892− Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

867+data ICALState s1 s2 i1 i2 a =

868+ ICALFirst s1 s2

869+ -- | ICALFirstYield s1 s2 i1

870+ | ICALFirstInner s1 s2 i1

871+ | ICALFirstOnly s1

872+ | ICALFirstOnlyInner s1 i1

873+ | ICALSecondInject s1 s2

874+ | ICALFirstInject s1 s2 i2

875+ -- | ICALFirstBuf s1 s2 i1 i2

876+ | ICALSecondInner s1 s2 i1 i2

877+ -- -- | ICALSecondInner s1 s2 i1 i2 a

878+ -- -- | ICALFirstResume s1 s2 i1 i2 a

893879

894− stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =

895− go SPEC wrd0 st0 fs0

880+-- | Interleave streams (full streams, not the elements) unfolded from two

881+-- input streams and concat. Stop when the first stream stops. If the second

882+-- stream ends before the first one then first stream still keeps running alone

883+-- without any interleaving with the second stream.

884+--

885+-- [a1, a2, ... an] [b1, b2 ...]

886+-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]

887+-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]

888+-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]

889+--

890+{-# INLINE_NORMAL gintercalate #-}

891+gintercalate

892+ :: Monad m

893+ => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c

894+gintercalate

895+ (Unfold istep1 inject1) (Stream step1 state1)

896+ (Unfold istep2 inject2) (Stream step2 state2) =

897+ Stream step (ICALFirst state1 state2)

898+

899+ where

900+

901+ {-# INLINE_LATE step #-}

902+ step gst (ICALFirst s1 s2) = do

903+ r <- step1 (adaptState gst) s1

904+ case r of

905+ Yield a s -> do

906+ i <- inject1 a

907+ i `seq` return (Skip (ICALFirstInner s s2 i))

908+ -- i `seq` return (Skip (ICALFirstYield s s2 i))

909+ Skip s -> return $ Skip (ICALFirst s s2)

910+ Stop -> return Stop

911+

912+ {-

913+ step _ (ICALFirstYield s1 s2 i1) = do

914+ r <- istep1 i1

915+ return $ case r of

916+ Yield x i' -> Yield x (ICALFirstInner s1 s2 i')

917+ Skip i' -> Skip (ICALFirstYield s1 s2 i')

918+ Stop -> Skip (ICALFirst s1 s2)

919+ -}

920+

921+ step _ (ICALFirstInner s1 s2 i1) = do

922+ r <- istep1 i1

923+ return $ case r of

924+ Yield x i' -> Yield x (ICALFirstInner s1 s2 i')

925+ Skip i' -> Skip (ICALFirstInner s1 s2 i')

926+ Stop -> Skip (ICALSecondInject s1 s2)

927+

928+ step gst (ICALFirstOnly s1) = do

929+ r <- step1 (adaptState gst) s1

930+ case r of

931+ Yield a s -> do

932+ i <- inject1 a

933+ i `seq` return (Skip (ICALFirstOnlyInner s i))

934+ Skip s -> return $ Skip (ICALFirstOnly s)

935+ Stop -> return Stop

936+

937+ step _ (ICALFirstOnlyInner s1 i1) = do

938+ r <- istep1 i1

939+ return $ case r of

940+ Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')

941+ Skip i' -> Skip (ICALFirstOnlyInner s1 i')

942+ Stop -> Skip (ICALFirstOnly s1)

943+

944+ -- We inject the second stream even before checking if the first stream

945+ -- would yield any more elements. There is no clear choice whether we

946+ -- should do this before or after that. Doing it after may make the state

947+ -- machine a bit simpler though.

948+ step gst (ICALSecondInject s1 s2) = do

949+ r <- step2 (adaptState gst) s2

950+ case r of

951+ Yield a s -> do

952+ i <- inject2 a

953+ i `seq` return (Skip (ICALFirstInject s1 s i))

954+ Skip s -> return $ Skip (ICALSecondInject s1 s)

955+ Stop -> return $ Skip (ICALFirstOnly s1)

956+

957+ step gst (ICALFirstInject s1 s2 i2) = do

958+ r <- step1 (adaptState gst) s1

959+ case r of

960+ Yield a s -> do

961+ i <- inject1 a

962+ i `seq` return (Skip (ICALSecondInner s s2 i i2))

963+ -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))

964+ Skip s -> return $ Skip (ICALFirstInject s s2 i2)

965+ Stop -> return Stop

966+

967+ {-

968+ step _ (ICALFirstBuf s1 s2 i1 i2) = do

969+ r <- istep1 i1

970+ return $ case r of

971+ Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)

972+ Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)

973+ Stop -> Stop

974+

975+ step _ (ICALSecondInner s1 s2 i1 i2 v) = do

976+ r <- istep2 i2

977+ return $ case r of

978+ Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)

979+ Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)

980+ Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)

981+ -}

982+

983+ step _ (ICALSecondInner s1 s2 i1 i2) = do

984+ r <- istep2 i2

985+ return $ case r of

986+ Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')

987+ Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')

988+ Stop -> Skip (ICALFirstInner s1 s2 i1)

989+ -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)

990+

991+ {-

992+ step _ (ICALFirstResume s1 s2 i1 i2 x) = do

993+ return $ Yield x (ICALFirstInner s1 s2 i1 i2)

994+ -}

995+

996+------------------------------------------------------------------------------

997+-- Parsing

998+------------------------------------------------------------------------------

999+

1000+{-# ANN type ParseChunksState Fuse #-}

1001+data ParseChunksState x inpBuf st pst =

1002+ ParseChunksInit inpBuf st

1003+ | ParseChunksInitLeftOver inpBuf

1004+ | ParseChunksStream st inpBuf !pst

1005+ | ParseChunksBuf inpBuf st inpBuf !pst

1006+ | ParseChunksYield x (ParseChunksState x inpBuf st pst)

1007+

1008+{-# INLINE_NORMAL parseMany #-}

1009+parseMany

1010+ :: MonadThrow m

1011+ => PRD.Parser m a b

1012+ -> Stream m a

1013+ -> Stream m b

1014+parseMany (PRD.Parser pstep initial extract) (Stream step state) =

1015+ Stream stepOuter (ParseChunksInit [] state)

1016+

1017+ where

1018+

1019+ {-# INLINE_LATE stepOuter #-}

1020+ -- Buffer is empty, get the first element from the stream, initialize the

1021+ -- fold and then go to stream processing loop.

1022+ stepOuter gst (ParseChunksInit [] st) = do

1023+ r <- step (adaptState gst) st

1024+ case r of

1025+ Yield x s -> initial >>= return . Skip . ParseChunksBuf [x] s []

1026+ Skip s -> return $ Skip $ ParseChunksInit [] s

1027+ Stop -> return Stop

1028+

1029+ -- Buffer is not empty, go to buffered processing loop

1030+ stepOuter _ (ParseChunksInit src st) = do

1031+ initial >>= return . Skip . ParseChunksBuf src st []

1032+

1033+ -- XXX we just discard any leftover input at the end

1034+ stepOuter _ (ParseChunksInitLeftOver _) = return Stop

1035+

1036+ -- Buffer is empty, process elements from the stream

1037+ stepOuter gst (ParseChunksStream st buf pst) = do

1038+ r <- step (adaptState gst) st

1039+ case r of

1040+ Yield x s -> do

1041+ pRes <- pstep pst x

1042+ case pRes of

1043+ PR.Partial 0 pst1 ->

1044+ return $ Skip $ ParseChunksStream s [] pst1

1045+ PR.Partial n pst1 -> do

1046+ assert (n <= length (x:buf)) (return ())

1047+ let src0 = Prelude.take n (x:buf)

1048+ src = Prelude.reverse src0

1049+ return $ Skip $ ParseChunksBuf src s [] pst1

1050+ PR.Continue 0 pst1 ->

1051+ return $ Skip $ ParseChunksStream s (x:buf) pst1

1052+ PR.Continue n pst1 -> do

1053+ assert (n <= length (x:buf)) (return ())

1054+ let (src0, buf1) = splitAt n (x:buf)

1055+ src = Prelude.reverse src0

1056+ return $ Skip $ ParseChunksBuf src s buf1 pst1

1057+ PR.Done 0 b -> do

1058+ return $ Skip $

1059+ ParseChunksYield b (ParseChunksInit [] s)

1060+ PR.Done n b -> do

1061+ assert (n <= length (x:buf)) (return ())

1062+ let src = Prelude.reverse (Prelude.take n (x:buf))

1063+ return $ Skip $

1064+ ParseChunksYield b (ParseChunksInit src s)

1065+ PR.Error err -> throwM $ ParseError err

1066+ Skip s -> return $ Skip $ ParseChunksStream s buf pst

1067+ Stop -> do

1068+ b <- extract pst

1069+ let src = Prelude.reverse buf

1070+ return $ Skip $

1071+ ParseChunksYield b (ParseChunksInitLeftOver src)

1072+

1073+ -- go back to stream processing mode

1074+ stepOuter _ (ParseChunksBuf [] s buf pst) =

1075+ return $ Skip $ ParseChunksStream s buf pst

1076+

1077+ -- buffered processing loop

1078+ stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do

1079+ pRes <- pstep pst x

1080+ case pRes of

1081+ PR.Partial 0 pst1 ->

1082+ return $ Skip $ ParseChunksBuf xs s [] pst1

1083+ PR.Partial n pst1 -> do

1084+ assert (n <= length (x:buf)) (return ())

1085+ let src0 = Prelude.take n (x:buf)

1086+ src = Prelude.reverse src0 ++ xs

1087+ return $ Skip $ ParseChunksBuf src s [] pst1

1088+ PR.Continue 0 pst1 ->

1089+ return $ Skip $ ParseChunksBuf xs s (x:buf) pst1

1090+ PR.Continue n pst1 -> do

1091+ assert (n <= length (x:buf)) (return ())

1092+ let (src0, buf1) = splitAt n (x:buf)

1093+ src = Prelude.reverse src0 ++ xs

1094+ return $ Skip $ ParseChunksBuf src s buf1 pst1

1095+ PR.Done 0 b ->

1096+ return $ Skip $ ParseChunksYield b (ParseChunksInit xs s)

1097+ PR.Done n b -> do

1098+ assert (n <= length (x:buf)) (return ())

1099+ let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1100+ return $ Skip $ ParseChunksYield b (ParseChunksInit src s)

1101+ PR.Error err -> throwM $ ParseError err

1102+

1103+ stepOuter _ (ParseChunksYield a next) = return $ Yield a next

1104+

1105+{-# ANN type ConcatParseState Fuse #-}

1106+data ConcatParseState x inpBuf st p =

1107+ ConcatParseInit inpBuf st p

1108+ | ConcatParseInitLeftOver inpBuf

1109+ | ConcatParseStream st inpBuf p

1110+ | ConcatParseBuf inpBuf st inpBuf p

1111+ | ConcatParseYield x (ConcatParseState x inpBuf st p)

1112+

1113+{-# INLINE_NORMAL parseIterate #-}

1114+parseIterate

1115+ :: MonadThrow m

1116+ => (b -> PRD.Parser m a b)

1117+ -> b

1118+ -> Stream m a

1119+ -> Stream m b

1120+parseIterate func seed (Stream step state) =

1121+ Stream stepOuter (ConcatParseInit [] state (func seed))

1122+

1123+ where

1124+

1125+ {-# INLINE_LATE stepOuter #-}

1126+ -- Buffer is empty, go to stream processing loop

1127+ stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do

1128+ initial >>= \r -> return $ Skip $ ConcatParseStream st []

1129+ (PRD.Parser pstep (return r) extract)

1130+

1131+ -- Buffer is not empty, go to buffered processing loop

1132+ stepOuter _ (ConcatParseInit src st

1133+ (PRD.Parser pstep initial extract)) = do

1134+ initial >>= \r -> return $ Skip $ ConcatParseBuf src st []

1135+ (PRD.Parser pstep (return r) extract)

1136+

1137+ -- XXX we just discard any leftover input at the end

1138+ stepOuter _ (ConcatParseInitLeftOver _) = return Stop

1139+

1140+ -- Buffer is empty process elements from the stream

1141+ stepOuter gst (ConcatParseStream st buf

1142+ p@(PRD.Parser pstep initial extract)) = do

1143+ r <- step (adaptState gst) st

1144+ case r of

1145+ Yield x s -> do

1146+ pst <- initial

1147+ pRes <- pstep pst x

1148+ case pRes of

1149+ PR.Partial 0 pst1 ->

1150+ return $ Skip $ ConcatParseStream s []

1151+ (PRD.Parser pstep (return pst1) extract)

1152+ PR.Partial n pst1 -> do

1153+ assert (n <= length (x:buf)) (return ())

1154+ let src0 = Prelude.take n (x:buf)

1155+ src = Prelude.reverse src0

1156+ return $ Skip $ ConcatParseBuf src s []

1157+ (PRD.Parser pstep (return pst1) extract)

1158+ -- PR.Continue 0 pst1 ->

1159+ -- return $ Skip $ ConcatParseStream s (x:buf) pst1

1160+ PR.Continue n pst1 -> do

1161+ assert (n <= length (x:buf)) (return ())

1162+ let (src0, buf1) = splitAt n (x:buf)

1163+ src = Prelude.reverse src0

1164+ return $ Skip $ ConcatParseBuf src s buf1

1165+ (PRD.Parser pstep (return pst1) extract)

1166+ -- XXX Specialize for Stop 0 common case?

1167+ PR.Done n b -> do

1168+ assert (n <= length (x:buf)) (return ())

1169+ let src = Prelude.reverse (Prelude.take n (x:buf))

1170+ return $ Skip $

1171+ ConcatParseYield b (ConcatParseInit src s (func b))

1172+ PR.Error err -> throwM $ ParseError err

1173+ Skip s -> return $ Skip $ ConcatParseStream s buf p

1174+ Stop -> do

1175+ pst <- initial

1176+ b <- extract pst

1177+ let src = Prelude.reverse buf

1178+ return $ Skip $

1179+ ConcatParseYield b (ConcatParseInitLeftOver src)

1180+

1181+ -- go back to stream processing mode

1182+ stepOuter _ (ConcatParseBuf [] s buf p) =

1183+ return $ Skip $ ConcatParseStream s buf p

1184+

1185+ -- buffered processing loop

1186+ stepOuter _ (ConcatParseBuf (x:xs) s buf

1187+ (PRD.Parser pstep initial extract)) = do

1188+ pst <- initial

1189+ pRes <- pstep pst x

1190+ case pRes of

1191+ PR.Partial 0 pst1 ->

1192+ return $ Skip $ ConcatParseBuf xs s []

1193+ (PRD.Parser pstep (return pst1) extract)

1194+ PR.Partial n pst1 -> do

1195+ assert (n <= length (x:buf)) (return ())

1196+ let src0 = Prelude.take n (x:buf)

1197+ src = Prelude.reverse src0 ++ xs

1198+ return $ Skip $ ConcatParseBuf src s []

1199+ (PRD.Parser pstep (return pst1) extract)

1200+ -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1

1201+ PR.Continue n pst1 -> do

1202+ assert (n <= length (x:buf)) (return ())

1203+ let (src0, buf1) = splitAt n (x:buf)

1204+ src = Prelude.reverse src0 ++ xs

1205+ return $ Skip $ ConcatParseBuf src s buf1

1206+ (PRD.Parser pstep (return pst1) extract)

1207+ -- XXX Specialize for Stop 0 common case?

1208+ PR.Done n b -> do

1209+ assert (n <= length (x:buf)) (return ())

1210+ let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1211+ return $ Skip $ ConcatParseYield b

1212+ (ConcatParseInit src s (func b))

1213+ PR.Error err -> throwM $ ParseError err

1214+

1215+ stepOuter _ (ConcatParseYield a next) = return $ Yield a next

1216+

1217+------------------------------------------------------------------------------

1218+-- Grouping

1219+------------------------------------------------------------------------------

1220+

1221+{-# INLINE_NORMAL groupsBy #-}

1222+groupsBy :: Monad m

1223+ => (a -> a -> Bool)

1224+ -> Fold m a b

1225+ -> Stream m a

1226+ -> Stream m b

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

1228+

1229+ where

1230+

1231+ {-# INLINE_LATE stepOuter #-}

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

1233+ res <- step (adaptState gst) st

1234+ case res of

1235+ Yield x s -> do

1236+ fs <- initial

1237+ r <- fstep fs x

1238+ case r of

1239+ FL.Partial fs1 -> go SPEC x s fs1

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

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

1242+ Stop -> return Stop

8961243

8971244 where

8981245

899− {-# INLINE go #-}

900− go !_ !wrd !st !fs = do

901− res <- step (adaptState gst) st

1246+ go !_ prev stt !acc = do

1247+ res <- step (adaptState gst) stt

9021248 case res of

9031249 Yield x s -> do

904− let wrd1 = addToWord wrd x

905− old = (wordMask .&. wrd)

906− `shiftR` (elemBits * (patLen - 1))

907− r <-

908− if withSep

909− then fstep fs x

910− else fstep fs (toEnum $ fromIntegral old)

911− case r of

912− FL.Partial fs1 ->

913− if wrd1 .&. wordMask == wordPat

914− then do

915− b <- done fs1

916− let next = SplitOnSuffixSeqWordInit s

917− skip $ SplitOnSuffixSeqYield b next

918− else go SPEC wrd1 s fs1

919− FL.Done b ->

920− let next = SplitOnSuffixSeqWordInit s

921− in skip $ SplitOnSuffixSeqYield b next

922− Skip s -> go SPEC wrd s fs

923− Stop ->

924− if wrd .&. wordMask == wordPat

925− then return Stop

926− else if withSep

1250+ if cmp x prev

9271251 then do

928− r <- done fs

929− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

930− else skip $ SplitOnSuffixSeqWordDone patLen fs wrd

1252+ r <- fstep acc x

1253+ case r of

1254+ FL.Partial fs1 -> go SPEC prev s fs1

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

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

1257+ Skip s -> go SPEC prev s acc

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

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

1260+ fs <- initial

1261+ r <- fstep fs prev

1262+ case r of

1263+ FL.Partial fs1 -> go SPEC st fs1

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

9311265

932− -------------------------------

933− -- General Pattern - Karp Rabin

934− -------------------------------

1266+ where

9351267

936− stepOuter gst (SplitOnSuffixSeqKRInit idx0 st0 rb rh0) = do

937− res <- step (adaptState gst) st0

1268+ -- XXX code duplicated from the previous equation

1269+ go !_ stt !acc = do

1270+ res <- step (adaptState gst) stt

1271+ case res of

1272+ Yield x s -> do

1273+ if cmp x prev

1274+ then do

1275+ r <- fstep acc x

1276+ case r of

1277+ FL.Partial fs1 -> go SPEC s fs1

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

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

1280+ Skip s -> go SPEC s acc

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

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

1283+

1284+{-# INLINE_NORMAL groupsRollingBy #-}

1285+groupsRollingBy :: Monad m

1286+ => (a -> a -> Bool)

1287+ -> Fold m a b

1288+ -> Stream m a

1289+ -> Stream m b

1290+groupsRollingBy cmp f (Stream step state) =

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

1292+

1293+ where

1294+

1295+ {-# INLINE_LATE stepOuter #-}

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

1297+ res <- step (adaptState gst) st

9381298 case res of

9391299 Yield x s -> do

940− rh1 <- liftIO $ RB.unsafeInsert rb rh0 x

9411300 fs <- initial

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

1301+ r <- fstep fs x

9431302 case r of

944− FL.Partial fs1 ->

945− skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1

946− FL.Done b ->

947− let next = SplitOnSuffixSeqKRInit 0 s rb (RB.startOf rb)

948− in skip $ SplitOnSuffixSeqYield b next

949− Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 s rb rh0

1303+ FL.Partial fs1 -> go SPEC x s fs1

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

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

9501306 Stop -> return Stop

9511307

952− stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

953− go SPEC 1 rh0 st0 fs0

1308+ where

1309+

1310+ go !_ prev stt !acc = do

1311+ res <- step (adaptState gst) stt

1312+ case res of

1313+ Yield x s -> do

1314+ if cmp prev x

1315+ then do

1316+ r <- fstep acc x

1317+ case r of

1318+ FL.Partial fs1 -> go SPEC x s fs1

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

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

1321+ Skip s -> go SPEC prev s acc

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

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

1324+ fs <- initial

1325+ r <- fstep fs prev'

1326+ case r of

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

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

9541329

9551330 where

9561331

957− go !_ !idx !rh st !fs = do

958− res <- step (adaptState gst) st

1332+ go !_ prevv stt !acc = do

1333+ res <- step (adaptState gst) stt

9591334 case res of

9601335 Yield x s -> do

961− rh1 <- liftIO (RB.unsafeInsert rb rh x)

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

963− case r of

964− FL.Partial fs1 ->

965− if idx /= maxIndex

966− then go SPEC (idx + 1) rh1 s fs1

967− else skip $

968− let fold = RB.unsafeFoldRing (RB.ringBound rb)

969− !ringHash = fold addCksum 0 rb

970− in if ringHash == patHash

971− then SplitOnSuffixSeqKRCheck fs1 s rb rh1

972− else SplitOnSuffixSeqKRLoop

973− fs1 s rb rh1 ringHash

974− FL.Done b ->

975− let next = SplitOnSuffixSeqKRInit

976− 0 st rb (RB.startOf rb)

977− in skip $ SplitOnSuffixSeqYield b next

978− Skip s -> go SPEC idx rh s fs

979− Stop -> do

980− -- do not issue a blank segment when we end at pattern

981− if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

982− then return Stop

983− else if withSep

1336+ if cmp prevv x

9841337 then do

985− r <- done fs

986− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

987− else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)

1338+ r <- fstep acc x

1339+ case r of

1340+ FL.Partial fs1 -> go SPEC x s fs1

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

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

1343+ Skip s -> go SPEC prevv s acc

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

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

9881346

989− stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =

990− go SPEC fs0 st0 rh0 cksum0

1347+------------------------------------------------------------------------------

1348+-- Splitting - by a predicate

1349+------------------------------------------------------------------------------

1350+

1351+data WordsByState s = WordsByJust s | WordsByNothing

1352+

1353+{-# INLINE_NORMAL wordsBy #-}

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

1355+wordsBy predicate f (Stream step state) =

1356+ Stream (stepOuter f) (WordsByJust state)

1357+

1358+ where

1359+

1360+ {-# INLINE_LATE stepOuter #-}

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

1362+ res <- step (adaptState gst) st

1363+ case res of

1364+ Yield x s -> do

1365+ if predicate x

1366+ then return $ Skip (WordsByJust s)

1367+ else do

1368+ fs <- initial

1369+ r <- fstep fs x

1370+ case r of

1371+ FL.Partial fs1 -> go SPEC s fs1

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

1373+

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

1375+ Stop -> return Stop

9911376

9921377 where

9931378

994− go !_ !fs !st !rh !cksum = do

995− res <- step (adaptState gst) st

1379+ go !_ stt !acc = do

1380+ res <- step (adaptState gst) stt

9961381 case res of

9971382 Yield x s -> do

998− old <- liftIO $ peek rh

999− rh1 <- liftIO (RB.unsafeInsert rb rh x)

1000− let cksum1 = deltaCksum cksum old x

1001− r <- if withSep then fstep fs x else fstep fs old

1002− case r of

1003− FL.Partial fs1 ->

1004− if (cksum1 /= patHash)

1005− then go SPEC fs1 s rh1 cksum1

1006− else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1

1007− FL.Done b ->

1008− let next = SplitOnSuffixSeqKRInit

1009− 0 st rb (RB.startOf rb)

1010− in skip $ SplitOnSuffixSeqYield b next

1011− Skip s -> go SPEC fs s rh cksum

1012− Stop ->

1013− if RB.unsafeEqArray rb rh patArr

1014− then return Stop

1015− else if withSep

1016− then do

1017− r <- done fs

1018− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

1019− else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh

1383+ if predicate x

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

1385+ else do

1386+ r <- fstep acc x

1387+ case r of

1388+ FL.Partial fs1 -> go SPEC s fs1

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

1390+ Skip s -> go SPEC s acc

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

10201392

1021− stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do

1022− if RB.unsafeEqArray rb rh patArr

1023− then do

1024− r <- done fs

1025− let next = SplitOnSuffixSeqKRInit 0 st rb (RB.startOf rb)

1026− skip $ SplitOnSuffixSeqYield r next

1027− else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

1393+ stepOuter _ _ WordsByNothing = return Stop

10281394

1029− stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

1030− r <- done fs

1031− skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

1032− stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do

1033− old <- liftIO $ peek rh

1034− let rh1 = RB.advance rb rh

1035− r <- fstep fs old

1036− case r of

1037− FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

1038− FL.Done b -> do

1039− fs1 <- initial

1040− let next = SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

1041− skip $ SplitOnSuffixSeqYield b next

1395+------------------------------------------------------------------------------

1396+-- Splitting on a sequence

1397+------------------------------------------------------------------------------

10421398

1043−{-# ANN type SplitState Fuse #-}

1044−data SplitState s arr

1045− = SplitInitial s

1046− | SplitBuffering s arr

1047− | SplitSplitting s arr

1048− | SplitYielding arr (SplitState s arr)

1049− | SplitFinishing

1399+-- String search algorithms:

1400+-- http://www-igm.univ-mlv.fr/~lecroq/string/index.html

10501401

1051−-- XXX An alternative approach would be to use a partial fold (Fold m a b) to

1052−-- split using a splitBy like combinator. The Fold would consume upto the

1053−-- separator and return any leftover which can then be fed to the next fold.

1054−--

1055−-- We can revisit this once we have partial folds/parsers.

1402+{-

1403+-- TODO can we unify the splitting operations using a splitting configuration

1404+-- like in the split package.

10561405--

1057−-- | Performs infix separator style splitting.

1058−{-# INLINE_NORMAL splitInnerBy #-}

1059−splitInnerBy

1060− :: Monad m

1061− => (f a -> m (f a, Maybe (f a))) -- splitter

1062− -> (f a -> f a -> m (f a)) -- joiner

1063− -> Stream m (f a)

1064− -> Stream m (f a)

1065−splitInnerBy splitter joiner (Stream step1 state1) =

1066− (Stream step (SplitInitial state1))

1406+data SplitStyle = Infix | Suffix | Prefix deriving (Eq, Show)

1407+data SplitOptions = SplitOptions

1408+ { style :: SplitStyle

1409+ , withSep :: Bool -- ^ keep the separators in output

1410+ -- , compact :: Bool -- ^ treat multiple consecutive separators as one

1411+ -- , trimHead :: Bool -- ^ drop blank at head

1412+ -- , trimTail :: Bool -- ^ drop blank at tail

1413+ }

1414+-}

10671415

1068− where

1416+{-# ANN type SplitOnSeqState Fuse #-}

1417+data SplitOnSeqState rb rh ck w fs s b x =

1418+ SplitOnSeqInit

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

1420+ | SplitOnSeqDone

10691421

1070− {-# INLINE_LATE step #-}

1071− step gst (SplitInitial st) = do

1072− r <- step1 gst st

1073− case r of

1074− Yield x s -> do

1075− (x1, mx2) <- splitter x

1076− return $ case mx2 of

1077− Nothing -> Skip (SplitBuffering s x1)

1078− Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))

1079− Skip s -> return $ Skip (SplitInitial s)

1080− Stop -> return $ Stop

1422+ | SplitOnSeqEmpty s

10811423

1082− step gst (SplitBuffering st buf) = do

1083− r <- step1 gst st

1084− case r of

1085− Yield x s -> do

1086− (x1, mx2) <- splitter x

1087− buf' <- joiner buf x1

1088− return $ case mx2 of

1089− Nothing -> Skip (SplitBuffering s buf')

1090− Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))

1091− Skip s -> return $ Skip (SplitBuffering s buf)

1092− Stop -> return $ Skip (SplitYielding buf SplitFinishing)

1424+ | SplitOnSeqSingle !fs s x

10931425

1094− step _ (SplitSplitting st buf) = do

1095− (x1, mx2) <- splitter buf

1096− return $ case mx2 of

1097− Nothing -> Skip $ SplitBuffering st x1

1098− Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)

1426+ | SplitOnSeqWordInit s

1427+ | SplitOnSeqWordLoop !w s !fs

1428+ | SplitOnSeqWordDone Int !fs !w

10991429

1100− step _ (SplitYielding x next) = return $ Yield x next

1101− step _ SplitFinishing = return $ Stop

1430+ | SplitOnSeqKRInit Int s rb !rh

1431+ | SplitOnSeqKRLoop fs s rb !rh !ck

1432+ | SplitOnSeqKRCheck fs s rb !rh

1433+ | SplitOnSeqKRDone Int !fs rb !rh

11021434

1103−-- | Performs infix separator style splitting.

1104−{-# INLINE_NORMAL splitInnerBySuffix #-}

1105−splitInnerBySuffix

1106− :: (Monad m, Eq (f a), Monoid (f a))

1107− => (f a -> m (f a, Maybe (f a))) -- splitter

1108− -> (f a -> f a -> m (f a)) -- joiner

1109− -> Stream m (f a)

1110− -> Stream m (f a)

1111−splitInnerBySuffix splitter joiner (Stream step1 state1) =

1112− (Stream step (SplitInitial state1))

1435+{-# INLINE_NORMAL splitOnSeq #-}

1436+splitOnSeq

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

1438+ => Array a

1439+ -> Fold m a b

1440+ -> Stream m a

1441+ -> Stream m b

1442+splitOnSeq patArr (Fold fstep initial done) (Stream step state) =

1443+ Stream stepOuter SplitOnSeqInit

11131444

11141445 where

11151446

1116− {-# INLINE_LATE step #-}

1117− step gst (SplitInitial st) = do

1118− r <- step1 gst st

1119− case r of

1120− Yield x s -> do

1121− (x1, mx2) <- splitter x

1122− return $ case mx2 of

1123− Nothing -> Skip (SplitBuffering s x1)

1124− Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))

1125− Skip s -> return $ Skip (SplitInitial s)

1126− Stop -> return $ Stop

1447+ patLen = A.length patArr

1448+ maxIndex = patLen - 1

1449+ elemBits = sizeOf (undefined :: a) * 8

11271450

1128− step gst (SplitBuffering st buf) = do

1129− r <- step1 gst st

1130− case r of

1131− Yield x s -> do

1132− (x1, mx2) <- splitter x

1133− buf' <- joiner buf x1

1134− return $ case mx2 of

1135− Nothing -> Skip (SplitBuffering s buf')

1136− Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))

1137− Skip s -> return $ Skip (SplitBuffering s buf)

1138− Stop -> return $

1139− if buf == mempty

1140− then Stop

1141− else Skip (SplitYielding buf SplitFinishing)

1451+ -- For word pattern case

1452+ wordMask :: Word

1453+ wordMask = (1 `shiftL` (elemBits * patLen)) - 1

11421454

1143− step _ (SplitSplitting st buf) = do

1144− (x1, mx2) <- splitter buf

1145− return $ case mx2 of

1146− Nothing -> Skip $ SplitBuffering st x1

1147− Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)

1455+ elemMask :: Word

1456+ elemMask = (1 `shiftL` elemBits) - 1

11481457

1149− step _ (SplitYielding x next) = return $ Yield x next

1150− step _ SplitFinishing = return Stop

1458+ wordPat :: Word

1459+ wordPat = wordMask .&. A.foldl' addToWord 0 patArr

11511460

1152−-------------------------------------------------------------------------------

1153−-- Stream transformations using Unfolds

1154−-------------------------------------------------------------------------------

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

11551462

1156−-- Define a unique structure to use in inspection testing

1157−data ConcatMapUState o i =

1158− ConcatMapUOuter o

1159− | ConcatMapUInner o i

1463+ -- For Rabin-Karp search

1464+ k = 2891336453 :: Word32

1465+ coeff = k ^ patLen

11601466

1161−-- | @concatMapU unfold stream@ uses @unfold@ to map the input stream elements

1162−-- to streams and then flattens the generated streams into a single output

1163−-- stream.

1467+ addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

11641468

1165−-- This is like 'concatMap' but uses an unfold with an explicit state to

1166−-- generate the stream instead of a 'Stream' type generator. This allows better

1167−-- optimization via fusion. This can be many times more efficient than

1168−-- 'concatMap'.

1469+ deltaCksum cksum old new =

1470+ addCksum cksum new - coeff * fromIntegral (fromEnum old)

11691471

1170−{-# INLINE_NORMAL concatMapU #-}

1171−concatMapU :: Monad m => Unfold m a b -> Stream m a -> Stream m b

1172−concatMapU (Unfold istep inject) (Stream ostep ost) =

1173− Stream step (ConcatMapUOuter ost)

1174− where

1175− {-# INLINE_LATE step #-}

1176− step gst (ConcatMapUOuter o) = do

1177− r <- ostep (adaptState gst) o

1178− case r of

1179− Yield a o' -> do

1180− i <- inject a

1181− i `seq` return (Skip (ConcatMapUInner o' i))

1182− Skip o' -> return $ Skip (ConcatMapUOuter o')

1183− Stop -> return $ Stop

1472+ -- XXX shall we use a random starting hash or 1 instead of 0?

1473+ patHash = A.foldl' addCksum 0 patArr

11841474

1185− step _ (ConcatMapUInner o i) = do

1186− r <- istep i

1187− return $ case r of

1188− Yield x i' -> Yield x (ConcatMapUInner o i')

1189− Skip i' -> Skip (ConcatMapUInner o i')

1190− Stop -> Skip (ConcatMapUOuter o)

1475+ skip = return . Skip

11911476

1192−data ConcatUnfoldInterleaveState o i =

1193− ConcatUnfoldInterleaveOuter o [i]

1194− | ConcatUnfoldInterleaveInner o [i]

1195− | ConcatUnfoldInterleaveInnerL [i] [i]

1196− | ConcatUnfoldInterleaveInnerR [i] [i]

1477+ {-# INLINE_LATE stepOuter #-}

1478+ stepOuter _ SplitOnSeqInit =

1479+ if patLen == 0

1480+ then return $ Skip $ SplitOnSeqEmpty state

1481+ else if patLen == 1

1482+ then do

1483+ acc <- initial

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

1485+ return $ Skip $ SplitOnSeqSingle acc state pat

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

1487+ <= sizeOf (undefined :: Word)

1488+ then return $ Skip $ SplitOnSeqWordInit state

1489+ else do

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

1491+ skip $ SplitOnSeqKRInit 0 state rb rhead

11971492

1198−-- XXX use arrays to store state instead of lists.

1199−-- XXX In general we can use different scheduling strategies e.g. how to

1200−-- schedule the outer vs inner loop or assigning weights to different streams

1201−-- or outer and inner loops.

1493+ stepOuter _ (SplitOnSeqYield x next) = return $ Yield x next

12021494

1203−-- After a yield, switch to the next stream. Do not switch streams on Skip.

1204−-- Yield from outer stream switches to the inner stream.

1205−--

1206−-- There are two choices here, (1) exhaust the outer stream first and then

1207−-- start yielding from the inner streams, this is much simpler to implement,

1208−-- (2) yield at least one element from an inner stream before going back to

1209−-- outer stream and opening the next stream from it.

1210−--

1211−-- Ideally, we need some scheduling bias to inner streams vs outer stream.

1212−-- Maybe we can configure the behavior.

1213−--

1214−{-# INLINE_NORMAL concatUnfoldInterleave #-}

1215−concatUnfoldInterleave :: Monad m => Unfold m a b -> Stream m a -> Stream m b

1216−concatUnfoldInterleave (Unfold istep inject) (Stream ostep ost) =

1217− Stream step (ConcatUnfoldInterleaveOuter ost [])

1218− where

1219− {-# INLINE_LATE step #-}

1220− step gst (ConcatUnfoldInterleaveOuter o ls) = do

1221− r <- ostep (adaptState gst) o

1222− case r of

1223− Yield a o' -> do

1224− i <- inject a

1225− i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))

1226− Skip o' -> return $ Skip (ConcatUnfoldInterleaveOuter o' ls)

1227− Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

1495+ ---------------------------

1496+ -- Empty pattern

1497+ ---------------------------

12281498

1229− step _ (ConcatUnfoldInterleaveInner _ []) = undefined

1230− step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do

1231− r <- istep st

1232− return $ case r of

1233− Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))

1234− Skip s -> Skip (ConcatUnfoldInterleaveInner o (s:ls))

1235− Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)

1499+ stepOuter gst (SplitOnSeqEmpty st) = do

1500+ res <- step (adaptState gst) st

1501+ case res of

1502+ Yield x s -> do

1503+ fs <- initial

1504+ r <- fstep fs x

1505+ case r of

1506+ FL.Partial fs1 -> do

1507+ b <- done fs1

1508+ skip $ SplitOnSeqYield b (SplitOnSeqEmpty s)

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

12361510

1237− step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop

1238− step _ (ConcatUnfoldInterleaveInnerL [] rs) =

1239− return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)

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

1512+ Stop -> return Stop

12401513

1241− step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do

1242− r <- istep st

1243− return $ case r of

1244− Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))

1245− Skip s -> Skip (ConcatUnfoldInterleaveInnerL (s:ls) rs)

1246− Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)

1514+ -----------------

1515+ -- Done

1516+ -----------------

12471517

1248− step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop

1249− step _ (ConcatUnfoldInterleaveInnerR ls []) =

1250− return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

1518+ stepOuter _ SplitOnSeqDone = return Stop

12511519

1252− step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do

1253− r <- istep st

1254− return $ case r of

1255− Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)

1256− Skip s -> Skip (ConcatUnfoldInterleaveInnerR ls (s:rs))

1257− Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)

1520+ -----------------

1521+ -- Single Pattern

1522+ -----------------

12581523

1259−-- XXX In general we can use different scheduling strategies e.g. how to

1260−-- schedule the outer vs inner loop or assigning weights to different streams

1261−-- or outer and inner loops.

1262−--

1263−-- This could be inefficient if the tasks are too small.

1264−--

1265−-- Compared to concatUnfoldInterleave this one switches streams on Skips.

1266−--

1267−{-# INLINE_NORMAL concatUnfoldRoundrobin #-}

1268−concatUnfoldRoundrobin :: Monad m => Unfold m a b -> Stream m a -> Stream m b

1269−concatUnfoldRoundrobin (Unfold istep inject) (Stream ostep ost) =

1270− Stream step (ConcatUnfoldInterleaveOuter ost [])

1271− where

1272− {-# INLINE_LATE step #-}

1273− step gst (ConcatUnfoldInterleaveOuter o ls) = do

1274− r <- ostep (adaptState gst) o

1524+ stepOuter gst (SplitOnSeqSingle fs st pat) = do

1525+ res <- step (adaptState gst) st

1526+ case res of

1527+ Yield x s -> do

1528+ if pat == x

1529+ then do

1530+ r <- done fs

1531+ fs1 <- initial

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

1533+ else do

1534+ r <- fstep fs x

1535+ case r of

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

1537+ FL.Done b -> do

1538+ fs1 <- initial

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

1540+ Skip s -> return $ Skip $ SplitOnSeqSingle fs s pat

1541+ Stop -> do

1542+ r <- done fs

1543+ return $ Skip $ SplitOnSeqYield r SplitOnSeqDone

1544+

1545+ ---------------------------

1546+ -- Short Pattern - Shift Or

1547+ ---------------------------

1548+

1549+ stepOuter _ (SplitOnSeqWordDone 0 fs _) = do

1550+ r <- done fs

1551+ skip $ SplitOnSeqYield r SplitOnSeqDone

1552+ stepOuter _ (SplitOnSeqWordDone n fs wrd) = do

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

1554+ r <- fstep fs (toEnum $ fromIntegral old)

12751555 case r of

1276− Yield a o' -> do

1277− i <- inject a

1278− i `seq` return (Skip (ConcatUnfoldInterleaveInner o' (i : ls)))

1279− Skip o' -> return $ Skip (ConcatUnfoldInterleaveInner o' ls)

1280− Stop -> return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

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

1557+ FL.Done b -> do

1558+ fs1 <- initial

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

1560+ skip $ SplitOnSeqYield b next

12811561

1282− step _ (ConcatUnfoldInterleaveInner o []) =

1283− return $ Skip (ConcatUnfoldInterleaveOuter o [])

1562+ stepOuter gst (SplitOnSeqWordInit st0) =

1563+ go SPEC 0 0 st0

12841564

1285− step _ (ConcatUnfoldInterleaveInner o (st:ls)) = do

1286− r <- istep st

1287− return $ case r of

1288− Yield x s -> Yield x (ConcatUnfoldInterleaveOuter o (s:ls))

1289− Skip s -> Skip (ConcatUnfoldInterleaveOuter o (s:ls))

1290− Stop -> Skip (ConcatUnfoldInterleaveOuter o ls)

1565+ where

12911566

1292− step _ (ConcatUnfoldInterleaveInnerL [] []) = return Stop

1293− step _ (ConcatUnfoldInterleaveInnerL [] rs) =

1294− return $ Skip (ConcatUnfoldInterleaveInnerR [] rs)

1567+ {-# INLINE go #-}

1568+ go !_ !idx !wrd !st = do

1569+ res <- step (adaptState gst) st

1570+ case res of

1571+ Yield x s -> do

1572+ let wrd1 = addToWord wrd x

1573+ if idx == maxIndex

1574+ then do

1575+ fs <- initial

1576+ if wrd1 .&. wordMask == wordPat

1577+ then do

1578+ r <- done fs

1579+ let next = SplitOnSeqWordInit s

1580+ skip $ SplitOnSeqYield r next

1581+ else skip $ SplitOnSeqWordLoop wrd1 s fs

1582+ else go SPEC (idx + 1) wrd1 s

1583+ Skip s -> go SPEC idx wrd s

1584+ Stop -> do

1585+ fs <- initial

1586+ if idx /= 0

1587+ then skip $ SplitOnSeqWordDone idx fs wrd

1588+ else do

1589+ r <- done fs

1590+ skip $ SplitOnSeqYield r SplitOnSeqDone

12951591

1296− step _ (ConcatUnfoldInterleaveInnerL (st:ls) rs) = do

1297− r <- istep st

1298− return $ case r of

1299− Yield x s -> Yield x (ConcatUnfoldInterleaveInnerL ls (s:rs))

1300− Skip s -> Skip (ConcatUnfoldInterleaveInnerL ls (s:rs))

1301− Stop -> Skip (ConcatUnfoldInterleaveInnerL ls rs)

1592+ stepOuter gst (SplitOnSeqWordLoop wrd0 st0 fs0) =

1593+ go SPEC wrd0 st0 fs0

13021594

1303− step _ (ConcatUnfoldInterleaveInnerR [] []) = return Stop

1304− step _ (ConcatUnfoldInterleaveInnerR ls []) =

1305− return $ Skip (ConcatUnfoldInterleaveInnerL ls [])

1595+ where

13061596

1307− step _ (ConcatUnfoldInterleaveInnerR ls (st:rs)) = do

1308− r <- istep st

1309− return $ case r of

1310− Yield x s -> Yield x (ConcatUnfoldInterleaveInnerR (s:ls) rs)

1311− Skip s -> Skip (ConcatUnfoldInterleaveInnerR (s:ls) rs)

1312− Stop -> Skip (ConcatUnfoldInterleaveInnerR ls rs)

1597+ {-# INLINE go #-}

1598+ go !_ !wrd !st !fs = do

1599+ res <- step (adaptState gst) st

1600+ case res of

1601+ Yield x s -> do

1602+ let wrd1 = addToWord wrd x

1603+ old = (wordMask .&. wrd)

1604+ `shiftR` (elemBits * (patLen - 1))

1605+ r <- fstep fs (toEnum $ fromIntegral old)

1606+ case r of

1607+ FL.Partial fs1 -> do

1608+ if wrd1 .&. wordMask == wordPat

1609+ then do

1610+ b <- done fs1

1611+ let next = SplitOnSeqWordInit s

1612+ skip $ SplitOnSeqYield b next

1613+ else go SPEC wrd1 s fs1

1614+ FL.Done b ->

1615+ let next = SplitOnSeqWordInit s

1616+ in skip $ SplitOnSeqYield b next

1617+ Skip s -> go SPEC wrd s fs

1618+ Stop -> skip $ SplitOnSeqWordDone patLen fs wrd

13131619

1314−data AppendState s1 s2 = AppendFirst s1 | AppendSecond s2

1620+ -------------------------------

1621+ -- General Pattern - Karp Rabin

1622+ -------------------------------

13151623

1316−-- Note that this could be much faster compared to the CPS stream. However, as

1317−-- the number of streams being composed increases this may become expensive.

1318−-- Need to see where the breaking point is between the two.

1319−--

1320−{-# INLINE_NORMAL append #-}

1321−append :: Monad m => Stream m a -> Stream m a -> Stream m a

1322−append (Stream step1 state1) (Stream step2 state2) =

1323− Stream step (AppendFirst state1)

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

1625+ res <- step (adaptState gst) st

1626+ case res of

1627+ Yield x s -> do

1628+ rh1 <- liftIO $ RB.unsafeInsert rb rh x

1629+ if idx == maxIndex

1630+ then do

1631+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

1632+ let !ringHash = fold addCksum 0 rb

1633+ fs <- initial

1634+ if ringHash == patHash

1635+ then skip $ SplitOnSeqKRCheck fs s rb rh1

1636+ else skip $ SplitOnSeqKRLoop fs s rb rh1 ringHash

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

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

1639+ Stop -> do

1640+ fs <- initial

1641+ skip $ SplitOnSeqKRDone idx fs rb (RB.startOf rb)

13241642

1325− where

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

1644+ -- code commented out below. Perhaps its more efficient because of

1645+ -- factoring out "rb" outside the loop.

1646+ --

1647+ stepOuter gst (SplitOnSeqKRLoop fs0 st0 rb rh0 cksum0) =

1648+ go SPEC fs0 st0 rh0 cksum0

13261649

1327− {-# INLINE_LATE step #-}

1328− step gst (AppendFirst st) = do

1329− r <- step1 gst st

1330− return $ case r of

1331− Yield a s -> Yield a (AppendFirst s)

1332− Skip s -> Skip (AppendFirst s)

1333− Stop -> Skip (AppendSecond state2)

1650+ where

13341651

1335− step gst (AppendSecond st) = do

1336− r <- step2 gst st

1337− return $ case r of

1338− Yield a s -> Yield a (AppendSecond s)

1339− Skip s -> Skip (AppendSecond s)

1340− Stop -> Stop

1652+ go !_ !fs !st !rh !cksum = do

1653+ res <- step (adaptState gst) st

1654+ case res of

1655+ Yield x s -> do

1656+ old <- liftIO $ peek rh

1657+ let cksum1 = deltaCksum cksum old x

1658+ r <- fstep fs old

1659+ case r of

1660+ FL.Partial fs1 -> do

1661+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

1662+ if cksum1 == patHash

1663+ then skip $ SplitOnSeqKRCheck fs1 s rb rh1

1664+ else go SPEC fs1 s rh1 cksum1

1665+ FL.Done b ->

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

1667+ in skip $ SplitOnSeqYield b next

1668+ Skip s -> go SPEC fs s rh cksum

1669+ Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh

13411670

1342−data InterleaveState s1 s2 = InterleaveFirst s1 s2 | InterleaveSecond s1 s2

1343− | InterleaveSecondOnly s2 | InterleaveFirstOnly s1

1671+ -- XXX The following code is 5 times slower compared to the recursive loop

1672+ -- based code above. Need to investigate why. One possibility is that the

1673+ -- go loop above does not thread around the ring buffer (rb). This code may

1674+ -- be causing the state to bloat and getting allocated on each iteration.

1675+ -- We can check the cmm/asm code to confirm. If so a good GHC solution to

1676+ -- such problem is needed. One way to avoid this could be to use unboxed

1677+ -- mutable state?

1678+ {-

1679+ stepOuter gst (SplitOnSeqKRLoop fs st rb rh cksum) = do

1680+ res <- step (adaptState gst) st

1681+ case res of

1682+ Yield x s -> do

1683+ old <- liftIO $ peek rh

1684+ let cksum1 = deltaCksum cksum old x

1685+ fs1 <- fstep fs old

1686+ if (cksum1 == patHash)

1687+ then do

1688+ r <- done fs1

1689+ skip $ SplitOnSeqYield r $ SplitOnSeqKRInit 0 s rb rh

1690+ else do

1691+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

1692+ skip $ SplitOnSeqKRLoop fs1 s rb rh1 cksum1

1693+ Skip s -> skip $ SplitOnSeqKRLoop fs s rb rh cksum

1694+ Stop -> skip $ SplitOnSeqKRDone patLen fs rb rh

1695+ -}

13441696

1345−{-# INLINE_NORMAL interleave #-}

1346−interleave :: Monad m => Stream m a -> Stream m a -> Stream m a

1347−interleave (Stream step1 state1) (Stream step2 state2) =

1348− Stream step (InterleaveFirst state1 state2)

1697+ stepOuter _ (SplitOnSeqKRCheck fs st rb rh) = do

1698+ if RB.unsafeEqArray rb rh patArr

1699+ then do

1700+ r <- done fs

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

1702+ skip $ SplitOnSeqYield r next

1703+ else skip $ SplitOnSeqKRLoop fs st rb rh patHash

1704+ stepOuter _ (SplitOnSeqKRDone 0 fs _ _) = do

1705+ r <- done fs

1706+ skip $ SplitOnSeqYield r SplitOnSeqDone

1707+ stepOuter _ (SplitOnSeqKRDone n fs rb rh) = do

1708+ old <- liftIO $ peek rh

1709+ let rh1 = RB.advance rb rh

1710+ r <- fstep fs old

1711+ case r of

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

1713+ FL.Done b -> do

1714+ fs1 <- initial

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

1716+ skip $ SplitOnSeqYield b next

13491717

1350− where

1718+{-# ANN type SplitOnSuffixSeqState Fuse #-}

1719+data SplitOnSuffixSeqState rb rh ck w fs s b x =

1720+ SplitOnSuffixSeqInit

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

1722+ | SplitOnSuffixSeqDone

13511723

1352− {-# INLINE_LATE step #-}

1353− step gst (InterleaveFirst st1 st2) = do

1354− r <- step1 gst st1

1355− return $ case r of

1356− Yield a s -> Yield a (InterleaveSecond s st2)

1357− Skip s -> Skip (InterleaveFirst s st2)

1358− Stop -> Skip (InterleaveSecondOnly st2)

1724+ | SplitOnSuffixSeqEmpty s

13591725

1360− step gst (InterleaveSecond st1 st2) = do

1361− r <- step2 gst st2

1362− return $ case r of

1363− Yield a s -> Yield a (InterleaveFirst st1 s)

1364− Skip s -> Skip (InterleaveSecond st1 s)

1365− Stop -> Skip (InterleaveFirstOnly st1)

1726+ | SplitOnSuffixSeqSingleInit s x

1727+ | SplitOnSuffixSeqSingle !fs s x

13661728

1367− step gst (InterleaveFirstOnly st1) = do

1368− r <- step1 gst st1

1369− return $ case r of

1370− Yield a s -> Yield a (InterleaveFirstOnly s)

1371− Skip s -> Skip (InterleaveFirstOnly s)

1372− Stop -> Stop

1729+ | SplitOnSuffixSeqWordInit s

1730+ | SplitOnSuffixSeqWordLoop !w s !fs

1731+ | SplitOnSuffixSeqWordDone Int !fs !w

13731732

1374− step gst (InterleaveSecondOnly st2) = do

1375− r <- step2 gst st2

1376− return $ case r of

1377− Yield a s -> Yield a (InterleaveSecondOnly s)

1378− Skip s -> Skip (InterleaveSecondOnly s)

1379− Stop -> Stop

1733+ | SplitOnSuffixSeqKRInit Int s rb !rh

1734+ | SplitOnSuffixSeqKRInit1 !fs s rb !rh

1735+ | SplitOnSuffixSeqKRLoop fs s rb !rh !ck

1736+ | SplitOnSuffixSeqKRCheck fs s rb !rh

1737+ | SplitOnSuffixSeqKRDone Int !fs rb !rh

13801738

1381−{-# INLINE_NORMAL interleaveMin #-}

1382−interleaveMin :: Monad m => Stream m a -> Stream m a -> Stream m a

1383−interleaveMin (Stream step1 state1) (Stream step2 state2) =

1384− Stream step (InterleaveFirst state1 state2)

1739+{-# INLINE_NORMAL splitOnSuffixSeq #-}

1740+splitOnSuffixSeq

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

1742+ => Bool

1743+ -> Array a

1744+ -> Fold m a b

1745+ -> Stream m a

1746+ -> Stream m b

1747+splitOnSuffixSeq withSep patArr (Fold fstep initial done) (Stream step state) =

1748+ Stream stepOuter SplitOnSuffixSeqInit

13851749

13861750 where

13871751

1388− {-# INLINE_LATE step #-}

1389− step gst (InterleaveFirst st1 st2) = do

1390− r <- step1 gst st1

1391− return $ case r of

1392− Yield a s -> Yield a (InterleaveSecond s st2)

1393− Skip s -> Skip (InterleaveFirst s st2)

1394− Stop -> Stop

1395−

1396− step gst (InterleaveSecond st1 st2) = do

1397− r <- step2 gst st2

1398− return $ case r of

1399− Yield a s -> Yield a (InterleaveFirst st1 s)

1400− Skip s -> Skip (InterleaveSecond st1 s)

1401− Stop -> Stop

1752+ patLen = A.length patArr

1753+ maxIndex = patLen - 1

1754+ elemBits = sizeOf (undefined :: a) * 8

14021755

1403− step _ (InterleaveFirstOnly _) = undefined

1404− step _ (InterleaveSecondOnly _) = undefined

1756+ -- For word pattern case

1757+ wordMask :: Word

1758+ wordMask = (1 `shiftL` (elemBits * patLen)) - 1

14051759

1406−{-# INLINE_NORMAL interleaveSuffix #-}

1407−interleaveSuffix :: Monad m => Stream m a -> Stream m a -> Stream m a

1408−interleaveSuffix (Stream step1 state1) (Stream step2 state2) =

1409− Stream step (InterleaveFirst state1 state2)

1760+ elemMask :: Word

1761+ elemMask = (1 `shiftL` elemBits) - 1

14101762

1411− where

1763+ wordPat :: Word

1764+ wordPat = wordMask .&. A.foldl' addToWord 0 patArr

14121765

1413− {-# INLINE_LATE step #-}

1414− step gst (InterleaveFirst st1 st2) = do

1415− r <- step1 gst st1

1416− return $ case r of

1417− Yield a s -> Yield a (InterleaveSecond s st2)

1418− Skip s -> Skip (InterleaveFirst s st2)

1419− Stop -> Stop

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

14201767

1421− step gst (InterleaveSecond st1 st2) = do

1422− r <- step2 gst st2

1423− return $ case r of

1424− Yield a s -> Yield a (InterleaveFirst st1 s)

1425− Skip s -> Skip (InterleaveSecond st1 s)

1426− Stop -> Skip (InterleaveFirstOnly st1)

1768+ -- For single element pattern case

1769+ {-# INLINE processYieldSingle #-}

1770+ processYieldSingle pat x s fs =

1771+ if pat == x

1772+ then do

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

1774+ case r of

1775+ FL.Partial fs1 -> do

1776+ b <- done fs1

1777+ let next = SplitOnSuffixSeqSingleInit s pat

1778+ skip $ SplitOnSuffixSeqYield b next

1779+ FL.Done b ->

1780+ let next = SplitOnSuffixSeqSingleInit s pat

1781+ in skip $ SplitOnSuffixSeqYield b next

1782+ else do

1783+ r <- fstep fs x

1784+ case r of

1785+ FL.Partial fs1 -> skip $ SplitOnSuffixSeqSingle fs1 s pat

1786+ FL.Done b ->

1787+ let next = SplitOnSuffixSeqSingleInit s pat

1788+ in skip $ SplitOnSuffixSeqYield b next

14271789

1428− step gst (InterleaveFirstOnly st1) = do

1429− r <- step1 gst st1

1430− return $ case r of

1431− Yield a s -> Yield a (InterleaveFirstOnly s)

1432− Skip s -> Skip (InterleaveFirstOnly s)

1433− Stop -> Stop

1790+ -- For Rabin-Karp search

1791+ k = 2891336453 :: Word32

1792+ coeff = k ^ patLen

14341793

1435− step _ (InterleaveSecondOnly _) = undefined

1794+ addCksum cksum a = cksum * k + fromIntegral (fromEnum a)

14361795

1437−data InterleaveInfixState s1 s2 a

1438− = InterleaveInfixFirst s1 s2

1439− | InterleaveInfixSecondBuf s1 s2

1440− | InterleaveInfixSecondYield s1 s2 a

1441− | InterleaveInfixFirstYield s1 s2 a

1442− | InterleaveInfixFirstOnly s1

1796+ deltaCksum cksum old new =

1797+ addCksum cksum new - coeff * fromIntegral (fromEnum old)

14431798

1444−{-# INLINE_NORMAL interleaveInfix #-}

1445−interleaveInfix :: Monad m => Stream m a -> Stream m a -> Stream m a

1446−interleaveInfix (Stream step1 state1) (Stream step2 state2) =

1447− Stream step (InterleaveInfixFirst state1 state2)

1799+ -- XXX shall we use a random starting hash or 1 instead of 0?

1800+ patHash = A.foldl' addCksum 0 patArr

14481801

1449− where

1802+ skip = return . Skip

14501803

1451− {-# INLINE_LATE step #-}

1452− step gst (InterleaveInfixFirst st1 st2) = do

1453− r <- step1 gst st1

1454− return $ case r of

1455− Yield a s -> Yield a (InterleaveInfixSecondBuf s st2)

1456− Skip s -> Skip (InterleaveInfixFirst s st2)

1457− Stop -> Stop

1804+ {-# INLINE_LATE stepOuter #-}

1805+ stepOuter _ SplitOnSuffixSeqInit =

1806+ if patLen == 0

1807+ then skip $ SplitOnSuffixSeqEmpty state

1808+ else if patLen == 1

1809+ then do

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

1811+ skip $ SplitOnSuffixSeqSingleInit state pat

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

1813+ <= sizeOf (undefined :: Word)

1814+ then skip $ SplitOnSuffixSeqWordInit state

1815+ else do

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

1817+ skip $ SplitOnSuffixSeqKRInit 0 state rb rhead

14581818

1459− step gst (InterleaveInfixSecondBuf st1 st2) = do

1460− r <- step2 gst st2

1461− return $ case r of

1462− Yield a s -> Skip (InterleaveInfixSecondYield st1 s a)

1463− Skip s -> Skip (InterleaveInfixSecondBuf st1 s)

1464− Stop -> Skip (InterleaveInfixFirstOnly st1)

1819+ stepOuter _ (SplitOnSuffixSeqYield x next) = return $ Yield x next

14651820

1466− step gst (InterleaveInfixSecondYield st1 st2 x) = do

1467− r <- step1 gst st1

1468− return $ case r of

1469− Yield a s -> Yield x (InterleaveInfixFirstYield s st2 a)

1470− Skip s -> Skip (InterleaveInfixSecondYield s st2 x)

1471− Stop -> Stop

1821+ ---------------------------

1822+ -- Empty pattern

1823+ ---------------------------

14721824

1473− step _ (InterleaveInfixFirstYield st1 st2 x) = do

1474− return $ Yield x (InterleaveInfixSecondBuf st1 st2)

1825+ stepOuter gst (SplitOnSuffixSeqEmpty st) = do

1826+ res <- step (adaptState gst) st

1827+ case res of

1828+ Yield x s -> do

1829+ acc <- initial

1830+ r <- fstep acc x

1831+ case r of

1832+ FL.Partial fs -> do

1833+ b <- done fs

1834+ skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

1835+ FL.Done b ->

1836+ skip $ SplitOnSuffixSeqYield b (SplitOnSuffixSeqEmpty s)

1837+ Skip s -> skip (SplitOnSuffixSeqEmpty s)

1838+ Stop -> return Stop

14751839

1476− step gst (InterleaveInfixFirstOnly st1) = do

1477− r <- step1 gst st1

1478− return $ case r of

1479− Yield a s -> Yield a (InterleaveInfixFirstOnly s)

1480− Skip s -> Skip (InterleaveInfixFirstOnly s)

1481− Stop -> Stop

1840+ -----------------

1841+ -- Done

1842+ -----------------

14821843

1483−{-# INLINE_NORMAL roundRobin #-}

1484−roundRobin :: Monad m => Stream m a -> Stream m a -> Stream m a

1485−roundRobin (Stream step1 state1) (Stream step2 state2) =

1486− Stream step (InterleaveFirst state1 state2)

1844+ stepOuter _ SplitOnSuffixSeqDone = return Stop

14871845

1488− where

1846+ -----------------

1847+ -- Single Pattern

1848+ -----------------

14891849

1490− {-# INLINE_LATE step #-}

1491− step gst (InterleaveFirst st1 st2) = do

1492− r <- step1 gst st1

1493− return $ case r of

1494− Yield a s -> Yield a (InterleaveSecond s st2)

1495− Skip s -> Skip (InterleaveSecond s st2)

1496− Stop -> Skip (InterleaveSecondOnly st2)

1850+ stepOuter gst (SplitOnSuffixSeqSingleInit st pat) = do

1851+ res <- step (adaptState gst) st

1852+ case res of

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

1854+ Skip s -> skip $ SplitOnSuffixSeqSingleInit s pat

1855+ Stop -> return Stop

14971856

1498− step gst (InterleaveSecond st1 st2) = do

1499− r <- step2 gst st2

1500− return $ case r of

1501− Yield a s -> Yield a (InterleaveFirst st1 s)

1502− Skip s -> Skip (InterleaveFirst st1 s)

1503− Stop -> Skip (InterleaveFirstOnly st1)

1857+ stepOuter gst (SplitOnSuffixSeqSingle fs st pat) = do

1858+ res <- step (adaptState gst) st

1859+ case res of

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

1861+ Skip s -> skip $ SplitOnSuffixSeqSingle fs s pat

1862+ Stop -> do

1863+ r <- done fs

1864+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

15041865

1505− step gst (InterleaveSecondOnly st2) = do

1506− r <- step2 gst st2

1507− return $ case r of

1508− Yield a s -> Yield a (InterleaveSecondOnly s)

1509− Skip s -> Skip (InterleaveSecondOnly s)

1510− Stop -> Stop

1866+ ---------------------------

1867+ -- Short Pattern - Shift Or

1868+ ---------------------------

15111869

1512− step gst (InterleaveFirstOnly st1) = do

1513− r <- step1 gst st1

1514− return $ case r of

1515− Yield a s -> Yield a (InterleaveFirstOnly s)

1516− Skip s -> Skip (InterleaveFirstOnly s)

1517− Stop -> Stop

1870+ stepOuter _ (SplitOnSuffixSeqWordDone 0 fs _) = do

1871+ r <- done fs

1872+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

1873+ stepOuter _ (SplitOnSuffixSeqWordDone n fs wrd) = do

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

1875+ r <- fstep fs (toEnum $ fromIntegral old)

1876+ case r of

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

1878+ FL.Done b -> do

1879+ fs1 <- initial

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

1881+ skip $ SplitOnSuffixSeqYield b next

15181882

1519−data ICUState s1 s2 i1 i2 =

1520− ICUFirst s1 s2

1521− | ICUSecond s1 s2

1522− | ICUSecondOnly s2

1523− | ICUFirstOnly s1

1524− | ICUFirstInner s1 s2 i1

1525− | ICUSecondInner s1 s2 i2

1526− | ICUFirstOnlyInner s1 i1

1527− | ICUSecondOnlyInner s2 i2

1883+ stepOuter gst (SplitOnSuffixSeqWordInit st0) = do

1884+ res <- step (adaptState gst) st0

1885+ case res of

1886+ Yield x s -> do

1887+ fs <- initial

1888+ let wrd = addToWord 0 x

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

1890+ case r of

1891+ FL.Partial fs1 -> go SPEC 1 wrd s fs1

1892+ FL.Done b -> do

1893+ let next = SplitOnSuffixSeqWordInit s

1894+ in skip $ SplitOnSuffixSeqYield b next

1895+ Skip s -> skip (SplitOnSuffixSeqWordInit s)

1896+ Stop -> return Stop

15281897

1529−-- | Interleave streams (full streams, not the elements) unfolded from two

1530−-- input streams and concat. Stop when the first stream stops. If the second

1531−-- stream ends before the first one then first stream still keeps running alone

1532−-- without any interleaving with the second stream.

1533−--

1534−-- [a1, a2, ... an] [b1, b2 ...]

1535−-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]

1536−-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]

1537−-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]

1538−--

1539−{-# INLINE_NORMAL gintercalateSuffix #-}

1540−gintercalateSuffix

1541− :: Monad m

1542− => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c

1543−gintercalateSuffix

1544− (Unfold istep1 inject1) (Stream step1 state1)

1545− (Unfold istep2 inject2) (Stream step2 state2) =

1546− Stream step (ICUFirst state1 state2)

1898+ where

15471899

1548− where

1900+ {-# INLINE go #-}

1901+ go !_ !idx !wrd !st !fs = do

1902+ res <- step (adaptState gst) st

1903+ case res of

1904+ Yield x s -> do

1905+ let wrd1 = addToWord wrd x

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

1907+ case r of

1908+ FL.Partial fs1 ->

1909+ if idx /= maxIndex

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

1911+ else if wrd1 .&. wordMask /= wordPat

1912+ then skip $ SplitOnSuffixSeqWordLoop wrd1 s fs1

1913+ else do

1914+ b <- done fs

1915+ let next = SplitOnSuffixSeqWordInit s

1916+ skip $ SplitOnSuffixSeqYield b next

1917+ FL.Done b ->

1918+ let next = SplitOnSuffixSeqWordInit s

1919+ in skip $ SplitOnSuffixSeqYield b next

1920+ Skip s -> go SPEC idx wrd s fs

1921+ Stop -> skip $ SplitOnSuffixSeqWordDone idx fs wrd

15491922

1550− {-# INLINE_LATE step #-}

1551− step gst (ICUFirst s1 s2) = do

1552− r <- step1 (adaptState gst) s1

1553− case r of

1554− Yield a s -> do

1555− i <- inject1 a

1556− i `seq` return (Skip (ICUFirstInner s s2 i))

1557− Skip s -> return $ Skip (ICUFirst s s2)

1558− Stop -> return Stop

1923+ stepOuter gst (SplitOnSuffixSeqWordLoop wrd0 st0 fs0) =

1924+ go SPEC wrd0 st0 fs0

15591925

1560− step gst (ICUFirstOnly s1) = do

1561− r <- step1 (adaptState gst) s1

1562− case r of

1563− Yield a s -> do

1564− i <- inject1 a

1565− i `seq` return (Skip (ICUFirstOnlyInner s i))

1566− Skip s -> return $ Skip (ICUFirstOnly s)

1567− Stop -> return Stop

1926+ where

15681927

1569− step _ (ICUFirstInner s1 s2 i1) = do

1570− r <- istep1 i1

1571− return $ case r of

1572− Yield x i' -> Yield x (ICUFirstInner s1 s2 i')

1573− Skip i' -> Skip (ICUFirstInner s1 s2 i')

1574− Stop -> Skip (ICUSecond s1 s2)

1928+ {-# INLINE go #-}

1929+ go !_ !wrd !st !fs = do

1930+ res <- step (adaptState gst) st

1931+ case res of

1932+ Yield x s -> do

1933+ let wrd1 = addToWord wrd x

1934+ old = (wordMask .&. wrd)

1935+ `shiftR` (elemBits * (patLen - 1))

1936+ r <-

1937+ if withSep

1938+ then fstep fs x

1939+ else fstep fs (toEnum $ fromIntegral old)

1940+ case r of

1941+ FL.Partial fs1 ->

1942+ if wrd1 .&. wordMask == wordPat

1943+ then do

1944+ b <- done fs1

1945+ let next = SplitOnSuffixSeqWordInit s

1946+ skip $ SplitOnSuffixSeqYield b next

1947+ else go SPEC wrd1 s fs1

1948+ FL.Done b ->

1949+ let next = SplitOnSuffixSeqWordInit s

1950+ in skip $ SplitOnSuffixSeqYield b next

1951+ Skip s -> go SPEC wrd s fs

1952+ Stop ->

1953+ if wrd .&. wordMask == wordPat

1954+ then return Stop

1955+ else if withSep

1956+ then do

1957+ r <- done fs

1958+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

1959+ else skip $ SplitOnSuffixSeqWordDone patLen fs wrd

15751960

1576− step _ (ICUFirstOnlyInner s1 i1) = do

1577− r <- istep1 i1

1578− return $ case r of

1579− Yield x i' -> Yield x (ICUFirstOnlyInner s1 i')

1580− Skip i' -> Skip (ICUFirstOnlyInner s1 i')

1581− Stop -> Skip (ICUFirstOnly s1)

1961+ -------------------------------

1962+ -- General Pattern - Karp Rabin

1963+ -------------------------------

15821964

1583− step gst (ICUSecond s1 s2) = do

1584− r <- step2 (adaptState gst) s2

1585− case r of

1586− Yield a s -> do

1587− i <- inject2 a

1588− i `seq` return (Skip (ICUSecondInner s1 s i))

1589− Skip s -> return $ Skip (ICUSecond s1 s)

1590− Stop -> return $ Skip (ICUFirstOnly s1)

1965+ stepOuter gst (SplitOnSuffixSeqKRInit idx0 st0 rb rh0) = do

1966+ res <- step (adaptState gst) st0

1967+ case res of

1968+ Yield x s -> do

1969+ rh1 <- liftIO $ RB.unsafeInsert rb rh0 x

1970+ fs <- initial

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

1972+ case r of

1973+ FL.Partial fs1 ->

1974+ skip $ SplitOnSuffixSeqKRInit1 fs1 s rb rh1

1975+ FL.Done b ->

1976+ let next = SplitOnSuffixSeqKRInit 0 s rb (RB.startOf rb)

1977+ in skip $ SplitOnSuffixSeqYield b next

1978+ Skip s -> skip $ SplitOnSuffixSeqKRInit idx0 s rb rh0

1979+ Stop -> return Stop

15911980

1592− step _ (ICUSecondInner s1 s2 i2) = do

1593− r <- istep2 i2

1594− return $ case r of

1595− Yield x i' -> Yield x (ICUSecondInner s1 s2 i')

1596− Skip i' -> Skip (ICUSecondInner s1 s2 i')

1597− Stop -> Skip (ICUFirst s1 s2)

1981+ stepOuter gst (SplitOnSuffixSeqKRInit1 fs0 st0 rb rh0) = do

1982+ go SPEC 1 rh0 st0 fs0

15981983

1599− step _ (ICUSecondOnly _s2) = undefined

1600− step _ (ICUSecondOnlyInner _s2 _i2) = undefined

1984+ where

16011985

1602−{-# ANN type InterposeSuffixState Fuse #-}

1603−data InterposeSuffixState s1 i1 =

1604− InterposeSuffixFirst s1

1605− -- | InterposeSuffixFirstYield s1 i1

1606− | InterposeSuffixFirstInner s1 i1

1607− | InterposeSuffixSecond s1

1986+ go !_ !idx !rh st !fs = do

1987+ res <- step (adaptState gst) st

1988+ case res of

1989+ Yield x s -> do

1990+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

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

1992+ case r of

1993+ FL.Partial fs1 ->

1994+ if idx /= maxIndex

1995+ then go SPEC (idx + 1) rh1 s fs1

1996+ else skip $

1997+ let fold = RB.unsafeFoldRing (RB.ringBound rb)

1998+ !ringHash = fold addCksum 0 rb

1999+ in if ringHash == patHash

2000+ then SplitOnSuffixSeqKRCheck fs1 s rb rh1

2001+ else SplitOnSuffixSeqKRLoop

2002+ fs1 s rb rh1 ringHash

2003+ FL.Done b ->

2004+ let next = SplitOnSuffixSeqKRInit

2005+ 0 st rb (RB.startOf rb)

2006+ in skip $ SplitOnSuffixSeqYield b next

2007+ Skip s -> go SPEC idx rh s fs

2008+ Stop -> do

2009+ -- do not issue a blank segment when we end at pattern

2010+ if (idx == maxIndex) && RB.unsafeEqArray rb rh patArr

2011+ then return Stop

2012+ else if withSep

2013+ then do

2014+ r <- done fs

2015+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2016+ else skip $ SplitOnSuffixSeqKRDone idx fs rb (RB.startOf rb)

16082017

1609−-- Note that if an unfolded layer turns out to be nil we still emit the

1610−-- separator effect. An alternate behavior could be to emit the separator

1611−-- effect only if at least one element has been yielded by the unfolding.

1612−-- However, that becomes a bit complicated, so we have chosen the former

1613−-- behvaior for now.

1614−{-# INLINE_NORMAL interposeSuffix #-}

1615−interposeSuffix

1616− :: Monad m

1617− => m c -> Unfold m b c -> Stream m b -> Stream m c

1618−interposeSuffix

1619− action

1620− (Unfold istep1 inject1) (Stream step1 state1) =

1621− Stream step (InterposeSuffixFirst state1)

2018+ stepOuter gst (SplitOnSuffixSeqKRLoop fs0 st0 rb rh0 cksum0) =

2019+ go SPEC fs0 st0 rh0 cksum0

16222020

1623− where

2021+ where

16242022

1625− {-# INLINE_LATE step #-}

1626− step gst (InterposeSuffixFirst s1) = do

1627− r <- step1 (adaptState gst) s1

1628− case r of

1629− Yield a s -> do

1630− i <- inject1 a

1631− i `seq` return (Skip (InterposeSuffixFirstInner s i))

1632− -- i `seq` return (Skip (InterposeSuffixFirstYield s i))

1633− Skip s -> return $ Skip (InterposeSuffixFirst s)

1634− Stop -> return Stop

2023+ go !_ !fs !st !rh !cksum = do

2024+ res <- step (adaptState gst) st

2025+ case res of

2026+ Yield x s -> do

2027+ old <- liftIO $ peek rh

2028+ rh1 <- liftIO (RB.unsafeInsert rb rh x)

2029+ let cksum1 = deltaCksum cksum old x

2030+ r <- if withSep then fstep fs x else fstep fs old

2031+ case r of

2032+ FL.Partial fs1 ->

2033+ if (cksum1 /= patHash)

2034+ then go SPEC fs1 s rh1 cksum1

2035+ else skip $ SplitOnSuffixSeqKRCheck fs1 s rb rh1

2036+ FL.Done b ->

2037+ let next = SplitOnSuffixSeqKRInit

2038+ 0 st rb (RB.startOf rb)

2039+ in skip $ SplitOnSuffixSeqYield b next

2040+ Skip s -> go SPEC fs s rh cksum

2041+ Stop ->

2042+ if RB.unsafeEqArray rb rh patArr

2043+ then return Stop

2044+ else if withSep

2045+ then do

2046+ r <- done fs

2047+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2048+ else skip $ SplitOnSuffixSeqKRDone patLen fs rb rh

16352049

1636− {-

1637− step _ (InterposeSuffixFirstYield s1 i1) = do

1638− r <- istep1 i1

1639− return $ case r of

1640− Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')

1641− Skip i' -> Skip (InterposeSuffixFirstYield s1 i')

1642− Stop -> Skip (InterposeSuffixFirst s1)

1643− -}

2050+ stepOuter _ (SplitOnSuffixSeqKRCheck fs st rb rh) = do

2051+ if RB.unsafeEqArray rb rh patArr

2052+ then do

2053+ r <- done fs

2054+ let next = SplitOnSuffixSeqKRInit 0 st rb (RB.startOf rb)

2055+ skip $ SplitOnSuffixSeqYield r next

2056+ else skip $ SplitOnSuffixSeqKRLoop fs st rb rh patHash

16442057

1645− step _ (InterposeSuffixFirstInner s1 i1) = do

1646− r <- istep1 i1

1647− return $ case r of

1648− Yield x i' -> Yield x (InterposeSuffixFirstInner s1 i')

1649− Skip i' -> Skip (InterposeSuffixFirstInner s1 i')

1650− Stop -> Skip (InterposeSuffixSecond s1)

2058+ stepOuter _ (SplitOnSuffixSeqKRDone 0 fs _ _) = do

2059+ r <- done fs

2060+ skip $ SplitOnSuffixSeqYield r SplitOnSuffixSeqDone

2061+ stepOuter _ (SplitOnSuffixSeqKRDone n fs rb rh) = do

2062+ old <- liftIO $ peek rh

2063+ let rh1 = RB.advance rb rh

2064+ r <- fstep fs old

2065+ case r of

2066+ FL.Partial fs1 -> skip $ SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

2067+ FL.Done b -> do

2068+ fs1 <- initial

2069+ let next = SplitOnSuffixSeqKRDone (n - 1) fs1 rb rh1

2070+ skip $ SplitOnSuffixSeqYield b next

16512071

1652− step _ (InterposeSuffixSecond s1) = do

1653− r <- action

1654− return $ Yield r (InterposeSuffixFirst s1)

2072+------------------------------------------------------------------------------

2073+-- Nested Container Transformation

2074+------------------------------------------------------------------------------

16552075

1656−data ICALState s1 s2 i1 i2 a =

1657− ICALFirst s1 s2

1658− -- | ICALFirstYield s1 s2 i1

1659− | ICALFirstInner s1 s2 i1

1660− | ICALFirstOnly s1

1661− | ICALFirstOnlyInner s1 i1

1662− | ICALSecondInject s1 s2

1663− | ICALFirstInject s1 s2 i2

1664− -- | ICALFirstBuf s1 s2 i1 i2

1665− | ICALSecondInner s1 s2 i1 i2

1666− -- -- | ICALSecondInner s1 s2 i1 i2 a

1667− -- -- | ICALFirstResume s1 s2 i1 i2 a

2076+{-# ANN type SplitState Fuse #-}

2077+data SplitState s arr

2078+ = SplitInitial s

2079+ | SplitBuffering s arr

2080+ | SplitSplitting s arr

2081+ | SplitYielding arr (SplitState s arr)

2082+ | SplitFinishing

16682083

1669−-- | Interleave streams (full streams, not the elements) unfolded from two

1670−-- input streams and concat. Stop when the first stream stops. If the second

1671−-- stream ends before the first one then first stream still keeps running alone

1672−-- without any interleaving with the second stream.

2084+-- XXX An alternative approach would be to use a partial fold (Fold m a b) to

2085+-- split using a splitBy like combinator. The Fold would consume upto the

2086+-- separator and return any leftover which can then be fed to the next fold.

16732087--

1674−-- [a1, a2, ... an] [b1, b2 ...]

1675−-- => [streamA1, streamA2, ... streamAn] [streamB1, streamB2, ...]

1676−-- => [streamA1, streamB1, streamA2...StreamAn, streamBn]

1677−-- => [a11, a12, ...a1j, b11, b12, ...b1k, a21, a22, ...]

2088+-- We can revisit this once we have partial folds/parsers.

16782089--

1679−{-# INLINE_NORMAL gintercalate #-}

1680−gintercalate

2090+-- | Performs infix separator style splitting.

2091+{-# INLINE_NORMAL splitInnerBy #-}

2092+splitInnerBy

16812093 :: Monad m

1682− => Unfold m a c -> Stream m a -> Unfold m b c -> Stream m b -> Stream m c

1683−gintercalate

1684− (Unfold istep1 inject1) (Stream step1 state1)

1685− (Unfold istep2 inject2) (Stream step2 state2) =

1686− Stream step (ICALFirst state1 state2)

2094+ => (f a -> m (f a, Maybe (f a))) -- splitter

2095+ -> (f a -> f a -> m (f a)) -- joiner

2096+ -> Stream m (f a)

2097+ -> Stream m (f a)

2098+splitInnerBy splitter joiner (Stream step1 state1) =

2099+ (Stream step (SplitInitial state1))

16872100

16882101 where

16892102

16902103 {-# INLINE_LATE step #-}

1691− step gst (ICALFirst s1 s2) = do

1692− r <- step1 (adaptState gst) s1

1693− case r of

1694− Yield a s -> do

1695− i <- inject1 a

1696− i `seq` return (Skip (ICALFirstInner s s2 i))

1697− -- i `seq` return (Skip (ICALFirstYield s s2 i))

1698− Skip s -> return $ Skip (ICALFirst s s2)

1699− Stop -> return Stop

1700−

1701− {-

1702− step _ (ICALFirstYield s1 s2 i1) = do

1703− r <- istep1 i1

1704− return $ case r of

1705− Yield x i' -> Yield x (ICALFirstInner s1 s2 i')

1706− Skip i' -> Skip (ICALFirstYield s1 s2 i')

1707− Stop -> Skip (ICALFirst s1 s2)

1708− -}

1709−

1710− step _ (ICALFirstInner s1 s2 i1) = do

1711− r <- istep1 i1

1712− return $ case r of

1713− Yield x i' -> Yield x (ICALFirstInner s1 s2 i')

1714− Skip i' -> Skip (ICALFirstInner s1 s2 i')

1715− Stop -> Skip (ICALSecondInject s1 s2)

1716−

1717− step gst (ICALFirstOnly s1) = do

1718− r <- step1 (adaptState gst) s1

1719− case r of

1720− Yield a s -> do

1721− i <- inject1 a

1722− i `seq` return (Skip (ICALFirstOnlyInner s i))

1723− Skip s -> return $ Skip (ICALFirstOnly s)

1724− Stop -> return Stop

1725−

1726− step _ (ICALFirstOnlyInner s1 i1) = do

1727− r <- istep1 i1

1728− return $ case r of

1729− Yield x i' -> Yield x (ICALFirstOnlyInner s1 i')

1730− Skip i' -> Skip (ICALFirstOnlyInner s1 i')

1731− Stop -> Skip (ICALFirstOnly s1)

1732−

1733− -- We inject the second stream even before checking if the first stream

1734− -- would yield any more elements. There is no clear choice whether we

1735− -- should do this before or after that. Doing it after may make the state

1736− -- machine a bit simpler though.

1737− step gst (ICALSecondInject s1 s2) = do

1738− r <- step2 (adaptState gst) s2

2104+ step gst (SplitInitial st) = do

2105+ r <- step1 gst st

17392106 case r of

1740− Yield a s -> do

1741− i <- inject2 a

1742− i `seq` return (Skip (ICALFirstInject s1 s i))

1743− Skip s -> return $ Skip (ICALSecondInject s1 s)

1744− Stop -> return $ Skip (ICALFirstOnly s1)

2107+ Yield x s -> do

2108+ (x1, mx2) <- splitter x

2109+ return $ case mx2 of

2110+ Nothing -> Skip (SplitBuffering s x1)

2111+ Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))

2112+ Skip s -> return $ Skip (SplitInitial s)

2113+ Stop -> return $ Stop

17452114

1746− step gst (ICALFirstInject s1 s2 i2) = do

1747− r <- step1 (adaptState gst) s1

2115+ step gst (SplitBuffering st buf) = do

2116+ r <- step1 gst st

17482117 case r of

1749− Yield a s -> do

1750− i <- inject1 a

1751− i `seq` return (Skip (ICALSecondInner s s2 i i2))

1752− -- i `seq` return (Skip (ICALFirstBuf s s2 i i2))

1753− Skip s -> return $ Skip (ICALFirstInject s s2 i2)

1754− Stop -> return Stop

1755−

1756− {-

1757− step _ (ICALFirstBuf s1 s2 i1 i2) = do

1758− r <- istep1 i1

1759− return $ case r of

1760− Yield x i' -> Skip (ICALSecondInner s1 s2 i' i2 x)

1761− Skip i' -> Skip (ICALFirstBuf s1 s2 i' i2)

1762− Stop -> Stop

1763−

1764− step _ (ICALSecondInner s1 s2 i1 i2 v) = do

1765− r <- istep2 i2

1766− return $ case r of

1767− Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i' v)

1768− Skip i' -> Skip (ICALSecondInner s1 s2 i1 i' v)

1769− Stop -> Skip (ICALFirstResume s1 s2 i1 i2 v)

1770− -}

1771−

1772− step _ (ICALSecondInner s1 s2 i1 i2) = do

1773− r <- istep2 i2

1774− return $ case r of

1775− Yield x i' -> Yield x (ICALSecondInner s1 s2 i1 i')

1776− Skip i' -> Skip (ICALSecondInner s1 s2 i1 i')

1777− Stop -> Skip (ICALFirstInner s1 s2 i1)

1778− -- Stop -> Skip (ICALFirstResume s1 s2 i1 i2)

2118+ Yield x s -> do

2119+ (x1, mx2) <- splitter x

2120+ buf' <- joiner buf x1

2121+ return $ case mx2 of

2122+ Nothing -> Skip (SplitBuffering s buf')

2123+ Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))

2124+ Skip s -> return $ Skip (SplitBuffering s buf)

2125+ Stop -> return $ Skip (SplitYielding buf SplitFinishing)

17792126

1780− {-

1781− step _ (ICALFirstResume s1 s2 i1 i2 x) = do

1782− return $ Yield x (ICALFirstInner s1 s2 i1 i2)

1783− -}

2127+ step _ (SplitSplitting st buf) = do

2128+ (x1, mx2) <- splitter buf

2129+ return $ case mx2 of

2130+ Nothing -> Skip $ SplitBuffering st x1

2131+ Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)

17842132

1785−{-# ANN type InterposeState Fuse #-}

1786−data InterposeState s1 i1 a =

1787− InterposeFirst s1

1788− -- | InterposeFirstYield s1 i1

1789− | InterposeFirstInner s1 i1

1790− | InterposeFirstInject s1

1791− -- | InterposeFirstBuf s1 i1

1792− | InterposeSecondYield s1 i1

1793− -- -- | InterposeSecondYield s1 i1 a

1794− -- -- | InterposeFirstResume s1 i1 a

2133+ step _ (SplitYielding x next) = return $ Yield x next

2134+ step _ SplitFinishing = return $ Stop

17952135

1796−-- Note that this only interposes the pure values, we may run many effects to

1797−-- generate those values as some effects may not generate anything (Skip).

1798−{-# INLINE_NORMAL interpose #-}

1799−interpose :: Monad m => m c -> Unfold m b c -> Stream m b -> Stream m c

1800−interpose

1801− action

1802− (Unfold istep1 inject1) (Stream step1 state1) =

1803− Stream step (InterposeFirst state1)

2136+-- | Performs infix separator style splitting.

2137+{-# INLINE_NORMAL splitInnerBySuffix #-}

2138+splitInnerBySuffix

2139+ :: (Monad m, Eq (f a), Monoid (f a))

2140+ => (f a -> m (f a, Maybe (f a))) -- splitter

2141+ -> (f a -> f a -> m (f a)) -- joiner

2142+ -> Stream m (f a)

2143+ -> Stream m (f a)

2144+splitInnerBySuffix splitter joiner (Stream step1 state1) =

2145+ (Stream step (SplitInitial state1))

18042146

18052147 where

18062148

18072149 {-# INLINE_LATE step #-}

1808− step gst (InterposeFirst s1) = do

1809− r <- step1 (adaptState gst) s1

2150+ step gst (SplitInitial st) = do

2151+ r <- step1 gst st

18102152 case r of

1811− Yield a s -> do

1812− i <- inject1 a

1813− i `seq` return (Skip (InterposeFirstInner s i))

1814− -- i `seq` return (Skip (InterposeFirstYield s i))

1815− Skip s -> return $ Skip (InterposeFirst s)

1816− Stop -> return Stop

1817−

1818− {-

1819− step _ (InterposeFirstYield s1 i1) = do

1820− r <- istep1 i1

1821− return $ case r of

1822− Yield x i' -> Yield x (InterposeFirstInner s1 i')

1823− Skip i' -> Skip (InterposeFirstYield s1 i')

1824− Stop -> Skip (InterposeFirst s1)

1825− -}

1826−

1827− step _ (InterposeFirstInner s1 i1) = do

1828− r <- istep1 i1

1829− return $ case r of

1830− Yield x i' -> Yield x (InterposeFirstInner s1 i')

1831− Skip i' -> Skip (InterposeFirstInner s1 i')

1832− Stop -> Skip (InterposeFirstInject s1)

2153+ Yield x s -> do

2154+ (x1, mx2) <- splitter x

2155+ return $ case mx2 of

2156+ Nothing -> Skip (SplitBuffering s x1)

2157+ Just x2 -> Skip (SplitYielding x1 (SplitSplitting s x2))

2158+ Skip s -> return $ Skip (SplitInitial s)

2159+ Stop -> return $ Stop

18332160

1834− step gst (InterposeFirstInject s1) = do

1835− r <- step1 (adaptState gst) s1

2161+ step gst (SplitBuffering st buf) = do

2162+ r <- step1 gst st

18362163 case r of

1837− Yield a s -> do

1838− i <- inject1 a

1839− -- i `seq` return (Skip (InterposeFirstBuf s i))

1840− i `seq` return (Skip (InterposeSecondYield s i))

1841− Skip s -> return $ Skip (InterposeFirstInject s)

1842− Stop -> return Stop

1843−

1844− {-

1845− step _ (InterposeFirstBuf s1 i1) = do

1846− r <- istep1 i1

1847− return $ case r of

1848− Yield x i' -> Skip (InterposeSecondYield s1 i' x)

1849− Skip i' -> Skip (InterposeFirstBuf s1 i')

1850− Stop -> Stop

1851− -}

2164+ Yield x s -> do

2165+ (x1, mx2) <- splitter x

2166+ buf' <- joiner buf x1

2167+ return $ case mx2 of

2168+ Nothing -> Skip (SplitBuffering s buf')

2169+ Just x2 -> Skip (SplitYielding buf' (SplitSplitting s x2))

2170+ Skip s -> return $ Skip (SplitBuffering s buf)

2171+ Stop -> return $

2172+ if buf == mempty

2173+ then Stop

2174+ else Skip (SplitYielding buf SplitFinishing)

18522175

1853− {-

1854− step _ (InterposeSecondYield s1 i1 v) = do

1855− r <- action

1856− return $ Yield r (InterposeFirstResume s1 i1 v)

1857− -}

1858− step _ (InterposeSecondYield s1 i1) = do

1859− r <- action

1860− return $ Yield r (InterposeFirstInner s1 i1)

2176+ step _ (SplitSplitting st buf) = do

2177+ (x1, mx2) <- splitter buf

2178+ return $ case mx2 of

2179+ Nothing -> Skip $ SplitBuffering st x1

2180+ Just x2 -> Skip $ SplitYielding x1 (SplitSplitting st x2)

18612181

1862− {-

1863− step _ (InterposeFirstResume s1 i1 v) = do

1864− return $ Yield v (InterposeFirstInner s1 i1)

1865− -}

2182+ step _ (SplitYielding x next) = return $ Yield x next

2183+ step _ SplitFinishing = return Stop

src/Streamly/Internal/Data/Stream/StreamD/Transform.hs+790−1026

@@ -1,24 +1,48 @@

1−#include "inline.hs"

2−

31-- |

42-- Module : Streamly.Internal.Data.Stream.StreamD.Transform

4+-- (c) Roman Leshchinskiy 2008-2010

65-- License : BSD-3-Clause

76-- Maintainer : streamly@composewell.com

87-- Stability : experimental

98-- Portability : GHC

9+--

10+-- "Streamly.Internal.Data.Pipe" might ultimately replace this module.

11+

12+-- A few functions in this module have been adapted from the vector package

13+-- (c) Roman Leshchinskiy. See the notes in specific combinators.

1014

1115module Streamly.Internal.Data.Stream.StreamD.Transform

1216 (

13− -- * Transformation

17+ -- * Piping

18+ -- | Pass through a 'Pipe'.

1419 transform

1520

16− -- ** By folding

21+ -- * Mapping

22+ -- | Stateless one-to-one maps.

23+ , map

24+ , mapM

25+ , sequence

26+

27+ -- * Mapping Effects

28+ , tap

29+ , tapOffsetEvery

30+ , tapAsync

31+ , tapRate

32+ , pollCounts

33+

34+ -- * Folding

1735 , foldrS

1836 , foldrT

1937 , foldlS

2038 , foldlT

2139

40+ -- * Scanning By 'Fold'

41+ , postscanOnce -- XXX rename to postscan

42+ , scanOnce -- XXX rename to scan

43+

44+ -- * Scanning

45+ -- | Left scans. Stateful, mostly one-to-one maps.

2246 , scanlM'

2347 , scanlMAfter'

2448 , scanl'

@@ -42,17 +66,16 @@ module Streamly.Internal.Data.Stream.StreamD.Transform

4266 , postscanlMx'

4367 , scanlMx'

4468 , scanlx'

45− , postscanOnce

46− , scanOnce

47−

48− -- * Reordering

49− , reverse

50− , reverse'

5169

5270 -- * Filtering

71+ -- | Produce a subset of the stream.

5372 , filter

5473 , filterM

74+ , deleteBy

5575 , uniq

76+

77+ -- * Trimming

78+ -- | Produce a subset of the stream trimmed at ends.

5679 , take

5780 , takeByTime

5881 , takeWhile

@@ -62,76 +85,61 @@ module Streamly.Internal.Data.Stream.StreamD.Transform

6285 , dropWhile

6386 , dropWhileM

6487

65− -- * Mapping

66− , map

67− , mapM

68− , sequence

69− , rollingMap

70− , rollingMapM

71−

72− -- ** Special Maps

73− , tap

74− , tapOffsetEvery

75− , tapAsync

76− , tapRate

77− , pollCounts

78−

79− -- * Inserting

80− , intersperseM

81− , intersperseM_

88+ -- * Inserting Elements

89+ -- | Produce a superset of the stream.

90+ , insertBy

8291 , intersperse

92+ , intersperseM

8393 , intersperseSuffix

84− , intersperseSuffix_

8594 , intersperseSuffixBySpan

86− , insertBy

8795

88− -- * Deleting

89− , deleteBy

96+ -- * Inserting Side Effects

97+ , intersperseM_

98+ , intersperseSuffix_

99+

100+ -- * Reordering

101+ -- | Produce strictly the same set but reordered.

102+ , reverse

103+ , reverse'

90104

91− -- ** Map and Filter

105+ -- * Position Indexing

106+ , indexed

107+ , indexedR

108+

109+ -- * Searching

110+ , findIndices

111+

112+ -- * Rolling map

113+ -- | Map using the previous element.

114+ , rollingMap

115+ , rollingMapM

116+

117+ -- * Maybe Streams

92118 , mapMaybe

93119 , mapMaybeM

94120

95− -- * Parsers

96− , parseMany

97− , parseIterate

98−

99− -- * Concurrent Application

121+ -- * Threading

122+ -- | Make the stream concurrent

100123 , mkParallel

101124 , mkParallelD

102−

103− -- ** Conversions

104− -- | Transform a stream into another type.

105− , hoist

106− , generally

107−

108− , liftInner

109− , runReaderT

110− , evalStateT

111− , runStateT

112125 )

113126where

114127

128+#include "inline.hs"

129+

115130import Control.Concurrent (killThread, myThreadId, takeMVar, threadDelay)

116−import Control.Exception (assert, AsyncException)

131+import Control.Exception (AsyncException)

117132import Control.Monad (void, when)

118−import Control.Monad.Catch (MonadCatch, MonadThrow, throwM)

133+import Control.Monad.Catch (MonadCatch, throwM)

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

120135import Control.Monad.Trans.Class (MonadTrans(lift))

121−import Control.Monad.Trans.Reader (ReaderT)

122−import Control.Monad.Trans.State.Strict (StateT)

123−import Data.Functor.Identity (Identity(..))

124136import Data.IORef (newIORef, mkWeakIORef)

125137import Data.Maybe (fromJust, isJust)

126138import Foreign.Storable (Storable(..))

127−import Fusion.Plugin.Types (Fuse(..))

128139import GHC.Types (SPEC(..))

129140import qualified Control.Monad.Catch as MC

130−import qualified Control.Monad.Trans.Reader as Reader

131−import qualified Control.Monad.Trans.State.Strict as State

132141

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

134−import Streamly.Internal.Data.Parser (ParseError(..))

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

136144import Streamly.Internal.Data.Stream.SVar (fromConsumer, pushToFold)

137145import Streamly.Internal.Data.Time.Clock (Clock(Monotonic), getTime)

@@ -141,22 +149,19 @@ import Streamly.Internal.Data.Time.Units

141149import qualified Streamly.Internal.Data.Array.Storable.Foreign.Types as A

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

143151import qualified Streamly.Internal.Data.IORef.Prim as Prim

144−import qualified Streamly.Internal.Data.Parser as PR

145−import qualified Streamly.Internal.Data.Parser.ParserD as PRD

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

147153import qualified Streamly.Internal.Data.Stream.StreamK as K

148154

149−import qualified Prelude

150155import Prelude hiding

151156 ( drop, dropWhile, filter, map, mapM, reverse

152− , scanl, scanl1, sequence, take, takeWhile, zipWith)

157+ , scanl, scanl1, sequence, take, takeWhile)

153158

154159import Streamly.Internal.Data.Stream.StreamD.Type

155160import Streamly.Internal.Data.SVar

156161

157−-------------------------------------------------------------------------------

158−-- General transformation

159−-------------------------------------------------------------------------------

162+------------------------------------------------------------------------------

163+-- Piping

164+------------------------------------------------------------------------------

160165

161166{-# INLINE_NORMAL transform #-}

162167transform :: Monad m => Pipe m a b -> Stream m a -> Stream m b

@@ -185,11 +190,7 @@ transform (Pipe pstep1 pstep2 pstate) (Stream step state) =

185190 Pipe.Continue pst' -> return $ Skip (pst', st)

186191

187192------------------------------------------------------------------------------

188−-- Transformation by Folding

189−------------------------------------------------------------------------------

190−

191−------------------------------------------------------------------------------

192−-- Left Folds

193+-- Transformation Folds

193194------------------------------------------------------------------------------

194195

195196{-# INLINE_NORMAL foldlT #-}

@@ -227,143 +228,397 @@ foldlS fstep begin (Stream step state) = Stream step' (Left (state, begin))

227228 Stop -> Stop

228229

229230------------------------------------------------------------------------------

230−-- Prescans

231+-- Transformation by Mapping

231232------------------------------------------------------------------------------

232233

233−-- XXX Is a prescan useful, discarding the last step does not sound useful? I

234−-- am not sure about the utility of this function, so this is implemented but

235−-- not exposed. We can expose it if someone provides good reasons why this is

236−-- useful.

237−--

238−-- XXX We have to execute the stream one step ahead to know that we are at the

239−-- last step. The vector implementation of prescan executes the last fold step

240−-- but does not yield the result. This means we have executed the effect but

241−-- discarded value. This does not sound right. In this implementation we are

242−-- not executing the last fold step.

243−{-# INLINE_NORMAL prescanlM' #-}

244−prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

245−prescanlM' f mz (Stream step state) = Stream step' (state, mz)

234+{-# INLINE_NORMAL sequence #-}

235+sequence :: Monad m => Stream m (m a) -> Stream m a

236+sequence (Stream step state) = Stream step' state

246237 where

247238 {-# INLINE_LATE step' #-}

248− step' gst (st, prev) = do

249− r <- step (adaptState gst) st

250− case r of

251− Yield x s -> do

252− acc <- prev

253− return $ Yield acc (s, f acc x)

254− Skip s -> return $ Skip (s, prev)

255− Stop -> return Stop

256−

257−{-# INLINE prescanl' #-}

258−prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

259−prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)

239+ step' gst st = do

240+ r <- step (adaptState gst) st

241+ case r of

242+ Yield x s -> x >>= \a -> return (Yield a s)

243+ Skip s -> return $ Skip s

244+ Stop -> return Stop

260245

261246------------------------------------------------------------------------------

262−-- Monolithic postscans (postscan followed by a map)

247+-- Mapping side effects

263248------------------------------------------------------------------------------

264249

265−-- The performance of a modular postscan followed by a map seems to be

266−-- equivalent to this monolithic scan followed by map therefore we may not need

267−-- this implementation. We just have it for performance comparison and in case

268−-- modular version does not perform well in some situation.

269−--

270−{-# INLINE_NORMAL postscanlMx' #-}

271−postscanlMx' :: Monad m

272− => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

273−postscanlMx' fstep begin done (Stream step state) = do

274− Stream step' (state, begin)

275− where

276− {-# INLINE_LATE step' #-}

277− step' gst (st, acc) = do

278− r <- step (adaptState gst) st

279− case r of

280− Yield x s -> do

281− old <- acc

282− y <- fstep old x

283− v <- done y

284− v `seq` y `seq` return (Yield v (s, return y))

285− Skip s -> return $ Skip (s, acc)

286− Stop -> return Stop

287−

288−{-# INLINE_NORMAL postscanlx' #-}

289−postscanlx' :: Monad m

290− => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

291−postscanlx' fstep begin done s =

292− postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

293−

294−-- XXX do we need consM strict to evaluate the begin value?

295−{-# INLINE scanlMx' #-}

296−scanlMx' :: Monad m

297− => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

298−scanlMx' fstep begin done s =

299− (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s

300−

301−data PostScanState s f = PostScan s !f

250+data TapState fs st a

251+ = TapInit | Tapping !fs st | TapDone st

302252

303−{-# INLINE_NORMAL postscanOnce #-}

304−postscanOnce :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b

305−postscanOnce (FL.Fold fstep begin done) (Stream step state) =

306− Stream step' (PostScan state begin)

253+-- XXX Multiple yield points

254+{-# INLINE tap #-}

255+tap :: Monad m => Fold m a b -> Stream m a -> Stream m a

256+tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

307257

308258 where

309259

310− {-# INLINE_LATE step' #-}

311− step' gst (PostScan st acc) = do

312− r <- step (adaptState gst) st

260+ step' _ TapInit = do

261+ r <- initial

262+ return $ Skip (Tapping r state)

263+ step' gst (Tapping acc st) = do

264+ r <- step gst st

313265 case r of

266+ -- XXX Abstract Yield?

314267 Yield x s -> do

315− old <- acc

316− res <- fstep old x

317− case res of

318− FL.Partial fs -> do

319− !v <- done fs

320− return $ Yield v $ PostScan s (return fs)

321− FL.Done _ -> return Stop

322− Skip s -> return $ Skip $ PostScan s acc

323− Stop -> return Stop

268+ res <- fstep acc x

269+ return

270+ $ Yield x

271+ $ case res of

272+ FL.Partial fs -> Tapping fs s

273+ FL.Done _ -> TapDone s

274+ Skip s -> return $ Skip (Tapping acc s)

275+ Stop -> do

276+ void $ extract acc

277+ return Stop

278+ step' gst (TapDone st) = do

279+ r <- step gst st

280+ return

281+ $ case r of

282+ Yield x s -> Yield x (TapDone s)

283+ Skip s -> Skip (TapDone s)

284+ Stop -> Stop

324285

325−{-# INLINE scanOnce #-}

326−scanOnce :: Monad m

327− => FL.Fold m a b -> Stream m a -> Stream m b

328−scanOnce fld@(FL.Fold _ begin done) s =

329− (begin >>= \x -> x `seq` done x) `consM` postscanOnce fld s

286+data TapOffState fs s a

287+ = TapOffInit

288+ | TapOffTapping !fs s Int

289+ | TapOffDone s

330290

331−{-# INLINE scanlx' #-}

332−scanlx' :: Monad m

333− => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

334−scanlx' fstep begin done s =

335− scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

291+-- XXX Multiple yield points

292+{-# INLINE_NORMAL tapOffsetEvery #-}

293+tapOffsetEvery :: Monad m

294+ => Int -> Int -> Fold m a b -> Stream m a -> Stream m a

295+tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

296+ Stream step' TapOffInit

336297

337−------------------------------------------------------------------------------

338−-- postscans

339−------------------------------------------------------------------------------

298+ where

340299

341−{-# INLINE_NORMAL postscanlM' #-}

342−postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

343−postscanlM' fstep begin (Stream step state) =

344− Stream step' Nothing

345− where

346300 {-# INLINE_LATE step' #-}

347− step' _ Nothing = do

348− !x <- begin

349− return $ Skip (Just (state, x))

350−

351− step' gst (Just (st, acc)) = do

352− r <- step (adaptState gst) st

301+ step' _ TapOffInit = do

302+ r <- initial

303+ return $ Skip $ TapOffTapping r state (offset `mod` n)

304+ step' gst (TapOffTapping acc st count) = do

305+ r <- step gst st

353306 case r of

354307 Yield x s -> do

355− !y <- fstep acc x

356− return $ Yield y (Just (s, y))

357− Skip s -> return $ Skip (Just (s, acc))

358− Stop -> return Stop

359−

360−{-# INLINE_NORMAL postscanl' #-}

361−postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

362−postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)

308+ next <-

309+ if count <= 0

310+ then do

311+ res <- fstep acc x

312+ return

313+ $ case res of

314+ FL.Partial sres ->

315+ TapOffTapping sres s (n - 1)

316+ FL.Done _ -> TapOffDone s

317+ else return $ TapOffTapping acc s (count - 1)

318+ return $ Yield x next

319+ Skip s -> return $ Skip (TapOffTapping acc s count)

320+ Stop -> do

321+ void $ extract acc

322+ return Stop

323+ step' gst (TapOffDone st) = do

324+ r <- step gst st

325+ return

326+ $ case r of

327+ Yield x s -> Yield x (TapOffDone s)

328+ Skip s -> Skip (TapOffDone s)

329+ Stop -> Stop

363330

364−-- We can possibly have the "done" function as a Maybe to provide an option to

365−-- emit or not emit the accumulator when the stream stops.

366−--

331+{-# INLINE_NORMAL pollCounts #-}

332+pollCounts

333+ :: MonadAsync m

334+ => (a -> Bool)

335+ -> (Stream m Int -> Stream m Int)

336+ -> Fold m Int b

337+ -> Stream m a

338+ -> Stream m a

339+pollCounts predicate transf fld (Stream step state) = Stream step' Nothing

340+ where

341+

342+ {-# INLINE_LATE step' #-}

343+ step' _ Nothing = do

344+ -- As long as we are using an "Int" for counts lockfree reads from

345+ -- Var should work correctly on both 32-bit and 64-bit machines.

346+ -- However, an Int on a 32-bit machine may overflow quickly.

347+ countVar <- liftIO $ Prim.newIORef (0 :: Int)

348+ tid <- forkManaged

349+ $ void $ foldOnce fld

350+ $ transf $ fromPrimIORef countVar

351+ return $ Skip (Just (countVar, tid, state))

352+

353+ step' gst (Just (countVar, tid, st)) = do

354+ r <- step gst st

355+ case r of

356+ Yield x s -> do

357+ when (predicate x) $ liftIO $ Prim.modifyIORef' countVar (+ 1)

358+ return $ Yield x (Just (countVar, tid, s))

359+ Skip s -> return $ Skip (Just (countVar, tid, s))

360+ Stop -> do

361+ liftIO $ killThread tid

362+ return Stop

363+

364+{-# INLINE_NORMAL tapRate #-}

365+tapRate ::

366+ (MonadAsync m, MonadCatch m)

367+ => Double

368+ -> (Int -> m b)

369+ -> Stream m a

370+ -> Stream m a

371+tapRate samplingRate action (Stream step state) = Stream step' Nothing

372+ where

373+ {-# NOINLINE loop #-}

374+ loop countVar prev = do

375+ i <-

376+ MC.catch

377+ (do liftIO $ threadDelay (round $ samplingRate * 1000000)

378+ i <- liftIO $ Prim.readIORef countVar

379+ let !diff = i - prev

380+ void $ action diff

381+ return i)

382+ (\(e :: AsyncException) -> do

383+ i <- liftIO $ Prim.readIORef countVar

384+ let !diff = i - prev

385+ void $ action diff

386+ throwM (MC.toException e))

387+ loop countVar i

388+

389+ {-# INLINE_LATE step' #-}

390+ step' _ Nothing = do

391+ countVar <- liftIO $ Prim.newIORef 0

392+ tid <- fork $ loop countVar 0

393+ ref <- liftIO $ newIORef ()

394+ _ <- liftIO $ mkWeakIORef ref (killThread tid)

395+ return $ Skip (Just (countVar, tid, state, ref))

396+

397+ step' gst (Just (countVar, tid, st, ref)) = do

398+ r <- step gst st

399+ case r of

400+ Yield x s -> do

401+ liftIO $ Prim.modifyIORef' countVar (+ 1)

402+ return $ Yield x (Just (countVar, tid, s, ref))

403+ Skip s -> return $ Skip (Just (countVar, tid, s, ref))

404+ Stop -> do

405+ liftIO $ killThread tid

406+ return Stop

407+

408+-------------------------------------------------------------------------------

409+-- Concurrent tap

410+-------------------------------------------------------------------------------

411+

412+-- | Create an SVar with a fold consumer that will fold any elements sent to it

413+-- using the supplied fold function.

414+{-# INLINE newFoldSVar #-}

415+newFoldSVar :: MonadAsync m => State t m a -> Fold m a b -> m (SVar t m a)

416+newFoldSVar stt f = do

417+ -- Buffer size for the SVar is derived from the current state

418+ sv <- newParallelVar StopAny (adaptState stt)

419+ -- Add the producer thread-id to the SVar.

420+ liftIO myThreadId >>= modifyThread sv

421+ void $ doFork (work sv) (svarMrun sv) (handleFoldException sv)

422+ return sv

423+

424+ where

425+

426+ {-# NOINLINE work #-}

427+ work sv = void $ foldOnce f $ fromProducer sv

428+

429+{-# INLINE_NORMAL tapAsync #-}

430+tapAsync :: MonadAsync m => Fold m a b -> Stream m a -> Stream m a

431+tapAsync f (Stream step1 state1) = Stream step TapInit

432+ where

433+

434+ drainFold svr = do

435+ -- In general, a Stop event would come equipped with the result

436+ -- of the fold. It is not used here but it would be useful in

437+ -- applicative and distribute.

438+ done <- fromConsumer svr

439+ when (not done) $ do

440+ liftIO $ withDiagMVar svr "teeToSVar: waiting to drain"

441+ $ takeMVar (outputDoorBellFromConsumer svr)

442+ drainFold svr

443+

444+ stopFold svr = do

445+ liftIO $ sendStop svr Nothing

446+ -- drain/wait until a stop event arrives from the fold.

447+ drainFold svr

448+

449+ {-# INLINE_LATE step #-}

450+ step gst TapInit = do

451+ sv <- newFoldSVar gst f

452+ return $ Skip (Tapping sv state1)

453+

454+ step gst (Tapping sv st) = do

455+ r <- step1 gst st

456+ case r of

457+ Yield a s -> do

458+ done <- pushToFold sv a

459+ if done

460+ then do

461+ -- XXX we do not need to wait synchronously here

462+ stopFold sv

463+ return $ Yield a (TapDone s)

464+ else return $ Yield a (Tapping sv s)

465+ Skip s -> return $ Skip (Tapping sv s)

466+ Stop -> do

467+ stopFold sv

468+ return $ Stop

469+

470+ step gst (TapDone st) = do

471+ r <- step1 gst st

472+ return $ case r of

473+ Yield a s -> Yield a (TapDone s)

474+ Skip s -> Skip (TapDone s)

475+ Stop -> Stop

476+

477+------------------------------------------------------------------------------

478+-- Scanning with a Fold

479+------------------------------------------------------------------------------

480+

481+data PostScanState s f = PostScan s !f

482+

483+{-# INLINE_NORMAL postscanOnce #-}

484+postscanOnce :: Monad m => FL.Fold m a b -> Stream m a -> Stream m b

485+postscanOnce (FL.Fold fstep begin done) (Stream step state) =

486+ Stream step' (PostScan state begin)

487+

488+ where

489+

490+ {-# INLINE_LATE step' #-}

491+ step' gst (PostScan st acc) = do

492+ r <- step (adaptState gst) st

493+ case r of

494+ Yield x s -> do

495+ old <- acc

496+ res <- fstep old x

497+ case res of

498+ FL.Partial fs -> do

499+ !v <- done fs

500+ return $ Yield v $ PostScan s (return fs)

501+ FL.Done _ -> return Stop

502+ Skip s -> return $ Skip $ PostScan s acc

503+ Stop -> return Stop

504+

505+{-# INLINE scanOnce #-}

506+scanOnce :: Monad m

507+ => FL.Fold m a b -> Stream m a -> Stream m b

508+scanOnce fld@(FL.Fold _ begin done) s =

509+ (begin >>= \x -> x `seq` done x) `consM` postscanOnce fld s

510+

511+------------------------------------------------------------------------------

512+-- Scanning - Prescans

513+------------------------------------------------------------------------------

514+

515+-- Adapted from the vector package.

516+--

517+-- XXX Is a prescan useful, discarding the last step does not sound useful? I

518+-- am not sure about the utility of this function, so this is implemented but

519+-- not exposed. We can expose it if someone provides good reasons why this is

520+-- useful.

521+--

522+-- XXX We have to execute the stream one step ahead to know that we are at the

523+-- last step. The vector implementation of prescan executes the last fold step

524+-- but does not yield the result. This means we have executed the effect but

525+-- discarded value. This does not sound right. In this implementation we are

526+-- not executing the last fold step.

527+{-# INLINE_NORMAL prescanlM' #-}

528+prescanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

529+prescanlM' f mz (Stream step state) = Stream step' (state, mz)

530+ where

531+ {-# INLINE_LATE step' #-}

532+ step' gst (st, prev) = do

533+ r <- step (adaptState gst) st

534+ case r of

535+ Yield x s -> do

536+ acc <- prev

537+ return $ Yield acc (s, f acc x)

538+ Skip s -> return $ Skip (s, prev)

539+ Stop -> return Stop

540+

541+{-# INLINE prescanl' #-}

542+prescanl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

543+prescanl' f z = prescanlM' (\a b -> return (f a b)) (return z)

544+

545+------------------------------------------------------------------------------

546+-- Monolithic postscans (postscan followed by a map)

547+------------------------------------------------------------------------------

548+

549+-- The performance of a modular postscan followed by a map seems to be

550+-- equivalent to this monolithic scan followed by map therefore we may not need

551+-- this implementation. We just have it for performance comparison and in case

552+-- modular version does not perform well in some situation.

553+--

554+{-# INLINE_NORMAL postscanlMx' #-}

555+postscanlMx' :: Monad m

556+ => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

557+postscanlMx' fstep begin done (Stream step state) = do

558+ Stream step' (state, begin)

559+ where

560+ {-# INLINE_LATE step' #-}

561+ step' gst (st, acc) = do

562+ r <- step (adaptState gst) st

563+ case r of

564+ Yield x s -> do

565+ old <- acc

566+ y <- fstep old x

567+ v <- done y

568+ v `seq` y `seq` return (Yield v (s, return y))

569+ Skip s -> return $ Skip (s, acc)

570+ Stop -> return Stop

571+

572+{-# INLINE_NORMAL postscanlx' #-}

573+postscanlx' :: Monad m

574+ => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

575+postscanlx' fstep begin done s =

576+ postscanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

577+

578+-- XXX do we need consM strict to evaluate the begin value?

579+{-# INLINE scanlMx' #-}

580+scanlMx' :: Monad m

581+ => (x -> a -> m x) -> m x -> (x -> m b) -> Stream m a -> Stream m b

582+scanlMx' fstep begin done s =

583+ (begin >>= \x -> x `seq` done x) `consM` postscanlMx' fstep begin done s

584+

585+{-# INLINE scanlx' #-}

586+scanlx' :: Monad m

587+ => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> Stream m b

588+scanlx' fstep begin done s =

589+ scanlMx' (\b a -> return (fstep b a)) (return begin) (return . done) s

590+

591+------------------------------------------------------------------------------

592+-- postscans

593+------------------------------------------------------------------------------

594+

595+-- Adapted from the vector package.

596+{-# INLINE_NORMAL postscanlM' #-}

597+postscanlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> Stream m b

598+postscanlM' fstep begin (Stream step state) =

599+ Stream step' Nothing

600+ where

601+ {-# INLINE_LATE step' #-}

602+ step' _ Nothing = do

603+ !x <- begin

604+ return $ Skip (Just (state, x))

605+

606+ step' gst (Just (st, acc)) = do

607+ r <- step (adaptState gst) st

608+ case r of

609+ Yield x s -> do

610+ !y <- fstep acc x

611+ return $ Yield y (Just (s, y))

612+ Skip s -> return $ Skip (Just (s, acc))

613+ Stop -> return Stop

614+

615+{-# INLINE_NORMAL postscanl' #-}

616+postscanl' :: Monad m => (a -> b -> a) -> a -> Stream m b -> Stream m a

617+postscanl' f seed = postscanlM' (\a b -> return (f a b)) (return seed)

618+

619+-- We can possibly have the "done" function as a Maybe to provide an option to

620+-- emit or not emit the accumulator when the stream stops.

621+--

367622-- TBD: use a single Yield point

368623--

369624{-# INLINE_NORMAL postscanlMAfter' #-}

@@ -449,217 +704,71 @@ scanlM fstep begin (Stream step state) = Stream step' Nothing

449704 case r of

450705 Yield x s -> do

451706 y <- fstep acc x

452− return $ Yield y (Just (s, y))

453− Skip s -> return $ Skip (Just (s, acc))

454− Stop -> return $ Stop

455−

456−{-# INLINE scanl #-}

457−scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

458−scanl f seed = scanlM (\a b -> return (f a b)) (return seed)

459−

460−{-# INLINE_NORMAL scanl1M #-}

461−scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

462−scanl1M fstep (Stream step state) = Stream step' (state, Nothing)

463− where

464− {-# INLINE_LATE step' #-}

465− step' gst (st, Nothing) = do

466− r <- step gst st

467− case r of

468− Yield x s -> return $ Yield x (s, Just x)

469− Skip s -> return $ Skip (s, Nothing)

470− Stop -> return Stop

471−

472− step' gst (st, Just acc) = do

473− r <- step gst st

474− case r of

475− Yield y s -> do

476− z <- fstep acc y

477− return $ Yield z (s, Just z)

478− Skip s -> return $ Skip (s, Just acc)

479− Stop -> return Stop

480−

481−{-# INLINE scanl1 #-}

482−scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

483−scanl1 f = scanl1M (\x y -> return (f x y))

484−

485−{-# INLINE_NORMAL scanl1M' #-}

486−scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

487−scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)

488− where

489− {-# INLINE_LATE step' #-}

490− step' gst (st, Nothing) = do

491− r <- step gst st

492− case r of

493− Yield x s -> x `seq` return $ Yield x (s, Just x)

494− Skip s -> return $ Skip (s, Nothing)

495− Stop -> return Stop

496−

497− step' gst (st, Just acc) = acc `seq` do

498− r <- step gst st

499− case r of

500− Yield y s -> do

501− z <- fstep acc y

502− z `seq` return $ Yield z (s, Just z)

503− Skip s -> return $ Skip (s, Just acc)

504− Stop -> return Stop

505−

506−{-# INLINE scanl1' #-}

507−scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

508−scanl1' f = scanl1M' (\x y -> return (f x y))

509−

510−------------------------------------------------------------------------------

511−-- Stateful map/scan

512−------------------------------------------------------------------------------

513−

514−data RollingMapState s a = RollingMapInit s | RollingMapGo s a

515−

516−{-# INLINE rollingMapM #-}

517−rollingMapM :: Monad m => (a -> a -> m b) -> Stream m a -> Stream m b

518−rollingMapM f (Stream step1 state1) = Stream step (RollingMapInit state1)

519− where

520− step gst (RollingMapInit st) = do

521− r <- step1 (adaptState gst) st

522− return $ case r of

523− Yield x s -> Skip $ RollingMapGo s x

524− Skip s -> Skip $ RollingMapInit s

525− Stop -> Stop

526−

527− step gst (RollingMapGo s1 x1) = do

528− r <- step1 (adaptState gst) s1

529− case r of

530− Yield x s -> do

531− !res <- f x x1

532− return $ Yield res $ RollingMapGo s x

533− Skip s -> return $ Skip $ RollingMapGo s x1

534− Stop -> return $ Stop

535−

536−{-# INLINE rollingMap #-}

537−rollingMap :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b

538−rollingMap f = rollingMapM (\x y -> return $ f x y)

539−

540−------------------------------------------------------------------------------

541−-- Reordering

542−------------------------------------------------------------------------------

543−

544−-- We can implement reverse as:

545−--

546−-- > reverse = foldlS (flip cons) nil

547−--

548−-- However, this implementation is unusable because of the horrible performance

549−-- of cons. So we just convert it to a list first and then stream from the

550−-- list.

551−--

552−-- XXX Maybe we can use an Array instead of a list here?

553−{-# INLINE_NORMAL reverse #-}

554−reverse :: Monad m => Stream m a -> Stream m a

555−reverse m = Stream step Nothing

556− where

557− {-# INLINE_LATE step #-}

558− step _ Nothing = do

559− xs <- foldl' (flip (:)) [] m

560− return $ Skip (Just xs)

561− step _ (Just (x:xs)) = return $ Yield x (Just xs)

562− step _ (Just []) = return Stop

563−

564−-- Much faster reverse for Storables

565−{-# INLINE_NORMAL reverse' #-}

566−reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a

567−{-

568−-- This commented implementation copies the whole stream into one single array

569−-- and then streams from that array, this is 3-4x faster than the chunked code

570−-- that follows. Though this could be problematic due to unbounded large

571−-- allocations. We need to figure out why the chunked code is slower and if we

572−-- can optimize the chunked code to work as fast as this one. It may be a

573−-- fusion issue?

574−import Foreign.ForeignPtr (touchForeignPtr)

575−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

576−import Foreign.Ptr (Ptr, plusPtr)

577−reverse' m = Stream step Nothing

578− where

579− {-# INLINE_LATE step #-}

580− step _ Nothing = do

581− arr <- A.fromStreamD m

582− let p = aEnd arr `plusPtr` negate (sizeOf (undefined :: a))

583− return $ Skip $ Just (aStart arr, p)

584−

585− step _ (Just (start, p)) | p < unsafeForeignPtrToPtr start = return Stop

586−

587− step _ (Just (start, p)) = do

588− let !x = A.unsafeInlineIO $ do

589− r <- peek p

590− touchForeignPtr start

591− return r

592− next = p `plusPtr` negate (sizeOf (undefined :: a))

593− return $ Yield x (Just (start, next))

594−-}

595−reverse' m =

596− A.flattenArraysRev

597− $ fromStreamK

598− $ K.reverse

599− $ toStreamK

600− $ A.fromStreamDArraysOf A.defaultChunkSize m

707+ return $ Yield y (Just (s, y))

708+ Skip s -> return $ Skip (Just (s, acc))

709+ Stop -> return $ Stop

601710

602−-------------------------------------------------------------------------------

603−-- Filtering

604−-------------------------------------------------------------------------------

711+{-# INLINE scanl #-}

712+scanl :: Monad m => (b -> a -> b) -> b -> Stream m a -> Stream m b

713+scanl f seed = scanlM (\a b -> return (f a b)) (return seed)

605714

606−{-# INLINE_NORMAL drop #-}

607−drop :: Monad m => Int -> Stream m a -> Stream m a

608−drop n (Stream step state) = Stream step' (state, Just n)

715+-- Adapted from the vector package

716+{-# INLINE_NORMAL scanl1M #-}

717+scanl1M :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

718+scanl1M fstep (Stream step state) = Stream step' (state, Nothing)

609719 where

610720 {-# INLINE_LATE step' #-}

611− step' gst (st, Just i)

612− | i > 0 = do

613− r <- step gst st

614− return $

615− case r of

616− Yield _ s -> Skip (s, Just (i - 1))

617− Skip s -> Skip (s, Just i)

618− Stop -> Stop

619− | otherwise = return $ Skip (st, Nothing)

620−

621721 step' gst (st, Nothing) = do

622− r <- step gst st

623− return $

722+ r <- step gst st

624723 case r of

625− Yield x s -> Yield x (s, Nothing)

626− Skip s -> Skip (s, Nothing)

627− Stop -> Stop

724+ Yield x s -> return $ Yield x (s, Just x)

725+ Skip s -> return $ Skip (s, Nothing)

726+ Stop -> return Stop

628727

629−data DropWhileState s a

630− = DropWhileDrop s

631− | DropWhileYield a s

632− | DropWhileNext s

728+ step' gst (st, Just acc) = do

729+ r <- step gst st

730+ case r of

731+ Yield y s -> do

732+ z <- fstep acc y

733+ return $ Yield z (s, Just z)

734+ Skip s -> return $ Skip (s, Just acc)

735+ Stop -> return Stop

633736

634−{-# INLINE_NORMAL dropWhileM #-}

635−dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a

636−dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)

737+{-# INLINE scanl1 #-}

738+scanl1 :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

739+scanl1 f = scanl1M (\x y -> return (f x y))

740+

741+-- Adapted from the vector package

742+{-# INLINE_NORMAL scanl1M' #-}

743+scanl1M' :: Monad m => (a -> a -> m a) -> Stream m a -> Stream m a

744+scanl1M' fstep (Stream step state) = Stream step' (state, Nothing)

637745 where

638746 {-# INLINE_LATE step' #-}

639− step' gst (DropWhileDrop st) = do

747+ step' gst (st, Nothing) = do

640748 r <- step gst st

641749 case r of

642− Yield x s -> do

643− b <- f x

644− if b

645− then return $ Skip (DropWhileDrop s)

646− else return $ Skip (DropWhileYield x s)

647− Skip s -> return $ Skip (DropWhileDrop s)

648− Stop -> return Stop

750+ Yield x s -> x `seq` return $ Yield x (s, Just x)

751+ Skip s -> return $ Skip (s, Nothing)

752+ Stop -> return Stop

649753

650− step' gst (DropWhileNext st) = do

754+ step' gst (st, Just acc) = acc `seq` do

651755 r <- step gst st

652756 case r of

653− Yield x s -> return $ Skip (DropWhileYield x s)

654− Skip s -> return $ Skip (DropWhileNext s)

655− Stop -> return Stop

757+ Yield y s -> do

758+ z <- fstep acc y

759+ z `seq` return $ Yield z (s, Just z)

760+ Skip s -> return $ Skip (s, Just acc)

761+ Stop -> return Stop

656762

657− step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)

763+{-# INLINE scanl1' #-}

764+scanl1' :: Monad m => (a -> a -> a) -> Stream m a -> Stream m a

765+scanl1' f = scanl1M' (\x y -> return (f x y))

658766

659−{-# INLINE dropWhile #-}

660−dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a

661−dropWhile f = dropWhileM (return . f)

767+-------------------------------------------------------------------------------

768+-- Filtering

769+-------------------------------------------------------------------------------

662770

771+-- Adapted from the vector package

663772{-# INLINE_NORMAL filterM #-}

664773filterM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a

665774filterM f (Stream step state) = Stream step' state

@@ -680,6 +789,7 @@ filterM f (Stream step state) = Stream step' state

680789filter :: Monad m => (a -> Bool) -> Stream m a -> Stream m a

681790filter f = filterM (return . f)

682791

792+-- Adapted from the vector package

683793{-# INLINE_NORMAL uniq #-}

684794uniq :: (Eq a, Monad m) => Stream m a -> Stream m a

685795uniq (Stream step state) = Stream step' (Nothing, state)

@@ -699,257 +809,194 @@ uniq (Stream step state) = Stream step' (Nothing, state)

699809 Skip s -> return $ Skip (Just x, s)

700810 Stop -> return Stop

701811

702−------------------------------------------------------------------------------

703−-- Transformation by Mapping

704−------------------------------------------------------------------------------

705−

706−{-# INLINE_NORMAL sequence #-}

707−sequence :: Monad m => Stream m (m a) -> Stream m a

708−sequence (Stream step state) = Stream step' state

709− where

710− {-# INLINE_LATE step' #-}

711− step' gst st = do

712− r <- step (adaptState gst) st

713− case r of

714− Yield x s -> x >>= \a -> return (Yield a s)

715− Skip s -> return $ Skip s

716− Stop -> return Stop

717−

718−------------------------------------------------------------------------------

719−-- Tapping/Distributing

720−------------------------------------------------------------------------------

721−

722−data TapState fs st a

723− = TapInit | Tapping !fs st | TapDone st

724−

725−-- XXX Multiple yield points

726−{-# INLINE tap #-}

727−tap :: Monad m => Fold m a b -> Stream m a -> Stream m a

728−tap (Fold fstep initial extract) (Stream step state) = Stream step' TapInit

729−

730− where

731−

732− step' _ TapInit = do

733− r <- initial

734− return $ Skip (Tapping r state)

735− step' gst (Tapping acc st) = do

736− r <- step gst st

737− case r of

738− -- XXX Abstract Yield?

739− Yield x s -> do

740− res <- fstep acc x

741− return

742− $ Yield x

743− $ case res of

744− FL.Partial fs -> Tapping fs s

745− FL.Done _ -> TapDone s

746− Skip s -> return $ Skip (Tapping acc s)

747− Stop -> do

748− void $ extract acc

749− return Stop

750− step' gst (TapDone st) = do

751− r <- step gst st

752− return

753− $ case r of

754− Yield x s -> Yield x (TapDone s)

755− Skip s -> Skip (TapDone s)

756− Stop -> Stop

757−

758−data TapOffState fs s a

759− = TapOffInit

760− | TapOffTapping !fs s Int

761− | TapOffDone s

762−

763−-- XXX Multiple yield points

764−{-# INLINE_NORMAL tapOffsetEvery #-}

765−tapOffsetEvery :: Monad m

766− => Int -> Int -> Fold m a b -> Stream m a -> Stream m a

767−tapOffsetEvery offset n (Fold fstep initial extract) (Stream step state) =

768− Stream step' TapOffInit

769−

770− where

771−

772− {-# INLINE_LATE step' #-}

773− step' _ TapOffInit = do

774− r <- initial

775− return $ Skip $ TapOffTapping r state (offset `mod` n)

776− step' gst (TapOffTapping acc st count) = do

777− r <- step gst st

778− case r of

779− Yield x s -> do

780− next <-

781− if count <= 0

782− then do

783− res <- fstep acc x

784− return

785− $ case res of

786− FL.Partial sres ->

787− TapOffTapping sres s (n - 1)

788− FL.Done _ -> TapOffDone s

789− else return $ TapOffTapping acc s (count - 1)

790− return $ Yield x next

791− Skip s -> return $ Skip (TapOffTapping acc s count)

792− Stop -> do

793− void $ extract acc

794− return Stop

795− step' gst (TapOffDone st) = do

796− r <- step gst st

797− return

798− $ case r of

799− Yield x s -> Yield x (TapOffDone s)

800− Skip s -> Skip (TapOffDone s)

801− Stop -> Stop

802−

803−{-# INLINE_NORMAL pollCounts #-}

804−pollCounts

805− :: MonadAsync m

806− => (a -> Bool)

807− -> (Stream m Int -> Stream m Int)

808− -> Fold m Int b

809− -> Stream m a

810− -> Stream m a

811−pollCounts predicate transf fld (Stream step state) = Stream step' Nothing

812− where

813−

814− {-# INLINE_LATE step' #-}

815− step' _ Nothing = do

816− -- As long as we are using an "Int" for counts lockfree reads from

817− -- Var should work correctly on both 32-bit and 64-bit machines.

818− -- However, an Int on a 32-bit machine may overflow quickly.

819− countVar <- liftIO $ Prim.newIORef (0 :: Int)

820− tid <- forkManaged

821− $ void $ foldOnce fld

822− $ transf $ fromPrimIORef countVar

823− return $ Skip (Just (countVar, tid, state))

824−

825− step' gst (Just (countVar, tid, st)) = do

826− r <- step gst st

827− case r of

828− Yield x s -> do

829− when (predicate x) $ liftIO $ Prim.modifyIORef' countVar (+ 1)

830− return $ Yield x (Just (countVar, tid, s))

831− Skip s -> return $ Skip (Just (countVar, tid, s))

832− Stop -> do

833− liftIO $ killThread tid

834− return Stop

835−

836−{-# INLINE_NORMAL tapRate #-}

837−tapRate ::

838− (MonadAsync m, MonadCatch m)

839− => Double

840− -> (Int -> m b)

841− -> Stream m a

842− -> Stream m a

843−tapRate samplingRate action (Stream step state) = Stream step' Nothing

844− where

845− {-# NOINLINE loop #-}

846− loop countVar prev = do

847− i <-

848− MC.catch

849− (do liftIO $ threadDelay (round $ samplingRate * 1000000)

850− i <- liftIO $ Prim.readIORef countVar

851− let !diff = i - prev

852− void $ action diff

853− return i)

854− (\(e :: AsyncException) -> do

855− i <- liftIO $ Prim.readIORef countVar

856− let !diff = i - prev

857− void $ action diff

858− throwM (MC.toException e))

859− loop countVar i

860−

861− {-# INLINE_LATE step' #-}

862− step' _ Nothing = do

863− countVar <- liftIO $ Prim.newIORef 0

864− tid <- fork $ loop countVar 0

865− ref <- liftIO $ newIORef ()

866− _ <- liftIO $ mkWeakIORef ref (killThread tid)

867− return $ Skip (Just (countVar, tid, state, ref))

812+{-# INLINE_NORMAL deleteBy #-}

813+deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a

814+deleteBy eq x (Stream step state) = Stream step' (state, False)

815+ where

816+ {-# INLINE_LATE step' #-}

817+ step' gst (st, False) = do

818+ r <- step gst st

819+ case r of

820+ Yield y s -> return $

821+ if eq x y then Skip (s, True) else Yield y (s, False)

822+ Skip s -> return $ Skip (s, False)

823+ Stop -> return Stop

868824

869− step' gst (Just (countVar, tid, st, ref)) = do

825+ step' gst (st, True) = do

870826 r <- step gst st

871827 case r of

872− Yield x s -> do

873− liftIO $ Prim.modifyIORef' countVar (+ 1)

874− return $ Yield x (Just (countVar, tid, s, ref))

875− Skip s -> return $ Skip (Just (countVar, tid, s, ref))

876− Stop -> do

877− liftIO $ killThread tid

878− return Stop

828+ Yield y s -> return $ Yield y (s, True)

829+ Skip s -> return $ Skip (s, True)

830+ Stop -> return Stop

879831

880−-------------------------------------------------------------------------------

881−-- Concurrent tap

882−-------------------------------------------------------------------------------

832+------------------------------------------------------------------------------

833+-- Trimming

834+------------------------------------------------------------------------------

883835

884−-- | Create an SVar with a fold consumer that will fold any elements sent to it

885−-- using the supplied fold function.

886−{-# INLINE newFoldSVar #-}

887−newFoldSVar :: MonadAsync m => State t m a -> Fold m a b -> m (SVar t m a)

888−newFoldSVar stt f = do

889− -- Buffer size for the SVar is derived from the current state

890− sv <- newParallelVar StopAny (adaptState stt)

891− -- Add the producer thread-id to the SVar.

892− liftIO myThreadId >>= modifyThread sv

893− void $ doFork (work sv) (svarMrun sv) (handleFoldException sv)

894− return sv

836+-- XXX using getTime in the loop can be pretty expensive especially for

837+-- computations where iterations are lightweight. We have the following

838+-- options:

839+--

840+-- 1) Run a timeout thread updating a flag asynchronously and check that

841+-- flag here, that way we can have a cheap termination check.

842+--

843+-- 2) Use COARSE clock to get time with lower resolution but more efficiently.

844+--

845+-- 3) Use rdtscp/rdtsc to get time directly from the processor, compute the

846+-- termination value of rdtsc in the beginning and then in each iteration just

847+-- get rdtsc and check if we should terminate.

848+--

849+data TakeByTime st s

850+ = TakeByTimeInit st

851+ | TakeByTimeCheck st s

852+ | TakeByTimeYield st s

895853

854+{-# INLINE_NORMAL takeByTime #-}

855+takeByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a

856+takeByTime duration (Stream step1 state1) = Stream step (TakeByTimeInit state1)

896857 where

897858

898− {-# NOINLINE work #-}

899− work sv = void $ foldOnce f $ fromProducer sv

859+ lim = toRelTime64 duration

900860

901−{-# INLINE_NORMAL tapAsync #-}

902−tapAsync :: MonadAsync m => Fold m a b -> Stream m a -> Stream m a

903−tapAsync f (Stream step1 state1) = Stream step TapInit

904− where

861+ {-# INLINE_LATE step #-}

862+ step _ (TakeByTimeInit _) | lim == 0 = return Stop

863+ step _ (TakeByTimeInit st) = do

864+ t0 <- liftIO $ getTime Monotonic

865+ return $ Skip (TakeByTimeYield st t0)

866+ step _ (TakeByTimeCheck st t0) = do

867+ t <- liftIO $ getTime Monotonic

868+ return $

869+ if diffAbsTime64 t t0 > lim

870+ then Stop

871+ else Skip (TakeByTimeYield st t0)

872+ step gst (TakeByTimeYield st t0) = do

873+ r <- step1 gst st

874+ return $ case r of

875+ Yield x s -> Yield x (TakeByTimeCheck s t0)

876+ Skip s -> Skip (TakeByTimeCheck s t0)

877+ Stop -> Stop

905878

906− drainFold svr = do

907− -- In general, a Stop event would come equipped with the result

908− -- of the fold. It is not used here but it would be useful in

909− -- applicative and distribute.

910− done <- fromConsumer svr

911− when (not done) $ do

912− liftIO $ withDiagMVar svr "teeToSVar: waiting to drain"

913− $ takeMVar (outputDoorBellFromConsumer svr)

914− drainFold svr

879+data DropByTime st s x

880+ = DropByTimeInit st

881+ | DropByTimeGen st s

882+ | DropByTimeCheck st s x

883+ | DropByTimeYield st

915884

916− stopFold svr = do

917− liftIO $ sendStop svr Nothing

918− -- drain/wait until a stop event arrives from the fold.

919− drainFold svr

885+{-# INLINE_NORMAL dropByTime #-}

886+dropByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a

887+dropByTime duration (Stream step1 state1) = Stream step (DropByTimeInit state1)

888+ where

920889

921− {-# INLINE_LATE step #-}

922− step gst TapInit = do

923− sv <- newFoldSVar gst f

924− return $ Skip (Tapping sv state1)

890+ lim = toRelTime64 duration

925891

926− step gst (Tapping sv st) = do

892+ {-# INLINE_LATE step #-}

893+ step _ (DropByTimeInit st) = do

894+ t0 <- liftIO $ getTime Monotonic

895+ return $ Skip (DropByTimeGen st t0)

896+ step gst (DropByTimeGen st t0) = do

927897 r <- step1 gst st

928− case r of

929− Yield a s -> do

930− done <- pushToFold sv a

931− if done

932− then do

933− -- XXX we do not need to wait synchronously here

934− stopFold sv

935− return $ Yield a (TapDone s)

936− else return $ Yield a (Tapping sv s)

937− Skip s -> return $ Skip (Tapping sv s)

938− Stop -> do

939− stopFold sv

940− return $ Stop

941−

942− step gst (TapDone st) = do

898+ return $ case r of

899+ Yield x s -> Skip (DropByTimeCheck s t0 x)

900+ Skip s -> Skip (DropByTimeGen s t0)

901+ Stop -> Stop

902+ step _ (DropByTimeCheck st t0 x) = do

903+ t <- liftIO $ getTime Monotonic

904+ if diffAbsTime64 t t0 <= lim

905+ then return $ Skip $ DropByTimeGen st t0

906+ else return $ Yield x $ DropByTimeYield st

907+ step gst (DropByTimeYield st) = do

943908 r <- step1 gst st

944909 return $ case r of

945− Yield a s -> Yield a (TapDone s)

946− Skip s -> Skip (TapDone s)

947− Stop -> Stop

910+ Yield x s -> Yield x (DropByTimeYield s)

911+ Skip s -> Skip (DropByTimeYield s)

912+ Stop -> Stop

913+

914+-- Adapted from the vector package

915+{-# INLINE_NORMAL drop #-}

916+drop :: Monad m => Int -> Stream m a -> Stream m a

917+drop n (Stream step state) = Stream step' (state, Just n)

918+ where

919+ {-# INLINE_LATE step' #-}

920+ step' gst (st, Just i)

921+ | i > 0 = do

922+ r <- step gst st

923+ return $

924+ case r of

925+ Yield _ s -> Skip (s, Just (i - 1))

926+ Skip s -> Skip (s, Just i)

927+ Stop -> Stop

928+ | otherwise = return $ Skip (st, Nothing)

929+

930+ step' gst (st, Nothing) = do

931+ r <- step gst st

932+ return $

933+ case r of

934+ Yield x s -> Yield x (s, Nothing)

935+ Skip s -> Skip (s, Nothing)

936+ Stop -> Stop

937+

938+-- Adapted from the vector package

939+data DropWhileState s a

940+ = DropWhileDrop s

941+ | DropWhileYield a s

942+ | DropWhileNext s

943+

944+{-# INLINE_NORMAL dropWhileM #-}

945+dropWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a

946+dropWhileM f (Stream step state) = Stream step' (DropWhileDrop state)

947+ where

948+ {-# INLINE_LATE step' #-}

949+ step' gst (DropWhileDrop st) = do

950+ r <- step gst st

951+ case r of

952+ Yield x s -> do

953+ b <- f x

954+ if b

955+ then return $ Skip (DropWhileDrop s)

956+ else return $ Skip (DropWhileYield x s)

957+ Skip s -> return $ Skip (DropWhileDrop s)

958+ Stop -> return Stop

959+

960+ step' gst (DropWhileNext st) = do

961+ r <- step gst st

962+ case r of

963+ Yield x s -> return $ Skip (DropWhileYield x s)

964+ Skip s -> return $ Skip (DropWhileNext s)

965+ Stop -> return Stop

966+

967+ step' _ (DropWhileYield x st) = return $ Yield x (DropWhileNext st)

968+

969+{-# INLINE dropWhile #-}

970+dropWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a

971+dropWhile f = dropWhileM (return . f)

948972

949973------------------------------------------------------------------------------

950−-- Inserting

974+-- Inserting Elements

951975------------------------------------------------------------------------------

952976

977+{-# INLINE_NORMAL insertBy #-}

978+insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a

979+insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)

980+ where

981+ {-# INLINE_LATE step' #-}

982+ step' gst (st, False, _) = do

983+ r <- step gst st

984+ case r of

985+ Yield x s -> case cmp a x of

986+ GT -> return $ Yield x (s, False, Nothing)

987+ _ -> return $ Yield a (s, True, Just x)

988+ Skip s -> return $ Skip (s, False, Nothing)

989+ Stop -> return $ Yield a (st, True, Nothing)

990+

991+ step' _ (_, True, Nothing) = return Stop

992+

993+ step' gst (st, True, Just prev) = do

994+ r <- step gst st

995+ case r of

996+ Yield x s -> return $ Yield prev (s, True, Just x)

997+ Skip s -> return $ Skip (s, True, Just prev)

998+ Stop -> return $ Yield prev (st, True, Nothing)

999+

9531000data LoopState x s = FirstYield s

9541001 | InterspersingYield s

9551002 | YieldAndCarry x s

@@ -978,6 +1025,10 @@ intersperseM m (Stream step state) = Stream step' (FirstYield state)

9781025

9791026 step' _ (YieldAndCarry x st) = return $ Yield x (InterspersingYield st)

9801027

1028+{-# INLINE intersperse #-}

1029+intersperse :: Monad m => a -> Stream m a -> Stream m a

1030+intersperse a = intersperseM (return a)

1031+

9811032{-# INLINE_NORMAL intersperseM_ #-}

9821033intersperseM_ :: Monad m => m b -> Stream m a -> Stream m a

9831034intersperseM_ m (Stream step1 state1) = Stream step (Left (pure (), state1))

@@ -1054,66 +1105,154 @@ intersperseSuffixBySpan n action (Stream step state) =

10541105 step' _ (SuffixSpanSuffix st) = do

10551106 action >>= \r -> return $ Skip (SuffixSpanYield r (SuffixSpanElem st n))

10561107

1057− step' _ (SuffixSpanLast) = do

1058− action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)

1108+ step' _ (SuffixSpanLast) = do

1109+ action >>= \r -> return $ Skip (SuffixSpanYield r SuffixSpanStop)

1110+

1111+ step' _ (SuffixSpanYield x next) = return $ Yield x next

1112+

1113+ step' _ (SuffixSpanStop) = return Stop

1114+

1115+------------------------------------------------------------------------------

1116+-- Reordering

1117+------------------------------------------------------------------------------

1118+

1119+-- We can implement reverse as:

1120+--

1121+-- > reverse = foldlS (flip cons) nil

1122+--

1123+-- However, this implementation is unusable because of the horrible performance

1124+-- of cons. So we just convert it to a list first and then stream from the

1125+-- list.

1126+--

1127+-- XXX Maybe we can use an Array instead of a list here?

1128+{-# INLINE_NORMAL reverse #-}

1129+reverse :: Monad m => Stream m a -> Stream m a

1130+reverse m = Stream step Nothing

1131+ where

1132+ {-# INLINE_LATE step #-}

1133+ step _ Nothing = do

1134+ xs <- foldl' (flip (:)) [] m

1135+ return $ Skip (Just xs)

1136+ step _ (Just (x:xs)) = return $ Yield x (Just xs)

1137+ step _ (Just []) = return Stop

1138+

1139+-- Much faster reverse for Storables

1140+{-# INLINE_NORMAL reverse' #-}

1141+reverse' :: forall m a. (MonadIO m, Storable a) => Stream m a -> Stream m a

1142+{-

1143+-- This commented implementation copies the whole stream into one single array

1144+-- and then streams from that array, this is 3-4x faster than the chunked code

1145+-- that follows. Though this could be problematic due to unbounded large

1146+-- allocations. We need to figure out why the chunked code is slower and if we

1147+-- can optimize the chunked code to work as fast as this one. It may be a

1148+-- fusion issue?

1149+import Foreign.ForeignPtr (touchForeignPtr)

1150+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)

1151+import Foreign.Ptr (Ptr, plusPtr)

1152+reverse' m = Stream step Nothing

1153+ where

1154+ {-# INLINE_LATE step #-}

1155+ step _ Nothing = do

1156+ arr <- A.fromStreamD m

1157+ let p = aEnd arr `plusPtr` negate (sizeOf (undefined :: a))

1158+ return $ Skip $ Just (aStart arr, p)

10591159

1060− step' _ (SuffixSpanYield x next) = return $ Yield x next

1160+ step _ (Just (start, p)) | p < unsafeForeignPtrToPtr start = return Stop

10611161

1062− step' _ (SuffixSpanStop) = return Stop

1162+ step _ (Just (start, p)) = do

1163+ let !x = A.unsafeInlineIO $ do

1164+ r <- peek p

1165+ touchForeignPtr start

1166+ return r

1167+ next = p `plusPtr` negate (sizeOf (undefined :: a))

1168+ return $ Yield x (Just (start, next))

1169+-}

1170+reverse' m =

1171+ A.flattenArraysRev

1172+ $ fromStreamK

1173+ $ K.reverse

1174+ $ toStreamK

1175+ $ A.fromStreamDArraysOf A.defaultChunkSize m

10631176

1064−{-# INLINE intersperse #-}

1065−intersperse :: Monad m => a -> Stream m a -> Stream m a

1066−intersperse a = intersperseM (return a)

1177+------------------------------------------------------------------------------

1178+-- Position Indexing

1179+------------------------------------------------------------------------------

10671180

1068−{-# INLINE_NORMAL insertBy #-}

1069−insertBy :: Monad m => (a -> a -> Ordering) -> a -> Stream m a -> Stream m a

1070−insertBy cmp a (Stream step state) = Stream step' (state, False, Nothing)

1181+-- Adapted from the vector package

1182+{-# INLINE_NORMAL indexed #-}

1183+indexed :: Monad m => Stream m a -> Stream m (Int, a)

1184+indexed (Stream step state) = Stream step' (state, 0)

10711185 where

10721186 {-# INLINE_LATE step' #-}

1073− step' gst (st, False, _) = do

1074− r <- step gst st

1075− case r of

1076− Yield x s -> case cmp a x of

1077− GT -> return $ Yield x (s, False, Nothing)

1078− _ -> return $ Yield a (s, True, Just x)

1079− Skip s -> return $ Skip (s, False, Nothing)

1080− Stop -> return $ Yield a (st, True, Nothing)

1081−

1082− step' _ (_, True, Nothing) = return Stop

1187+ step' gst (st, i) = i `seq` do

1188+ r <- step (adaptState gst) st

1189+ case r of

1190+ Yield x s -> return $ Yield (i, x) (s, i+1)

1191+ Skip s -> return $ Skip (s, i)

1192+ Stop -> return Stop

10831193

1084− step' gst (st, True, Just prev) = do

1085− r <- step gst st

1086− case r of

1087− Yield x s -> return $ Yield prev (s, True, Just x)

1088− Skip s -> return $ Skip (s, True, Just prev)

1089− Stop -> return $ Yield prev (st, True, Nothing)

1194+-- Adapted from the vector package

1195+{-# INLINE_NORMAL indexedR #-}

1196+indexedR :: Monad m => Int -> Stream m a -> Stream m (Int, a)

1197+indexedR m (Stream step state) = Stream step' (state, m)

1198+ where

1199+ {-# INLINE_LATE step' #-}

1200+ step' gst (st, i) = i `seq` do

1201+ r <- step (adaptState gst) st

1202+ case r of

1203+ Yield x s -> let i' = i - 1

1204+ in return $ Yield (i, x) (s, i')

1205+ Skip s -> return $ Skip (s, i)

1206+ Stop -> return Stop

10901207

10911208------------------------------------------------------------------------------

1092−-- Deleting

1209+-- Searching

10931210------------------------------------------------------------------------------

10941211

1095−{-# INLINE_NORMAL deleteBy #-}

1096−deleteBy :: Monad m => (a -> a -> Bool) -> a -> Stream m a -> Stream m a

1097−deleteBy eq x (Stream step state) = Stream step' (state, False)

1212+{-# INLINE_NORMAL findIndices #-}

1213+findIndices :: Monad m => (a -> Bool) -> Stream m a -> Stream m Int

1214+findIndices p (Stream step state) = Stream step' (state, 0)

10981215 where

10991216 {-# INLINE_LATE step' #-}

1100− step' gst (st, False) = do

1101− r <- step gst st

1102− case r of

1103− Yield y s -> return $

1104− if eq x y then Skip (s, True) else Yield y (s, False)

1105− Skip s -> return $ Skip (s, False)

1106− Stop -> return Stop

1217+ step' gst (st, i) = i `seq` do

1218+ r <- step (adaptState gst) st

1219+ return $ case r of

1220+ Yield x s -> if p x then Yield i (s, i+1) else Skip (s, i+1)

1221+ Skip s -> Skip (s, i)

1222+ Stop -> Stop

11071223

1108− step' gst (st, True) = do

1109− r <- step gst st

1224+------------------------------------------------------------------------------

1225+-- Rolling map

1226+------------------------------------------------------------------------------

1227+

1228+data RollingMapState s a = RollingMapInit s | RollingMapGo s a

1229+

1230+{-# INLINE rollingMapM #-}

1231+rollingMapM :: Monad m => (a -> a -> m b) -> Stream m a -> Stream m b

1232+rollingMapM f (Stream step1 state1) = Stream step (RollingMapInit state1)

1233+ where

1234+ step gst (RollingMapInit st) = do

1235+ r <- step1 (adaptState gst) st

1236+ return $ case r of

1237+ Yield x s -> Skip $ RollingMapGo s x

1238+ Skip s -> Skip $ RollingMapInit s

1239+ Stop -> Stop

1240+

1241+ step gst (RollingMapGo s1 x1) = do

1242+ r <- step1 (adaptState gst) s1

11101243 case r of

1111− Yield y s -> return $ Yield y (s, True)

1112− Skip s -> return $ Skip (s, True)

1113− Stop -> return Stop

1244+ Yield x s -> do

1245+ !res <- f x x1

1246+ return $ Yield res $ RollingMapGo s x

1247+ Skip s -> return $ Skip $ RollingMapGo s x1

1248+ Stop -> return $ Stop

1249+

1250+{-# INLINE rollingMap #-}

1251+rollingMap :: Monad m => (a -> a -> b) -> Stream m a -> Stream m b

1252+rollingMap f = rollingMapM (\x y -> return $ f x y)

11141253

11151254------------------------------------------------------------------------------

1116−-- Transformation by Map and Filter

1255+-- Maybe Streams

11171256------------------------------------------------------------------------------

11181257

11191258-- XXX Will this always fuse properly?

@@ -1125,227 +1264,6 @@ mapMaybe f = fmap fromJust . filter isJust . map f

11251264mapMaybeM :: Monad m => (a -> m (Maybe b)) -> Stream m a -> Stream m b

11261265mapMaybeM f = fmap fromJust . filter isJust . mapM f

11271266

1128−------------------------------------------------------------------------------

1129−-- Repeated parsing

1130−------------------------------------------------------------------------------

1131−

1132−{-# ANN type ParseChunksState Fuse #-}

1133−data ParseChunksState x inpBuf st pst =

1134− ParseChunksInit inpBuf st

1135− | ParseChunksInitLeftOver inpBuf

1136− | ParseChunksStream st inpBuf !pst

1137− | ParseChunksBuf inpBuf st inpBuf !pst

1138− | ParseChunksYield x (ParseChunksState x inpBuf st pst)

1139−

1140−{-# INLINE_NORMAL parseMany #-}

1141−parseMany

1142− :: MonadThrow m

1143− => PRD.Parser m a b

1144− -> Stream m a

1145− -> Stream m b

1146−parseMany (PRD.Parser pstep initial extract) (Stream step state) =

1147− Stream stepOuter (ParseChunksInit [] state)

1148−

1149− where

1150−

1151− {-# INLINE_LATE stepOuter #-}

1152− -- Buffer is empty, get the first element from the stream, initialize the

1153− -- fold and then go to stream processing loop.

1154− stepOuter gst (ParseChunksInit [] st) = do

1155− r <- step (adaptState gst) st

1156− case r of

1157− Yield x s -> initial >>= return . Skip . ParseChunksBuf [x] s []

1158− Skip s -> return $ Skip $ ParseChunksInit [] s

1159− Stop -> return Stop

1160−

1161− -- Buffer is not empty, go to buffered processing loop

1162− stepOuter _ (ParseChunksInit src st) = do

1163− initial >>= return . Skip . ParseChunksBuf src st []

1164−

1165− -- XXX we just discard any leftover input at the end

1166− stepOuter _ (ParseChunksInitLeftOver _) = return Stop

1167−

1168− -- Buffer is empty, process elements from the stream

1169− stepOuter gst (ParseChunksStream st buf pst) = do

1170− r <- step (adaptState gst) st

1171− case r of

1172− Yield x s -> do

1173− pRes <- pstep pst x

1174− case pRes of

1175− PR.Partial 0 pst1 ->

1176− return $ Skip $ ParseChunksStream s [] pst1

1177− PR.Partial n pst1 -> do

1178− assert (n <= length (x:buf)) (return ())

1179− let src0 = Prelude.take n (x:buf)

1180− src = Prelude.reverse src0

1181− return $ Skip $ ParseChunksBuf src s [] pst1

1182− PR.Continue 0 pst1 ->

1183− return $ Skip $ ParseChunksStream s (x:buf) pst1

1184− PR.Continue n pst1 -> do

1185− assert (n <= length (x:buf)) (return ())

1186− let (src0, buf1) = splitAt n (x:buf)

1187− src = Prelude.reverse src0

1188− return $ Skip $ ParseChunksBuf src s buf1 pst1

1189− PR.Done 0 b -> do

1190− return $ Skip $

1191− ParseChunksYield b (ParseChunksInit [] s)

1192− PR.Done n b -> do

1193− assert (n <= length (x:buf)) (return ())

1194− let src = Prelude.reverse (Prelude.take n (x:buf))

1195− return $ Skip $

1196− ParseChunksYield b (ParseChunksInit src s)

1197− PR.Error err -> throwM $ ParseError err

1198− Skip s -> return $ Skip $ ParseChunksStream s buf pst

1199− Stop -> do

1200− b <- extract pst

1201− let src = Prelude.reverse buf

1202− return $ Skip $

1203− ParseChunksYield b (ParseChunksInitLeftOver src)

1204−

1205− -- go back to stream processing mode

1206− stepOuter _ (ParseChunksBuf [] s buf pst) =

1207− return $ Skip $ ParseChunksStream s buf pst

1208−

1209− -- buffered processing loop

1210− stepOuter _ (ParseChunksBuf (x:xs) s buf pst) = do

1211− pRes <- pstep pst x

1212− case pRes of

1213− PR.Partial 0 pst1 ->

1214− return $ Skip $ ParseChunksBuf xs s [] pst1

1215− PR.Partial n pst1 -> do

1216− assert (n <= length (x:buf)) (return ())

1217− let src0 = Prelude.take n (x:buf)

1218− src = Prelude.reverse src0 ++ xs

1219− return $ Skip $ ParseChunksBuf src s [] pst1

1220− PR.Continue 0 pst1 ->

1221− return $ Skip $ ParseChunksBuf xs s (x:buf) pst1

1222− PR.Continue n pst1 -> do

1223− assert (n <= length (x:buf)) (return ())

1224− let (src0, buf1) = splitAt n (x:buf)

1225− src = Prelude.reverse src0 ++ xs

1226− return $ Skip $ ParseChunksBuf src s buf1 pst1

1227− PR.Done 0 b ->

1228− return $ Skip $ ParseChunksYield b (ParseChunksInit xs s)

1229− PR.Done n b -> do

1230− assert (n <= length (x:buf)) (return ())

1231− let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1232− return $ Skip $ ParseChunksYield b (ParseChunksInit src s)

1233− PR.Error err -> throwM $ ParseError err

1234−

1235− stepOuter _ (ParseChunksYield a next) = return $ Yield a next

1236−

1237−{-# ANN type ConcatParseState Fuse #-}

1238−data ConcatParseState x inpBuf st p =

1239− ConcatParseInit inpBuf st p

1240− | ConcatParseInitLeftOver inpBuf

1241− | ConcatParseStream st inpBuf p

1242− | ConcatParseBuf inpBuf st inpBuf p

1243− | ConcatParseYield x (ConcatParseState x inpBuf st p)

1244−

1245−{-# INLINE_NORMAL parseIterate #-}

1246−parseIterate

1247− :: MonadThrow m

1248− => (b -> PRD.Parser m a b)

1249− -> b

1250− -> Stream m a

1251− -> Stream m b

1252−parseIterate func seed (Stream step state) =

1253− Stream stepOuter (ConcatParseInit [] state (func seed))

1254−

1255− where

1256−

1257− {-# INLINE_LATE stepOuter #-}

1258− -- Buffer is empty, go to stream processing loop

1259− stepOuter _ (ConcatParseInit [] st (PRD.Parser pstep initial extract)) = do

1260− initial >>= \r -> return $ Skip $ ConcatParseStream st []

1261− (PRD.Parser pstep (return r) extract)

1262−

1263− -- Buffer is not empty, go to buffered processing loop

1264− stepOuter _ (ConcatParseInit src st

1265− (PRD.Parser pstep initial extract)) = do

1266− initial >>= \r -> return $ Skip $ ConcatParseBuf src st []

1267− (PRD.Parser pstep (return r) extract)

1268−

1269− -- XXX we just discard any leftover input at the end

1270− stepOuter _ (ConcatParseInitLeftOver _) = return Stop

1271−

1272− -- Buffer is empty process elements from the stream

1273− stepOuter gst (ConcatParseStream st buf

1274− p@(PRD.Parser pstep initial extract)) = do

1275− r <- step (adaptState gst) st

1276− case r of

1277− Yield x s -> do

1278− pst <- initial

1279− pRes <- pstep pst x

1280− case pRes of

1281− PR.Partial 0 pst1 ->

1282− return $ Skip $ ConcatParseStream s []

1283− (PRD.Parser pstep (return pst1) extract)

1284− PR.Partial n pst1 -> do

1285− assert (n <= length (x:buf)) (return ())

1286− let src0 = Prelude.take n (x:buf)

1287− src = Prelude.reverse src0

1288− return $ Skip $ ConcatParseBuf src s []

1289− (PRD.Parser pstep (return pst1) extract)

1290− -- PR.Continue 0 pst1 ->

1291− -- return $ Skip $ ConcatParseStream s (x:buf) pst1

1292− PR.Continue n pst1 -> do

1293− assert (n <= length (x:buf)) (return ())

1294− let (src0, buf1) = splitAt n (x:buf)

1295− src = Prelude.reverse src0

1296− return $ Skip $ ConcatParseBuf src s buf1

1297− (PRD.Parser pstep (return pst1) extract)

1298− -- XXX Specialize for Stop 0 common case?

1299− PR.Done n b -> do

1300− assert (n <= length (x:buf)) (return ())

1301− let src = Prelude.reverse (Prelude.take n (x:buf))

1302− return $ Skip $

1303− ConcatParseYield b (ConcatParseInit src s (func b))

1304− PR.Error err -> throwM $ ParseError err

1305− Skip s -> return $ Skip $ ConcatParseStream s buf p

1306− Stop -> do

1307− pst <- initial

1308− b <- extract pst

1309− let src = Prelude.reverse buf

1310− return $ Skip $

1311− ConcatParseYield b (ConcatParseInitLeftOver src)

1312−

1313− -- go back to stream processing mode

1314− stepOuter _ (ConcatParseBuf [] s buf p) =

1315− return $ Skip $ ConcatParseStream s buf p

1316−

1317− -- buffered processing loop

1318− stepOuter _ (ConcatParseBuf (x:xs) s buf

1319− (PRD.Parser pstep initial extract)) = do

1320− pst <- initial

1321− pRes <- pstep pst x

1322− case pRes of

1323− PR.Partial 0 pst1 ->

1324− return $ Skip $ ConcatParseBuf xs s []

1325− (PRD.Parser pstep (return pst1) extract)

1326− PR.Partial n pst1 -> do

1327− assert (n <= length (x:buf)) (return ())

1328− let src0 = Prelude.take n (x:buf)

1329− src = Prelude.reverse src0 ++ xs

1330− return $ Skip $ ConcatParseBuf src s []

1331− (PRD.Parser pstep (return pst1) extract)

1332− -- PR.Continue 0 pst1 -> return $ Skip $ ConcatParseBuf xs s (x:buf) pst1

1333− PR.Continue n pst1 -> do

1334− assert (n <= length (x:buf)) (return ())

1335− let (src0, buf1) = splitAt n (x:buf)

1336− src = Prelude.reverse src0 ++ xs

1337− return $ Skip $ ConcatParseBuf src s buf1

1338− (PRD.Parser pstep (return pst1) extract)

1339− -- XXX Specialize for Stop 0 common case?

1340− PR.Done n b -> do

1341− assert (n <= length (x:buf)) (return ())

1342− let src = Prelude.reverse (Prelude.take n (x:buf)) ++ xs

1343− return $ Skip $ ConcatParseYield b

1344− (ConcatParseInit src s (func b))

1345− PR.Error err -> throwM $ ParseError err

1346−

1347− stepOuter _ (ConcatParseYield a next) = return $ Yield a next

1348−

13491267-------------------------------------------------------------------------------

13501268-- Concurrent application and fold

13511269-------------------------------------------------------------------------------

@@ -1384,157 +1302,3 @@ mkParallelD m = Stream step Nothing

13841302{-# INLINE_NORMAL mkParallel #-}

13851303mkParallel :: (K.IsStream t, MonadAsync m) => t m a -> t m a

13861304mkParallel = fromStreamD . mkParallelD . toStreamD

1387−

1388−------------------------------------------------------------------------------

1389−-- Time related

1390−------------------------------------------------------------------------------

1391−

1392−-- XXX using getTime in the loop can be pretty expensive especially for

1393−-- computations where iterations are lightweight. We have the following

1394−-- options:

1395−--

1396−-- 1) Run a timeout thread updating a flag asynchronously and check that

1397−-- flag here, that way we can have a cheap termination check.

1398−--

1399−-- 2) Use COARSE clock to get time with lower resolution but more efficiently.

1400−--

1401−-- 3) Use rdtscp/rdtsc to get time directly from the processor, compute the

1402−-- termination value of rdtsc in the beginning and then in each iteration just

1403−-- get rdtsc and check if we should terminate.

1404−--

1405−data TakeByTime st s

1406− = TakeByTimeInit st

1407− | TakeByTimeCheck st s

1408− | TakeByTimeYield st s

1409−

1410−{-# INLINE_NORMAL takeByTime #-}

1411−takeByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a

1412−takeByTime duration (Stream step1 state1) = Stream step (TakeByTimeInit state1)

1413− where

1414−

1415− lim = toRelTime64 duration

1416−

1417− {-# INLINE_LATE step #-}

1418− step _ (TakeByTimeInit _) | lim == 0 = return Stop

1419− step _ (TakeByTimeInit st) = do

1420− t0 <- liftIO $ getTime Monotonic

1421− return $ Skip (TakeByTimeYield st t0)

1422− step _ (TakeByTimeCheck st t0) = do

1423− t <- liftIO $ getTime Monotonic

1424− return $

1425− if diffAbsTime64 t t0 > lim

1426− then Stop

1427− else Skip (TakeByTimeYield st t0)

1428− step gst (TakeByTimeYield st t0) = do

1429− r <- step1 gst st

1430− return $ case r of

1431− Yield x s -> Yield x (TakeByTimeCheck s t0)

1432− Skip s -> Skip (TakeByTimeCheck s t0)

1433− Stop -> Stop

1434−

1435−data DropByTime st s x

1436− = DropByTimeInit st

1437− | DropByTimeGen st s

1438− | DropByTimeCheck st s x

1439− | DropByTimeYield st

1440−

1441−{-# INLINE_NORMAL dropByTime #-}

1442−dropByTime :: (MonadIO m, TimeUnit64 t) => t -> Stream m a -> Stream m a

1443−dropByTime duration (Stream step1 state1) = Stream step (DropByTimeInit state1)

1444− where

1445−

1446− lim = toRelTime64 duration

1447−

1448− {-# INLINE_LATE step #-}

1449− step _ (DropByTimeInit st) = do

1450− t0 <- liftIO $ getTime Monotonic

1451− return $ Skip (DropByTimeGen st t0)

1452− step gst (DropByTimeGen st t0) = do

1453− r <- step1 gst st

1454− return $ case r of

1455− Yield x s -> Skip (DropByTimeCheck s t0 x)

1456− Skip s -> Skip (DropByTimeGen s t0)

1457− Stop -> Stop

1458− step _ (DropByTimeCheck st t0 x) = do

1459− t <- liftIO $ getTime Monotonic

1460− if diffAbsTime64 t t0 <= lim

1461− then return $ Skip $ DropByTimeGen st t0

1462− else return $ Yield x $ DropByTimeYield st

1463− step gst (DropByTimeYield st) = do

1464− r <- step1 gst st

1465− return $ case r of

1466− Yield x s -> Yield x (DropByTimeYield s)

1467− Skip s -> Skip (DropByTimeYield s)

1468− Stop -> Stop

1469−

1470−-------------------------------------------------------------------------------

1471−-- Hoisting the inner monad

1472−-------------------------------------------------------------------------------

1473−

1474−{-# INLINE_NORMAL hoist #-}

1475−hoist :: Monad n => (forall x. m x -> n x) -> Stream m a -> Stream n a

1476−hoist f (Stream step state) = (Stream step' state)

1477− where

1478− {-# INLINE_LATE step' #-}

1479− step' gst st = do

1480− r <- f $ step (adaptState gst) st

1481− return $ case r of

1482− Yield x s -> Yield x s

1483− Skip s -> Skip s

1484− Stop -> Stop

1485−

1486−{-# INLINE generally #-}

1487−generally :: Monad m => Stream Identity a -> Stream m a

1488−generally = hoist (return . runIdentity)

1489−

1490−{-# INLINE_NORMAL liftInner #-}

1491−liftInner :: (Monad m, MonadTrans t, Monad (t m))

1492− => Stream m a -> Stream (t m) a

1493−liftInner (Stream step state) = Stream step' state

1494− where

1495− {-# INLINE_LATE step' #-}

1496− step' gst st = do

1497− r <- lift $ step (adaptState gst) st

1498− return $ case r of

1499− Yield x s -> Yield x s

1500− Skip s -> Skip s

1501− Stop -> Stop

1502−

1503−{-# INLINE_NORMAL runReaderT #-}

1504−runReaderT :: Monad m => m s -> Stream (ReaderT s m) a -> Stream m a

1505−runReaderT env (Stream step state) = Stream step' (state, env)

1506− where

1507− {-# INLINE_LATE step' #-}

1508− step' gst (st, action) = do

1509− sv <- action

1510− r <- Reader.runReaderT (step (adaptState gst) st) sv

1511− return $ case r of

1512− Yield x s -> Yield x (s, return sv)

1513− Skip s -> Skip (s, return sv)

1514− Stop -> Stop

1515−

1516−{-# INLINE_NORMAL evalStateT #-}

1517−evalStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m a

1518−evalStateT initial (Stream step state) = Stream step' (state, initial)

1519− where

1520− {-# INLINE_LATE step' #-}

1521− step' gst (st, action) = do

1522− sv <- action

1523− (r, sv') <- State.runStateT (step (adaptState gst) st) sv

1524− return $ case r of

1525− Yield x s -> Yield x (s, return sv')

1526− Skip s -> Skip (s, return sv')

1527− Stop -> Stop

1528−

1529−{-# INLINE_NORMAL runStateT #-}

1530−runStateT :: Monad m => m s -> Stream (StateT s m) a -> Stream m (s, a)

1531−runStateT initial (Stream step state) = Stream step' (state, initial)

1532− where

1533− {-# INLINE_LATE step' #-}

1534− step' gst (st, action) = do

1535− sv <- action

1536− (r, sv') <- State.runStateT (step (adaptState gst) st) sv

1537− return $ case r of

1538− Yield x s -> Yield (sv', x) (s, return sv')

1539− Skip s -> Skip (s, return sv')

1540− Stop -> Stop

src/Streamly/Internal/Data/Stream/StreamD/Type.hs+558−510

@@ -4,12 +4,15 @@

44-- Module : Streamly.Internal.Data.Stream.StreamD.Type

66-- (c) Roman Leshchinskiy 2008-2010

7−--

8−-- License : BSD3

7+-- License : BSD-3-Clause

98-- Maintainer : streamly@composewell.com

109-- Stability : experimental

1110-- Portability : GHC

1211

12+-- The stream type is inspired by the vector package. A few functions in this

13+-- module have been originally adapted from the vector package (c) Roman

14+-- Leshchinskiy. See the notes in specific functions.

15+

1316module Streamly.Internal.Data.Stream.StreamD.Type

1417 (

1518 -- * The stream type

@@ -18,44 +21,61 @@ module Streamly.Internal.Data.Stream.StreamD.Type

1821 -- use the pattern synonym "Stream".

1922 , Stream (Stream, UnStream)

2023

21− , fromStreamK

22− , toStreamK

23− , fromStreamD

24− , toStreamD

25− , fromProducer

26− , fromPrimIORef

27− , fromSVar

28− , foldOnce

29− , toSVarParallel

30− , uncons

24+ -- * Primitives

3125 , nilM

3226 , consM

27+ , uncons

28+

29+ -- * From Values

3330 , yield

3431 , yieldM

35− , map

36− , mapM

37− , concatMap

38− , concatMapM

3932

33+ -- * From Containers

34+ , fromList

35+ , fromProducer

36+ , fromPrimIORef

37+ , fromSVar

38+

39+ -- * Conversions From/To

40+ , fromStreamK

41+ , toStreamK

42+ , toStreamD

43+ , fromStreamD

44+

45+ -- * Running a 'Fold'

46+ , foldOnce

47+

48+ -- * Right Folds

4049 , foldrT

4150 , foldrM

4251 , foldrMx

4352 , foldr

4453 , foldrS

4554

55+ -- * Left Folds

4656 , foldl'

4757 , foldlM'

4858 , foldlx'

4959 , foldlMx'

5060

61+ -- * To Containers

5162 , toList

52− , fromList

63+ , toSVarParallel

5364

65+ -- * Multi-stream folds

5466 , eqBy

5567 , cmpBy

68+

69+ -- * Transformations

70+ , map

71+ , mapM

5672 , take

57− , takeWhileM

5873 , takeWhile

74+ , takeWhileM

75+

76+ -- * Nesting

77+ , concatMap

78+ , concatMapM

5979 , GroupState (..) -- for inspection testing

6080 , foldMany

6181 , foldMany1

@@ -63,7 +83,6 @@ module Streamly.Internal.Data.Stream.StreamD.Type

6383 )

6484where

6585

66−

6786import Control.Applicative (liftA2)

6887import Control.Exception (fromException)

6988import Control.Monad (when)

@@ -123,69 +142,10 @@ pattern Stream step state <- (unShare -> UnStream step state)

123142{-# COMPLETE Stream #-}

124143#endif

125144

126−{-# INLINE_LATE fromStreamK #-}

127−fromStreamK :: Monad m => K.Stream m a -> Stream m a

128−fromStreamK = Stream step

129− where

130− step gst m1 =

131− let stop = return Stop

132− single a = return $ Yield a K.nil

133− yieldk a r = return $ Yield a r

134− in K.foldStreamShared gst yieldk single stop m1

135−

136−-- Convert a direct stream to and from CPS encoded stream

137−{-# INLINE_LATE toStreamK #-}

138−toStreamK :: Monad m => Stream m a -> K.Stream m a

139−toStreamK (Stream step state) = go state

140− where

141− go st = K.mkStream $ \gst yld _ stp ->

142− let go' ss = do

143− r <- step gst ss

144− case r of

145− Yield x s -> yld x (go s)

146− Skip s -> go' s

147− Stop -> stp

148− in go' st

149−

150−#ifndef DISABLE_FUSION

151−{-# RULES "fromStreamK/toStreamK fusion"

152− forall s. toStreamK (fromStreamK s) = s #-}

153−{-# RULES "toStreamK/fromStreamK fusion"

154− forall s. fromStreamK (toStreamK s) = s #-}

155−#endif

156−

157145------------------------------------------------------------------------------

158−-- Converting folds

146+-- Primitives

159147------------------------------------------------------------------------------

160148

161−{-# INLINE fromStreamD #-}

162−fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a

163−fromStreamD = K.fromStream . toStreamK

164−

165−{-# INLINE toStreamD #-}

166−toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a

167−toStreamD = fromStreamK . K.toStream

168−

169−-------------------------------------------------------------------------------

170−-- Deconstruction

171−-------------------------------------------------------------------------------

172−

173−-- Does not fuse, has the same performance as the StreamK version.

174−{-# INLINE_NORMAL uncons #-}

175−uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))

176−uncons (UnStream step state) = go state

177− where

178− go st = do

179− r <- step defState st

180− case r of

181− Yield x s -> return $ Just (x, Stream step s)

182− Skip s -> go s

183− Stop -> return Nothing

184−

185−-------------------------------------------------------------------------------

186−-- Construction

187−-------------------------------------------------------------------------------

188−

189149-- | An empty 'Stream' with a side effect.

190150{-# INLINE_NORMAL nilM #-}

191151nilM :: Monad m => m b -> Stream m a

@@ -205,86 +165,22 @@ consM m (Stream step state) = Stream step1 Nothing

205165 Skip s -> Skip (Just s)

206166 Stop -> Stop

207167

208−------------------------------------------------------------------------------

209−-- Instances

210−------------------------------------------------------------------------------

211−

212−-- | Map a monadic function over a 'Stream'

213−{-# INLINE_NORMAL mapM #-}

214−mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b

215−mapM f (Stream step state) = Stream step' state

168+-- | Does not fuse, has the same performance as the StreamK version.

169+{-# INLINE_NORMAL uncons #-}

170+uncons :: Monad m => Stream m a -> m (Maybe (a, Stream m a))

171+uncons (UnStream step state) = go state

216172 where

217− {-# INLINE_LATE step' #-}

218− step' gst st = do

219− r <- step (adaptState gst) st

173+ go st = do

174+ r <- step defState st

220175 case r of

221− Yield x s -> f x >>= \a -> return $ Yield a s

222− Skip s -> return $ Skip s

223− Stop -> return Stop

224−

225−{-# INLINE map #-}

226−map :: Monad m => (a -> b) -> Stream m a -> Stream m b

227−map f = mapM (return . f)

228−

229−instance Functor m => Functor (Stream m) where

230− {-# INLINE fmap #-}

231− fmap f (Stream step state) = Stream step' state

232− where

233− {-# INLINE_LATE step' #-}

234− step' gst st = fmap (fmap f) (step (adaptState gst) st)

235−

236− {-# INLINE (<$) #-}

237− (<$) = fmap . const

176+ Yield x s -> return $ Just (x, Stream step s)

177+ Skip s -> go s

178+ Stop -> return Nothing

238179

239180------------------------------------------------------------------------------

240−-- concatMap

181+-- From Values

241182------------------------------------------------------------------------------

242183

243−{-# INLINE_NORMAL concatMapM #-}

244−concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b

245−concatMapM f (Stream step state) = Stream step' (Left state)

246− where

247− {-# INLINE_LATE step' #-}

248− step' gst (Left st) = do

249− r <- step (adaptState gst) st

250− case r of

251− Yield a s -> do

252− b_stream <- f a

253− return $ Skip (Right (b_stream, s))

254− Skip s -> return $ Skip (Left s)

255− Stop -> return Stop

256−

257− -- XXX flattenArrays is 5x faster than "concatMap fromArray". if somehow we

258− -- can get inner_step to inline and fuse here we can perhaps get the same

259− -- performance using "concatMap fromArray".

260− --

261− -- XXX using the pattern synonym "Stream" causes a major performance issue

262− -- here even if the synonym does not include an adaptState call. Need to

263− -- find out why. Is that something to be fixed in GHC?

264− step' gst (Right (UnStream inner_step inner_st, st)) = do

265− r <- inner_step (adaptState gst) inner_st

266− case r of

267− Yield b inner_s ->

268− return $ Yield b (Right (Stream inner_step inner_s, st))

269− Skip inner_s ->

270− return $ Skip (Right (Stream inner_step inner_s, st))

271− Stop -> return $ Skip (Left st)

272−

273−{-# INLINE concatMap #-}

274−concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b

275−concatMap f = concatMapM (return . f)

276−

277−-- XXX The idea behind this rule is to rewrite any calls to "concatMap

278−-- fromArray" automatically to flattenArrays which is much faster. However, we

279−-- need an INLINE_EARLY on concatMap for this rule to fire. But if we use

280−-- INLINE_EARLY on concatMap or fromArray then direct uses of

281−-- "concatMap fromArray" (without the RULE) become much slower, this means

282−-- "concatMap f" in general would become slower. Need to find a solution to

283−-- this.

284−--

285−-- {-# RULES "concatMap Array.toStreamD"

286−-- concatMap Array.toStreamD = Array.flattenArray #-}

287−

288184-- | Create a singleton 'Stream' from a pure value.

289185{-# INLINE_NORMAL yield #-}

290186yield :: Applicative m => a -> Stream m a

@@ -294,111 +190,227 @@ yield x = Stream (\_ s -> pure $ step undefined s) True

294190 step _ True = Yield x False

295191 step _ False = Stop

296192

297−{-# INLINE_NORMAL concatAp #-}

298−concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b

299−concatAp (Stream stepa statea) (Stream stepb stateb) = Stream step' (Left statea)

193+-- | Create a singleton 'Stream' from a monadic action.

194+{-# INLINE_NORMAL yieldM #-}

195+yieldM :: Monad m => m a -> Stream m a

196+yieldM m = Stream step True

300197 where

301− {-# INLINE_LATE step' #-}

302− step' gst (Left st) = fmap

303− (\r -> case r of

304− Yield f s -> Skip (Right (f, s, stateb))

305− Skip s -> Skip (Left s)

306− Stop -> Stop)

307− (stepa (adaptState gst) st)

308− step' gst (Right (f, os, st)) = fmap

309− (\r -> case r of

310− Yield a s -> Yield (f a) (Right (f, os, s))

311− Skip s -> Skip (Right (f,os, s))

312− Stop -> Skip (Left os))

313− (stepb (adaptState gst) st)

314−

315−{-# INLINE_NORMAL apSequence #-}

316−apSequence :: Functor f => Stream f a -> Stream f b -> Stream f b

317−apSequence (Stream stepa statea) (Stream stepb stateb) =

318− Stream step (Left statea)

198+ {-# INLINE_LATE step #-}

199+ step _ True = m >>= \x -> return $ Yield x False

200+ step _ False = return Stop

319201

320− where

202+------------------------------------------------------------------------------

203+-- From Containers

204+------------------------------------------------------------------------------

321205

206+-- Adapted from the vector package.

207+-- | Convert a list of pure values to a 'Stream'

208+{-# INLINE_LATE fromList #-}

209+fromList :: Applicative m => [a] -> Stream m a

210+fromList = Stream step

211+ where

322212 {-# INLINE_LATE step #-}

323− step gst (Left st) =

324− fmap

325− (\r ->

326− case r of

327− Yield _ s -> Skip (Right (s, stateb))

328− Skip s -> Skip (Left s)

329− Stop -> Stop)

330− (stepa (adaptState gst) st)

331− step gst (Right (ostate, st)) =

332− fmap

333− (\r ->

334− case r of

335− Yield b s -> Yield b (Right (ostate, s))

336− Skip s -> Skip (Right (ostate, s))

337− Stop -> Skip (Left ostate))

338− (stepb gst st)

213+ step _ (x:xs) = pure $ Yield x xs

214+ step _ [] = pure Stop

339215

340−{-# INLINE_NORMAL apDiscardSnd #-}

341−apDiscardSnd :: Functor f => Stream f a -> Stream f b -> Stream f a

342−apDiscardSnd (Stream stepa statea) (Stream stepb stateb) =

343− Stream step (Left statea)

216+data FromSVarState t m a =

217+ FromSVarInit

218+ | FromSVarRead (SVar t m a)

219+ | FromSVarLoop (SVar t m a) [ChildEvent a]

220+ | FromSVarDone (SVar t m a)

344221

222+{-# INLINE_NORMAL fromSVar #-}

223+fromSVar :: (MonadAsync m) => SVar t m a -> Stream m a

224+fromSVar svar = Stream step FromSVarInit

345225 where

346226

347227 {-# INLINE_LATE step #-}

348− step gst (Left st) =

349− fmap

350− (\r ->

351− case r of

352− Yield b s -> Skip (Right (s, stateb, b))

353− Skip s -> Skip (Left s)

354− Stop -> Stop)

355− (stepa gst st)

356− step gst (Right (ostate, st, b)) =

357− fmap

358− (\r ->

359− case r of

360− Yield _ s -> Yield b (Right (ostate, s, b))

361− Skip s -> Skip (Right (ostate, s, b))

362− Stop -> Skip (Left ostate))

363− (stepb (adaptState gst) st)

228+ step _ FromSVarInit = do

229+ ref <- liftIO $ newIORef ()

230+ _ <- liftIO $ mkWeakIORef ref hook

231+ -- when this copy of svar gets garbage collected "ref" will get

232+ -- garbage collected and our GC hook will be called.

233+ let sv = svar{svarRef = Just ref}

234+ return $ Skip (FromSVarRead sv)

364235

365−instance Applicative f => Applicative (Stream f) where

366− {-# INLINE pure #-}

367− pure = yield

236+ where

368237

369− {-# INLINE (<*>) #-}

370− (<*>) = concatAp

238+ {-# NOINLINE hook #-}

239+ hook = do

240+ when (svarInspectMode svar) $ do

241+ r <- liftIO $ readIORef (svarStopTime (svarStats svar))

242+ when (isNothing r) $

243+ printSVar svar "SVar Garbage Collected"

244+ cleanupSVar svar

245+ -- If there are any SVars referenced by this SVar a GC will prompt

246+ -- them to be cleaned up quickly.

247+ when (svarInspectMode svar) performMajorGC

371248

372−#if MIN_VERSION_base(4,10,0)

373− {-# INLINE liftA2 #-}

374− liftA2 f x = (<*>) (fmap f x)

249+ step _ (FromSVarRead sv) = do

250+ list <- readOutputQ sv

251+ -- Reversing the output is important to guarantee that we process the

252+ -- outputs in the same order as they were generated by the constituent

253+ -- streams.

254+ return $ Skip $ FromSVarLoop sv (Prelude.reverse list)

255+

256+ step _ (FromSVarLoop sv []) = do

257+ done <- postProcess sv

258+ return $ Skip $ if done

259+ then (FromSVarDone sv)

260+ else (FromSVarRead sv)

261+

262+ step _ (FromSVarLoop sv (ev : es)) = do

263+ case ev of

264+ ChildYield a -> return $ Yield a (FromSVarLoop sv es)

265+ ChildStop tid e -> do

266+ accountThread sv tid

267+ case e of

268+ Nothing -> do

269+ stop <- shouldStop tid

270+ if stop

271+ then do

272+ liftIO (cleanupSVar sv)

273+ return $ Skip (FromSVarDone sv)

274+ else return $ Skip (FromSVarLoop sv es)

275+ Just ex ->

276+ case fromException ex of

277+ Just ThreadAbort ->

278+ return $ Skip (FromSVarLoop sv es)

279+ Nothing -> liftIO (cleanupSVar sv) >> throwM ex

280+ where

281+

282+ shouldStop tid =

283+ case svarStopStyle sv of

284+ StopNone -> return False

285+ StopAny -> return True

286+ StopBy -> do

287+ sid <- liftIO $ readIORef (svarStopBy sv)

288+ return $ if tid == sid then True else False

289+

290+ step _ (FromSVarDone sv) = do

291+ when (svarInspectMode sv) $ do

292+ t <- liftIO $ getTime Monotonic

293+ liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)

294+ liftIO $ printSVar sv "SVar Done"

295+ return Stop

296+

297+{-# INLINE_NORMAL fromPrimIORef #-}

298+fromPrimIORef :: (MonadIO m, Prim a) => Prim.IORef a -> Stream m a

299+fromPrimIORef var = Stream step ()

300+ where

301+ {-# INLINE_LATE step #-}

302+ step _ () = liftIO (Prim.readIORef var) >>= \x -> return $ Yield x ()

303+

304+-------------------------------------------------------------------------------

305+-- Process events received by a fold consumer from a stream producer

306+-------------------------------------------------------------------------------

307+

308+{-# INLINE_NORMAL fromProducer #-}

309+fromProducer :: (MonadAsync m) => SVar t m a -> Stream m a

310+fromProducer svar = Stream step (FromSVarRead svar)

311+ where

312+

313+ {-# INLINE_LATE step #-}

314+ step _ (FromSVarRead sv) = do

315+ list <- readOutputQ sv

316+ -- Reversing the output is important to guarantee that we process the

317+ -- outputs in the same order as they were generated by the constituent

318+ -- streams.

319+ return $ Skip $ FromSVarLoop sv (Prelude.reverse list)

320+

321+ step _ (FromSVarLoop sv []) = return $ Skip $ FromSVarRead sv

322+ step _ (FromSVarLoop sv (ev : es)) = do

323+ case ev of

324+ ChildYield a -> return $ Yield a (FromSVarLoop sv es)

325+ ChildStop tid e -> do

326+ accountThread sv tid

327+ case e of

328+ Nothing -> do

329+ sendStopToProducer sv

330+ return $ Skip (FromSVarDone sv)

331+ Just _ -> error "Bug: fromProducer: received exception"

332+

333+ step _ (FromSVarDone sv) = do

334+ when (svarInspectMode sv) $ do

335+ t <- liftIO $ getTime Monotonic

336+ liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)

337+ liftIO $ printSVar sv "SVar Done"

338+ return Stop

339+

340+ step _ FromSVarInit = undefined

341+

342+------------------------------------------------------------------------------

343+-- Conversions From/To

344+------------------------------------------------------------------------------

345+

346+{-# INLINE_LATE fromStreamK #-}

347+fromStreamK :: Monad m => K.Stream m a -> Stream m a

348+fromStreamK = Stream step

349+ where

350+ step gst m1 =

351+ let stop = return Stop

352+ single a = return $ Yield a K.nil

353+ yieldk a r = return $ Yield a r

354+ in K.foldStreamShared gst yieldk single stop m1

355+

356+-- Convert a direct stream to and from CPS encoded stream

357+{-# INLINE_LATE toStreamK #-}

358+toStreamK :: Monad m => Stream m a -> K.Stream m a

359+toStreamK (Stream step state) = go state

360+ where

361+ go st = K.mkStream $ \gst yld _ stp ->

362+ let go' ss = do

363+ r <- step gst ss

364+ case r of

365+ Yield x s -> yld x (go s)

366+ Skip s -> go' s

367+ Stop -> stp

368+ in go' st

369+

370+#ifndef DISABLE_FUSION

371+{-# RULES "fromStreamK/toStreamK fusion"

372+ forall s. toStreamK (fromStreamK s) = s #-}

373+{-# RULES "toStreamK/fromStreamK fusion"

374+ forall s. fromStreamK (toStreamK s) = s #-}

375375#endif

376376

377− {-# INLINE (*>) #-}

378− (*>) = apSequence

377+{-# INLINE fromStreamD #-}

378+fromStreamD :: (K.IsStream t, Monad m) => Stream m a -> t m a

379+fromStreamD = K.fromStream . toStreamK

379380

380− {-# INLINE (<*) #-}

381− (<*) = apDiscardSnd

381+{-# INLINE toStreamD #-}

382+toStreamD :: (K.IsStream t, Monad m) => t m a -> Stream m a

383+toStreamD = fromStreamK . K.toStream

382384

383−-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,

384−-- the monad instance does not seem to be significantly faster.

385−instance Monad m => Monad (Stream m) where

386− {-# INLINE return #-}

387− return = pure

385+------------------------------------------------------------------------------

386+-- Running a 'Fold'

387+------------------------------------------------------------------------------

388388

389− {-# INLINE (>>=) #-}

390− (>>=) = flip concatMap

389+{-# INLINE_NORMAL foldOnce #-}

390+foldOnce :: (Monad m) => Fold m a b -> Stream m a -> m b

391+foldOnce (Fold fstep begin done) (Stream step state) =

392+ begin >>= \x -> go SPEC x state

391393

392− {-# INLINE (>>) #-}

393− (>>) = (*>)

394+ where

394395

395−instance MonadTrans Stream where

396− {-# INLINE lift #-}

397− lift = yieldM

396+ {-# INLINE go #-}

397+ go !_ !fs st = do

398+ r <- step defState st

399+ case r of

400+ Yield x s -> do

401+ res <- fstep fs x

402+ case res of

403+ FL.Done b -> return b

404+ FL.Partial fs1 -> go SPEC fs1 s

405+ Skip s -> go SPEC fs s

406+ Stop -> done fs

398407

399−instance (MonadThrow m) => MonadThrow (Stream m) where

400− throwM = lift . throwM

408+------------------------------------------------------------------------------

409+-- Right Folds

410+------------------------------------------------------------------------------

401411

412+-- Adapted from the vector package.

413+--

402414-- XXX Use of SPEC constructor in folds causes 2x performance degradation in

403415-- one shot operations, but helps immensely in operations composed of multiple

404416-- combinators or the same combinator many times. There seems to be an

@@ -454,15 +466,6 @@ foldrMx fstep final convert (Stream step state) = convert $ go SPEC state

454466foldr :: Monad m => (a -> b -> b) -> b -> Stream m a -> m b

455467foldr f z = foldrM (\a b -> liftA2 f (return a) b) (return z)

456468

457−-- | Create a singleton 'Stream' from a monadic action.

458−{-# INLINE_NORMAL yieldM #-}

459−yieldM :: Monad m => m a -> Stream m a

460−yieldM m = Stream step True

461− where

462− {-# INLINE_LATE step #-}

463− step _ True = m >>= \x -> return $ Yield x False

464− step _ False = return Stop

465−

466469-- this performs horribly, should not be used

467470{-# INLINE_NORMAL foldrS #-}

468471foldrS

@@ -498,25 +501,9 @@ foldrT f final (Stream step state) = go SPEC state

498501 Skip s -> go SPEC s

499502 Stop -> final

500503

501−{-# INLINE_NORMAL toList #-}

502−toList :: Monad m => Stream m a -> m [a]

503−toList = foldr (:) []

504−

505−-- Use foldr/build fusion to fuse with list consumers

506−-- This can be useful when using the IsList instance

507−{-# INLINE_LATE toListFB #-}

508−toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b

509−toListFB c n (Stream step state) = go state

510− where

511− go st = case runIdentity (step defState st) of

512− Yield x s -> x `c` go s

513− Skip s -> go s

514− Stop -> n

515−

516−{-# RULES "toList Identity" toList = toListId #-}

517−{-# INLINE_EARLY toListId #-}

518−toListId :: Stream Identity a -> Identity [a]

519−toListId s = Identity $ build (\c n -> toListFB c n s)

504+------------------------------------------------------------------------------

505+-- Left Folds

506+------------------------------------------------------------------------------

520507

521508-- XXX run begin action only if the stream is not empty.

522509{-# INLINE_NORMAL foldlMx' #-}

@@ -540,6 +527,7 @@ foldlx' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Stream m a -> m b

540527foldlx' fstep begin done m =

541528 foldlMx' (\b a -> return (fstep b a)) (return begin) (return . done) m

542529

530+-- Adapted from the vector package.

543531-- XXX implement in terms of foldlMx'?

544532{-# INLINE_NORMAL foldlM' #-}

545533foldlM' :: Monad m => (b -> a -> m b) -> m b -> Stream m a -> m b

@@ -561,34 +549,122 @@ foldlM' fstep mbegin (Stream step state) = do

561549foldl' :: Monad m => (b -> a -> b) -> b -> Stream m a -> m b

562550foldl' fstep begin = foldlM' (\b a -> return (fstep b a)) (return begin)

563551

564−-- | Convert a list of pure values to a 'Stream'

565−{-# INLINE_LATE fromList #-}

566−fromList :: Applicative m => [a] -> Stream m a

567−fromList = Stream step

568− where

569− {-# INLINE_LATE step #-}

570− step _ (x:xs) = pure $ Yield x xs

571− step _ [] = pure Stop

572−

573552------------------------------------------------------------------------------

574−-- Comparisons

553+-- To Containers

575554------------------------------------------------------------------------------

576555

577−{-# INLINE_NORMAL eqBy #-}

578−eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool

579−eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2

580− where

581− eq_loop0 !_ s1 s2 = do

582− r <- step1 defState s1

583− case r of

584− Yield x s1' -> eq_loop1 SPEC x s1' s2

585− Skip s1' -> eq_loop0 SPEC s1' s2

586− Stop -> eq_null s2

556+{-# INLINE_NORMAL toList #-}

557+toList :: Monad m => Stream m a -> m [a]

558+toList = foldr (:) []

587559

588− eq_loop1 !_ x s1 s2 = do

589− r <- step2 defState s2

590− case r of

591− Yield y s2'

560+-- Use foldr/build fusion to fuse with list consumers

561+-- This can be useful when using the IsList instance

562+{-# INLINE_LATE toListFB #-}

563+toListFB :: (a -> b -> b) -> b -> Stream Identity a -> b

564+toListFB c n (Stream step state) = go state

565+ where

566+ go st = case runIdentity (step defState st) of

567+ Yield x s -> x `c` go s

568+ Skip s -> go s

569+ Stop -> n

570+

571+{-# RULES "toList Identity" toList = toListId #-}

572+{-# INLINE_EARLY toListId #-}

573+toListId :: Stream Identity a -> Identity [a]

574+toListId s = Identity $ build (\c n -> toListFB c n s)

575+

576+-------------------------------------------------------------------------------

577+-- Concurrent application and fold

578+-------------------------------------------------------------------------------

579+

580+-- XXX These functions should be moved to Stream/Parallel.hs

581+--

582+-- Using StreamD the worker stream producing code can fuse with the code to

583+-- queue output to the SVar giving some perf boost.

584+--

585+-- Note that StreamD can only be used in limited situations, specifically, we

586+-- cannot implement joinStreamVarPar using this.

587+--

588+-- XXX make sure that the SVar passed is a Parallel style SVar.

589+

590+-- | Fold the supplied stream to the SVar asynchronously using Parallel

591+-- concurrency style.

592+-- {-# INLINE_NORMAL toSVarParallel #-}

593+{-# INLINE toSVarParallel #-}

594+toSVarParallel :: MonadAsync m

595+ => State t m a -> SVar t m a -> Stream m a -> m ()

596+toSVarParallel st sv xs =

597+ if svarInspectMode sv

598+ then forkWithDiag

599+ else do

600+ tid <-

601+ case getYieldLimit st of

602+ Nothing -> doFork (work Nothing)

603+ (svarMrun sv)

604+ (handleChildException sv)

605+ Just _ -> doFork (workLim Nothing)

606+ (svarMrun sv)

607+ (handleChildException sv)

608+ modifyThread sv tid

609+

610+ where

611+

612+ {-# NOINLINE work #-}

613+ work info = (foldOnce (FL.toParallelSVar sv info) xs)

614+

615+ {-# NOINLINE workLim #-}

616+ workLim info = foldOnce (FL.toParallelSVarLimited sv info) xs

617+

618+ {-# NOINLINE forkWithDiag #-}

619+ forkWithDiag = do

620+ -- We do not use workerCount in case of ParallelVar but still there is

621+ -- no harm in maintaining it correctly.

622+ liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1

623+ recordMaxWorkers sv

624+ -- This allocation matters when significant number of workers are being

625+ -- sent. We allocate it only when needed. The overhead increases by 4x.

626+ winfo <-

627+ case yieldRateInfo sv of

628+ Nothing -> return Nothing

629+ Just _ -> liftIO $ do

630+ cntRef <- newIORef 0

631+ t <- getTime Monotonic

632+ lat <- newIORef (0, t)

633+ return $ Just WorkerInfo

634+ { workerYieldMax = 0

635+ , workerYieldCount = cntRef

636+ , workerLatencyStart = lat

637+ }

638+ tid <-

639+ case getYieldLimit st of

640+ Nothing -> doFork (work winfo)

641+ (svarMrun sv)

642+ (handleChildException sv)

643+ Just _ -> doFork (workLim winfo)

644+ (svarMrun sv)

645+ (handleChildException sv)

646+ modifyThread sv tid

647+

648+------------------------------------------------------------------------------

649+-- Multi-stream folds

650+------------------------------------------------------------------------------

651+

652+-- Adapted from the vector package.

653+{-# INLINE_NORMAL eqBy #-}

654+eqBy :: Monad m => (a -> b -> Bool) -> Stream m a -> Stream m b -> m Bool

655+eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2

656+ where

657+ eq_loop0 !_ s1 s2 = do

658+ r <- step1 defState s1

659+ case r of

660+ Yield x s1' -> eq_loop1 SPEC x s1' s2

661+ Skip s1' -> eq_loop0 SPEC s1' s2

662+ Stop -> eq_null s2

663+

664+ eq_loop1 !_ x s1 s2 = do

665+ r <- step2 defState s2

666+ case r of

667+ Yield y s2'

592668 | eq x y -> eq_loop0 SPEC s1 s2'

593669 | otherwise -> return False

594670 Skip s2' -> eq_loop1 SPEC x s1 s2'

@@ -601,6 +677,7 @@ eqBy eq (Stream step1 t1) (Stream step2 t2) = eq_loop0 SPEC t1 t2

601677 Skip s2' -> eq_null s2'

602678 Stop -> return True

603679

680+-- Adapted from the vector package.

604681-- | Compare two streams lexicographically

605682{-# INLINE_NORMAL cmpBy #-}

606683cmpBy

@@ -631,10 +708,43 @@ cmpBy cmp (Stream step1 t1) (Stream step2 t2) = cmp_loop0 SPEC t1 t2

631708 Skip s2' -> cmp_null s2'

632709 Stop -> return EQ

633710

711+------------------------------------------------------------------------------

712+-- Transformations

713+------------------------------------------------------------------------------

714+

715+-- Adapted from the vector package.

716+-- | Map a monadic function over a 'Stream'

717+{-# INLINE_NORMAL mapM #-}

718+mapM :: Monad m => (a -> m b) -> Stream m a -> Stream m b

719+mapM f (Stream step state) = Stream step' state

720+ where

721+ {-# INLINE_LATE step' #-}

722+ step' gst st = do

723+ r <- step (adaptState gst) st

724+ case r of

725+ Yield x s -> f x >>= \a -> return $ Yield a s

726+ Skip s -> return $ Skip s

727+ Stop -> return Stop

728+

729+{-# INLINE map #-}

730+map :: Monad m => (a -> b) -> Stream m a -> Stream m b

731+map f = mapM (return . f)

732+

733+instance Functor m => Functor (Stream m) where

734+ {-# INLINE fmap #-}

735+ fmap f (Stream step state) = Stream step' state

736+ where

737+ {-# INLINE_LATE step' #-}

738+ step' gst st = fmap (fmap f) (step (adaptState gst) st)

739+

740+ {-# INLINE (<$) #-}

741+ (<$) = fmap . const

742+

634743-------------------------------------------------------------------------------

635744-- Filtering

636745-------------------------------------------------------------------------------

637746

747+-- Adapted from the vector package.

638748{-# INLINE_NORMAL take #-}

639749take :: Monad m => Int -> Stream m a -> Stream m a

640750take n (Stream step state) = n `seq` Stream step' (state, 0)

@@ -648,7 +758,7 @@ take n (Stream step state) = n `seq` Stream step' (state, 0)

648758 Stop -> Stop

649759 step' _ (_, _) = return Stop

650760

651−

761+-- Adapted from the vector package.

652762{-# INLINE_NORMAL takeWhileM #-}

653763takeWhileM :: Monad m => (a -> m Bool) -> Stream m a -> Stream m a

654764takeWhileM f (Stream step state) = Stream step' state

@@ -667,6 +777,158 @@ takeWhileM f (Stream step state) = Stream step' state

667777takeWhile :: Monad m => (a -> Bool) -> Stream m a -> Stream m a

668778takeWhile f = takeWhileM (return . f)

669779

780+------------------------------------------------------------------------------

781+-- Combine N Streams - concatAp

782+------------------------------------------------------------------------------

783+

784+{-# INLINE_NORMAL concatAp #-}

785+concatAp :: Functor f => Stream f (a -> b) -> Stream f a -> Stream f b

786+concatAp (Stream stepa statea) (Stream stepb stateb) = Stream step' (Left statea)

787+ where

788+ {-# INLINE_LATE step' #-}

789+ step' gst (Left st) = fmap

790+ (\r -> case r of

791+ Yield f s -> Skip (Right (f, s, stateb))

792+ Skip s -> Skip (Left s)

793+ Stop -> Stop)

794+ (stepa (adaptState gst) st)

795+ step' gst (Right (f, os, st)) = fmap

796+ (\r -> case r of

797+ Yield a s -> Yield (f a) (Right (f, os, s))

798+ Skip s -> Skip (Right (f,os, s))

799+ Stop -> Skip (Left os))

800+ (stepb (adaptState gst) st)

801+

802+{-# INLINE_NORMAL apSequence #-}

803+apSequence :: Functor f => Stream f a -> Stream f b -> Stream f b

804+apSequence (Stream stepa statea) (Stream stepb stateb) =

805+ Stream step (Left statea)

806+

807+ where

808+

809+ {-# INLINE_LATE step #-}

810+ step gst (Left st) =

811+ fmap

812+ (\r ->

813+ case r of

814+ Yield _ s -> Skip (Right (s, stateb))

815+ Skip s -> Skip (Left s)

816+ Stop -> Stop)

817+ (stepa (adaptState gst) st)

818+ step gst (Right (ostate, st)) =

819+ fmap

820+ (\r ->

821+ case r of

822+ Yield b s -> Yield b (Right (ostate, s))

823+ Skip s -> Skip (Right (ostate, s))

824+ Stop -> Skip (Left ostate))

825+ (stepb gst st)

826+

827+{-# INLINE_NORMAL apDiscardSnd #-}

828+apDiscardSnd :: Functor f => Stream f a -> Stream f b -> Stream f a

829+apDiscardSnd (Stream stepa statea) (Stream stepb stateb) =

830+ Stream step (Left statea)

831+

832+ where

833+

834+ {-# INLINE_LATE step #-}

835+ step gst (Left st) =

836+ fmap

837+ (\r ->

838+ case r of

839+ Yield b s -> Skip (Right (s, stateb, b))

840+ Skip s -> Skip (Left s)

841+ Stop -> Stop)

842+ (stepa gst st)

843+ step gst (Right (ostate, st, b)) =

844+ fmap

845+ (\r ->

846+ case r of

847+ Yield _ s -> Yield b (Right (ostate, s, b))

848+ Skip s -> Skip (Right (ostate, s, b))

849+ Stop -> Skip (Left ostate))

850+ (stepb (adaptState gst) st)

851+

852+instance Applicative f => Applicative (Stream f) where

853+ {-# INLINE pure #-}

854+ pure = yield

855+

856+ {-# INLINE (<*>) #-}

857+ (<*>) = concatAp

858+

859+#if MIN_VERSION_base(4,10,0)

860+ {-# INLINE liftA2 #-}

861+ liftA2 f x = (<*>) (fmap f x)

862+#endif

863+

864+ {-# INLINE (*>) #-}

865+ (*>) = apSequence

866+

867+ {-# INLINE (<*) #-}

868+ (<*) = apDiscardSnd

869+

870+------------------------------------------------------------------------------

871+-- Combine N Streams - concatMap

872+------------------------------------------------------------------------------

873+

874+-- Adapted from the vector package.

875+{-# INLINE_NORMAL concatMapM #-}

876+concatMapM :: Monad m => (a -> m (Stream m b)) -> Stream m a -> Stream m b

877+concatMapM f (Stream step state) = Stream step' (Left state)

878+ where

879+ {-# INLINE_LATE step' #-}

880+ step' gst (Left st) = do

881+ r <- step (adaptState gst) st

882+ case r of

883+ Yield a s -> do

884+ b_stream <- f a

885+ return $ Skip (Right (b_stream, s))

886+ Skip s -> return $ Skip (Left s)

887+ Stop -> return Stop

888+

889+ -- XXX flattenArrays is 5x faster than "concatMap fromArray". if somehow we

890+ -- can get inner_step to inline and fuse here we can perhaps get the same

891+ -- performance using "concatMap fromArray".

892+ --

893+ -- XXX using the pattern synonym "Stream" causes a major performance issue

894+ -- here even if the synonym does not include an adaptState call. Need to

895+ -- find out why. Is that something to be fixed in GHC?

896+ step' gst (Right (UnStream inner_step inner_st, st)) = do

897+ r <- inner_step (adaptState gst) inner_st

898+ case r of

899+ Yield b inner_s ->

900+ return $ Yield b (Right (Stream inner_step inner_s, st))

901+ Skip inner_s ->

902+ return $ Skip (Right (Stream inner_step inner_s, st))

903+ Stop -> return $ Skip (Left st)

904+

905+{-# INLINE concatMap #-}

906+concatMap :: Monad m => (a -> Stream m b) -> Stream m a -> Stream m b

907+concatMap f = concatMapM (return . f)

908+

909+-- XXX The idea behind this rule is to rewrite any calls to "concatMap

910+-- fromArray" automatically to flattenArrays which is much faster. However, we

911+-- need an INLINE_EARLY on concatMap for this rule to fire. But if we use

912+-- INLINE_EARLY on concatMap or fromArray then direct uses of

913+-- "concatMap fromArray" (without the RULE) become much slower, this means

914+-- "concatMap f" in general would become slower. Need to find a solution to

915+-- this.

916+--

917+-- {-# RULES "concatMap Array.toStreamD"

918+-- concatMap Array.toStreamD = Array.flattenArray #-}

919+

920+-- NOTE: even though concatMap for StreamD is 4x faster compared to StreamK,

921+-- the monad instance does not seem to be significantly faster.

922+instance Monad m => Monad (Stream m) where

923+ {-# INLINE return #-}

924+ return = pure

925+

926+ {-# INLINE (>>=) #-}

927+ (>>=) = flip concatMap

928+

929+ {-# INLINE (>>) #-}

930+ (>>) = (*>)

931+

670932------------------------------------------------------------------------------

671933-- Grouping/Splitting

672934------------------------------------------------------------------------------

@@ -792,227 +1054,13 @@ groupsOf2 n input (Fold2 fstep inject extract) (Stream step state) =

7921054

7931055 step' _ GroupFinish2 = return Stop

7941056

795−data FromSVarState t m a =

796− FromSVarInit

797− | FromSVarRead (SVar t m a)

798− | FromSVarLoop (SVar t m a) [ChildEvent a]

799− | FromSVarDone (SVar t m a)

800−

801−-------------------------------------------------------------------------------

802−-- Generation from SVar

803−-------------------------------------------------------------------------------

804−

805−{-# INLINE_NORMAL fromSVar #-}

806−fromSVar :: (MonadAsync m) => SVar t m a -> Stream m a

807−fromSVar svar = Stream step FromSVarInit

808− where

809−

810− {-# INLINE_LATE step #-}

811− step _ FromSVarInit = do

812− ref <- liftIO $ newIORef ()

813− _ <- liftIO $ mkWeakIORef ref hook

814− -- when this copy of svar gets garbage collected "ref" will get

815− -- garbage collected and our GC hook will be called.

816− let sv = svar{svarRef = Just ref}

817− return $ Skip (FromSVarRead sv)

818−

819− where

820−

821− {-# NOINLINE hook #-}

822− hook = do

823− when (svarInspectMode svar) $ do

824− r <- liftIO $ readIORef (svarStopTime (svarStats svar))

825− when (isNothing r) $

826− printSVar svar "SVar Garbage Collected"

827− cleanupSVar svar

828− -- If there are any SVars referenced by this SVar a GC will prompt

829− -- them to be cleaned up quickly.

830− when (svarInspectMode svar) performMajorGC

831−

832− step _ (FromSVarRead sv) = do

833− list <- readOutputQ sv

834− -- Reversing the output is important to guarantee that we process the

835− -- outputs in the same order as they were generated by the constituent

836− -- streams.

837− return $ Skip $ FromSVarLoop sv (Prelude.reverse list)

838−

839− step _ (FromSVarLoop sv []) = do

840− done <- postProcess sv

841− return $ Skip $ if done

842− then (FromSVarDone sv)

843− else (FromSVarRead sv)

844−

845− step _ (FromSVarLoop sv (ev : es)) = do

846− case ev of

847− ChildYield a -> return $ Yield a (FromSVarLoop sv es)

848− ChildStop tid e -> do

849− accountThread sv tid

850− case e of

851− Nothing -> do

852− stop <- shouldStop tid

853− if stop

854− then do

855− liftIO (cleanupSVar sv)

856− return $ Skip (FromSVarDone sv)

857− else return $ Skip (FromSVarLoop sv es)

858− Just ex ->

859− case fromException ex of

860− Just ThreadAbort ->

861− return $ Skip (FromSVarLoop sv es)

862− Nothing -> liftIO (cleanupSVar sv) >> throwM ex

863− where

864−

865− shouldStop tid =

866− case svarStopStyle sv of

867− StopNone -> return False

868− StopAny -> return True

869− StopBy -> do

870− sid <- liftIO $ readIORef (svarStopBy sv)

871− return $ if tid == sid then True else False

872−

873− step _ (FromSVarDone sv) = do

874− when (svarInspectMode sv) $ do

875− t <- liftIO $ getTime Monotonic

876− liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)

877− liftIO $ printSVar sv "SVar Done"

878− return Stop

879−

880−{-# INLINE_NORMAL fromPrimIORef #-}

881−fromPrimIORef :: (MonadIO m, Prim a) => Prim.IORef a -> Stream m a

882−fromPrimIORef var = Stream step ()

883− where

884− {-# INLINE_LATE step #-}

885− step _ () = liftIO (Prim.readIORef var) >>= \x -> return $ Yield x ()

886−

887−-------------------------------------------------------------------------------

888−-- Process events received by a fold consumer from a stream producer

889−-------------------------------------------------------------------------------

890−

891−{-# INLINE_NORMAL fromProducer #-}

892−fromProducer :: (MonadAsync m) => SVar t m a -> Stream m a

893−fromProducer svar = Stream step (FromSVarRead svar)

894− where

895−

896− {-# INLINE_LATE step #-}

897− step _ (FromSVarRead sv) = do

898− list <- readOutputQ sv

899− -- Reversing the output is important to guarantee that we process the

900− -- outputs in the same order as they were generated by the constituent

901− -- streams.

902− return $ Skip $ FromSVarLoop sv (Prelude.reverse list)

903−

904− step _ (FromSVarLoop sv []) = return $ Skip $ FromSVarRead sv

905− step _ (FromSVarLoop sv (ev : es)) = do

906− case ev of

907− ChildYield a -> return $ Yield a (FromSVarLoop sv es)

908− ChildStop tid e -> do

909− accountThread sv tid

910− case e of

911− Nothing -> do

912− sendStopToProducer sv

913− return $ Skip (FromSVarDone sv)

914− Just _ -> error "Bug: fromProducer: received exception"

915−

916− step _ (FromSVarDone sv) = do

917− when (svarInspectMode sv) $ do

918− t <- liftIO $ getTime Monotonic

919− liftIO $ writeIORef (svarStopTime (svarStats sv)) (Just t)

920− liftIO $ printSVar sv "SVar Done"

921− return Stop

922−

923− step _ FromSVarInit = undefined

924−

9251057------------------------------------------------------------------------------

926−-- Left Folds

1058+-- Other instances

9271059------------------------------------------------------------------------------

9281060

929−{-# INLINE_NORMAL foldOnce #-}

930−foldOnce :: (Monad m) => Fold m a b -> Stream m a -> m b

931−foldOnce (Fold fstep begin done) (Stream step state) =

932− begin >>= \x -> go SPEC x state

933−

934− where

935−

936− {-# INLINE go #-}

937− go !_ !fs st = do

938− r <- step defState st

939− case r of

940− Yield x s -> do

941− res <- fstep fs x

942− case res of

943− FL.Done b -> return b

944− FL.Partial fs1 -> go SPEC fs1 s

945− Skip s -> go SPEC fs s

946− Stop -> done fs

947−

948−-------------------------------------------------------------------------------

949−-- Concurrent application and fold

950−-------------------------------------------------------------------------------

951−

952−-- XXX These functions should be moved to Stream/Parallel.hs

953−--

954−-- Using StreamD the worker stream producing code can fuse with the code to

955−-- queue output to the SVar giving some perf boost.

956−--

957−-- Note that StreamD can only be used in limited situations, specifically, we

958−-- cannot implement joinStreamVarPar using this.

959−--

960−-- XXX make sure that the SVar passed is a Parallel style SVar.

961−

962−-- | Fold the supplied stream to the SVar asynchronously using Parallel

963−-- concurrency style.

964−-- {-# INLINE_NORMAL toSVarParallel #-}

965−{-# INLINE toSVarParallel #-}

966−toSVarParallel :: MonadAsync m

967− => State t m a -> SVar t m a -> Stream m a -> m ()

968−toSVarParallel st sv xs =

969− if svarInspectMode sv

970− then forkWithDiag

971− else do

972− tid <-

973− case getYieldLimit st of

974− Nothing -> doFork (work Nothing)

975− (svarMrun sv)

976− (handleChildException sv)

977− Just _ -> doFork (workLim Nothing)

978− (svarMrun sv)

979− (handleChildException sv)

980− modifyThread sv tid

981−

982− where

983−

984− {-# NOINLINE work #-}

985− work info = (foldOnce (FL.toParallelSVar sv info) xs)

986−

987− {-# NOINLINE workLim #-}

988− workLim info = foldOnce (FL.toParallelSVarLimited sv info) xs

1061+instance MonadTrans Stream where

1062+ {-# INLINE lift #-}

1063+ lift = yieldM

9891064

990− {-# NOINLINE forkWithDiag #-}

991− forkWithDiag = do

992− -- We do not use workerCount in case of ParallelVar but still there is

993− -- no harm in maintaining it correctly.

994− liftIO $ atomicModifyIORefCAS_ (workerCount sv) $ \n -> n + 1

995− recordMaxWorkers sv

996− -- This allocation matters when significant number of workers are being

997− -- sent. We allocate it only when needed. The overhead increases by 4x.

998− winfo <-

999− case yieldRateInfo sv of

1000− Nothing -> return Nothing

1001− Just _ -> liftIO $ do

1002− cntRef <- newIORef 0

1003− t <- getTime Monotonic

1004− lat <- newIORef (0, t)

1005− return $ Just WorkerInfo

1006− { workerYieldMax = 0

1007− , workerYieldCount = cntRef

1008− , workerLatencyStart = lat

1009− }

1010− tid <-

1011− case getYieldLimit st of

1012− Nothing -> doFork (work winfo)

1013− (svarMrun sv)

1014− (handleChildException sv)

1015− Just _ -> doFork (workLim winfo)

1016− (svarMrun sv)

1017− (handleChildException sv)

1018− modifyThread sv tid

1065+instance (MonadThrow m) => MonadThrow (Stream m) where

1066+ throwM = lift . throwM

streamly.cabal+10−6

@@ -451,23 +451,19 @@ library

451451 , Streamly.Internal.Data.Stream.StreamK.Type

452452 , Streamly.Internal.Data.Stream.StreamK

453453 , Streamly.Internal.Data.Stream.StreamD.Type

454− , Streamly.Internal.Data.Stream.StreamD

455454 , Streamly.Internal.Data.Stream.StreamD.Generate

456455 , Streamly.Internal.Data.Stream.StreamD.Eliminate

457456 , Streamly.Internal.Data.Stream.StreamD.Nesting

458457 , Streamly.Internal.Data.Stream.StreamD.Transform

459458 , Streamly.Internal.Data.Stream.StreamD.Exception

459+ , Streamly.Internal.Data.Stream.StreamD.Lift

460+ , Streamly.Internal.Data.Stream.StreamD

460461 , Streamly.Internal.Data.Stream.StreamDK.Type

461462 , Streamly.Internal.Data.Stream.StreamDK

462463 , Streamly.Internal.Data.Stream.Enumeration

463464 , Streamly.Internal.Data.Stream.Prelude

464465

465466 -- Higher level streams

466− , Streamly.Internal.Data.Stream.IsStream

467− , Streamly.Internal.Data.Stream.IsStream.Generate

468− , Streamly.Internal.Data.Stream.IsStream.Eliminate

469− , Streamly.Internal.Data.Stream.IsStream.Transform

470− , Streamly.Internal.Data.Stream.IsStream.Exception

471467 , Streamly.Internal.Data.Stream.SVar

472468 , Streamly.Internal.Data.Stream.Serial

473469 , Streamly.Internal.Data.Stream.Async

@@ -475,6 +471,14 @@ library

475471 , Streamly.Internal.Data.Stream.Ahead

476472 , Streamly.Internal.Data.Stream.Zip

477473 , Streamly.Internal.Data.Stream.Combinators

474+ , Streamly.Internal.Data.Stream.IsStream.Common

475+ , Streamly.Internal.Data.Stream.IsStream.Generate

476+ , Streamly.Internal.Data.Stream.IsStream.Eliminate

477+ , Streamly.Internal.Data.Stream.IsStream.Transform

478+ , Streamly.Internal.Data.Stream.IsStream.Nesting

479+ , Streamly.Internal.Data.Stream.IsStream.Exception

480+ , Streamly.Internal.Data.Stream.IsStream.Lift

481+ , Streamly.Internal.Data.Stream.IsStream

478482 , Streamly.Internal.Data.List

479483

480484 -- Unfolds