pipes-interleave-1.0.0: Interleave and merge streams of elements

Safe HaskellSafe
LanguageHaskell2010

Pipes.Interleave

Synopsis

Documentation

interleave Source #

Arguments

:: (Monad m, Ord a) 
=> [Producer a m ()]

element producers

-> Producer a m () 

Interleave elements from a set of Producers such that the interleaved stream is increasing with respect to the given ordering.

>>> toList $ interleave [each [1,3..10], each [1,5..20]]
[1,1,3,5,5,7,9,9,13,17]

combine Source #

Arguments

:: (Monad m, Eq a) 
=> (a -> a -> a)

combine operation

-> Producer a m r 
-> Producer a m r 

Given a stream of increasing elements, combine those that are equal.

>>> let append (Entry k v) (Entry _ v') = Entry k (v+v')
>>> toList $ combine append (each $ map (uncurry Entry) [(1,1), (1,4), (2,3), (3,10)])
[Entry {priority = 1, payload = 5},Entry {priority = 2, payload = 3},Entry {priority = 3, payload = 10}]

combineM Source #

Arguments

:: (Monad m, Eq a) 
=> (a -> a -> m a)

combine operation

-> Producer a m r 
-> Producer a m r 

combine with monadic side-effects in the combine operation.

merge Source #

Arguments

:: (Monad m, Ord a) 
=> (a -> a -> a)

combine operation

-> [Producer a m ()]

producers of elements

-> Producer a m () 

Equivalent to combine composed with interleave

>>> let append (Entry k v) (Entry _ v') = Entry k (v+v')
>>> let producers = [ each [Entry i 2 | i <- [1,3..10]], each [Entry i 10 | i <- [1,5..20]] ] :: [Producer (Entry Int Int) Identity ()]
>>> toList $ merge append producers
[(1,12),(3,2),(5,12),(7,2),(9,12),(13,10),(17,10)]

mergeM Source #

Arguments

:: (Monad m, Ord a) 
=> (a -> a -> m a)

combine operation

-> [Producer a m ()]

producers of elements

-> Producer a m () 

Merge with monadic side-effects in the combine operation.

groupBy :: forall a r m. (Monad m, Ord a) => Producer a m r -> Producer [a] m r Source #

Split stream into groups of equal elements. Note that this is a non-local operation: if the Producer generates a large run of equal elements, all of them will remain in memory until the run ends.

>>> toList $ groupBy (each [Entry 1 1, Entry 1 4, Entry 2 3, Entry 3 10])
[[Entry {priority = 1, payload = 1},Entry {priority = 1, payload = 4}],[Entry {priority = 2, payload = 3}],[Entry {priority = 3, payload = 10}]]

data Entry p a :: * -> * -> * #

Explicit priority/payload tuples. Useful to build a priority queue using a Heap, since the payload is ignored in the Eq/Ord instances.

myHeap = fromList [Entry 2 "World", Entry 1 "Hello", Entry 3 "!"]

==> foldMap payload myHeap ≡ "HelloWorld!"

Constructors

Entry 

Fields

Instances

Functor (Entry p) 

Methods

fmap :: (a -> b) -> Entry p a -> Entry p b #

(<$) :: a -> Entry p b -> Entry p a #

Foldable (Entry p) 

Methods

fold :: Monoid m => Entry p m -> m #

foldMap :: Monoid m => (a -> m) -> Entry p a -> m #

foldr :: (a -> b -> b) -> b -> Entry p a -> b #

foldr' :: (a -> b -> b) -> b -> Entry p a -> b #

foldl :: (b -> a -> b) -> b -> Entry p a -> b #

foldl' :: (b -> a -> b) -> b -> Entry p a -> b #

foldr1 :: (a -> a -> a) -> Entry p a -> a #

foldl1 :: (a -> a -> a) -> Entry p a -> a #

toList :: Entry p a -> [a] #

null :: Entry p a -> Bool #

length :: Entry p a -> Int #

elem :: Eq a => a -> Entry p a -> Bool #

maximum :: Ord a => Entry p a -> a #

minimum :: Ord a => Entry p a -> a #

sum :: Num a => Entry p a -> a #

product :: Num a => Entry p a -> a #

Traversable (Entry p) 

Methods

traverse :: Applicative f => (a -> f b) -> Entry p a -> f (Entry p b) #

sequenceA :: Applicative f => Entry p (f a) -> f (Entry p a) #

mapM :: Monad m => (a -> m b) -> Entry p a -> m (Entry p b) #

sequence :: Monad m => Entry p (m a) -> m (Entry p a) #

Eq p => Eq (Entry p a) 

Methods

(==) :: Entry p a -> Entry p a -> Bool #

(/=) :: Entry p a -> Entry p a -> Bool #

(Data p, Data a) => Data (Entry p a) 

Methods

gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> Entry p a -> c (Entry p a) #

gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c (Entry p a) #

toConstr :: Entry p a -> Constr #

dataTypeOf :: Entry p a -> DataType #

dataCast1 :: Typeable (* -> *) t => (forall d. Data d => c (t d)) -> Maybe (c (Entry p a)) #

dataCast2 :: Typeable (* -> * -> *) t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c (Entry p a)) #

gmapT :: (forall b. Data b => b -> b) -> Entry p a -> Entry p a #

gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Entry p a -> r #

gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Entry p a -> r #

gmapQ :: (forall d. Data d => d -> u) -> Entry p a -> [u] #

gmapQi :: Int -> (forall d. Data d => d -> u) -> Entry p a -> u #

gmapM :: Monad m => (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a) #

gmapMp :: MonadPlus m => (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a) #

gmapMo :: MonadPlus m => (forall d. Data d => d -> m d) -> Entry p a -> m (Entry p a) #

Ord p => Ord (Entry p a) 

Methods

compare :: Entry p a -> Entry p a -> Ordering #

(<) :: Entry p a -> Entry p a -> Bool #

(<=) :: Entry p a -> Entry p a -> Bool #

(>) :: Entry p a -> Entry p a -> Bool #

(>=) :: Entry p a -> Entry p a -> Bool #

max :: Entry p a -> Entry p a -> Entry p a #

min :: Entry p a -> Entry p a -> Entry p a #

(Read p, Read a) => Read (Entry p a) 
(Show p, Show a) => Show (Entry p a) 

Methods

showsPrec :: Int -> Entry p a -> ShowS #

show :: Entry p a -> String #

showList :: [Entry p a] -> ShowS #