| Safe Haskell | Trustworthy | 
|---|---|
| Language | Haskell2010 | 
Pipes.Prelude
Description
General purpose utilities
The names in this module clash heavily with the Haskell Prelude, so I recommend the following import scheme:
import Pipes import qualified Pipes.Prelude as P -- or use any other qualifier you prefer
Note that String-based IO is inefficient.  The String-based utilities
    in this module exist only for simple demonstrations without incurring a
    dependency on the text package.
Also, stdinLn and stdoutLn remove and add newlines, respectively.  This
    behavior is intended to simplify examples.  The corresponding stdin and
    stdout utilities from pipes-bytestring and pipes-text preserve
    newlines.
Synopsis
- stdinLn :: forall (m :: Type -> Type). MonadIO m => Producer' String m ()
 - readLn :: forall (m :: Type -> Type) a. (MonadIO m, Read a) => Producer' a m ()
 - fromHandle :: forall (m :: Type -> Type) x' x. MonadIO m => Handle -> Proxy x' x () String m ()
 - repeatM :: Monad m => m a -> Proxy x' x () a m r
 - replicateM :: Monad m => Int -> m a -> Proxy x' x () a m ()
 - unfoldr :: Monad m => (s -> m (Either r (a, s))) -> s -> Producer a m r
 - stdoutLn :: forall (m :: Type -> Type). MonadIO m => Consumer' String m ()
 - stdoutLn' :: forall (m :: Type -> Type) r. MonadIO m => Consumer' String m r
 - mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r
 - print :: forall (m :: Type -> Type) a r. (MonadIO m, Show a) => Consumer' a m r
 - toHandle :: forall (m :: Type -> Type) r. MonadIO m => Handle -> Consumer' String m r
 - drain :: forall (m :: Type -> Type) a r. Functor m => Consumer' a m r
 - map :: forall (m :: Type -> Type) a b r. Functor m => (a -> b) -> Pipe a b m r
 - mapM :: Monad m => (a -> m b) -> Pipe a b m r
 - sequence :: Monad m => Pipe (m a) a m r
 - mapFoldable :: forall (m :: Type -> Type) t a b r. (Functor m, Foldable t) => (a -> t b) -> Pipe a b m r
 - filter :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a a m r
 - mapMaybe :: forall (m :: Type -> Type) a b r. Functor m => (a -> Maybe b) -> Pipe a b m r
 - filterM :: Monad m => (a -> m Bool) -> Pipe a a m r
 - wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r
 - take :: forall (m :: Type -> Type) a. Functor m => Int -> Pipe a a m ()
 - takeWhile :: forall (m :: Type -> Type) a. Functor m => (a -> Bool) -> Pipe a a m ()
 - takeWhile' :: forall (m :: Type -> Type) a. Functor m => (a -> Bool) -> Pipe a a m a
 - drop :: forall (m :: Type -> Type) a r. Functor m => Int -> Pipe a a m r
 - dropWhile :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a a m r
 - concat :: forall (m :: Type -> Type) f a r. (Functor m, Foldable f) => Pipe (f a) a m r
 - elemIndices :: forall (m :: Type -> Type) a r. (Functor m, Eq a) => a -> Pipe a Int m r
 - findIndices :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a Int m r
 - scan :: forall (m :: Type -> Type) x a b r. Functor m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
 - scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r
 - chain :: Monad m => (a -> m ()) -> Pipe a a m r
 - read :: forall (m :: Type -> Type) a r. (Functor m, Read a) => Pipe String a m r
 - show :: forall (m :: Type -> Type) a r. (Functor m, Show a) => Pipe a String m r
 - seq :: forall (m :: Type -> Type) a r. Functor m => Pipe a a m r
 - loop :: forall (m :: Type -> Type) a b r. Monad m => (a -> ListT m b) -> Pipe a b m r
 - fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
 - fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)
 - foldM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b
 - foldM' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)
 - all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
 - any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
 - and :: Monad m => Producer Bool m () -> m Bool
 - or :: Monad m => Producer Bool m () -> m Bool
 - elem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
 - notElem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
 - find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a)
 - findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int)
 - head :: Monad m => Producer a m () -> m (Maybe a)
 - index :: Monad m => Int -> Producer a m () -> m (Maybe a)
 - last :: Monad m => Producer a m () -> m (Maybe a)
 - length :: Monad m => Producer a m () -> m Int
 - maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
 - minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
 - null :: Monad m => Producer a m () -> m Bool
 - sum :: (Monad m, Num a) => Producer a m () -> m a
 - product :: (Monad m, Num a) => Producer a m () -> m a
 - toList :: Producer a Identity () -> [a]
 - toListM :: Monad m => Producer a m () -> m [a]
 - toListM' :: Monad m => Producer a m r -> m ([a], r)
 - zip :: forall (m :: Type -> Type) a r b x' x. Monad m => Producer a m r -> Producer b m r -> Proxy x' x () (a, b) m r
 - zipWith :: forall (m :: Type -> Type) a b c r x' x. Monad m => (a -> b -> c) -> Producer a m r -> Producer b m r -> Proxy x' x () c m r
 - tee :: forall (m :: Type -> Type) a r. Monad m => Consumer a m r -> Pipe a a m r
 - generalize :: forall (m :: Type -> Type) a b r x. Monad m => Pipe a b m r -> x -> Proxy x a x b m r
 
Producers
Use for loops to iterate over Producers whenever you want to perform the
    same action for every element:
-- Echo all lines from standard input to standard output
runEffect $ for P.stdinLn $ \str -> do
    lift $ putStrLn str... or more concisely:
>>>runEffect $ for P.stdinLn (lift . putStrLn)Test<Enter> Test ABC<Enter> ABC ...
fromHandle :: forall (m :: Type -> Type) x' x. MonadIO m => Handle -> Proxy x' x () String m () Source #
replicateM :: Monad m => Int -> m a -> Proxy x' x () a m () Source #
Repeat a monadic action a fixed number of times, yielding each result
replicateM  0      x = return ()
replicateM (m + n) x = replicateM m x >> replicateM n x  -- 0 <= {m,n}replicateM::Monadm => Int -> m a ->Producera m ()
unfoldr :: Monad m => (s -> m (Either r (a, s))) -> s -> Producer a m r Source #
The natural unfold into a Producer with a step function and a seed 
unfoldr next = id
Consumers
Feed a Consumer the same value repeatedly using (>~):
>>>runEffect $ lift getLine >~ P.stdoutLnTest<Enter> Test ABC<Enter> ABC ...
mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r Source #
Consume all values using a monadic function
drain :: forall (m :: Type -> Type) a r. Functor m => Consumer' a m r Source #
discard all incoming values
Pipes
Use (>->) to connect Producers, Pipes, and Consumers:
>>>runEffect $ P.stdinLn >-> P.takeWhile (/= "quit") >-> P.stdoutLnTest<Enter> Test ABC<Enter> ABC quit<Enter>>>>
map :: forall (m :: Type -> Type) a b r. Functor m => (a -> b) -> Pipe a b m r Source #
Apply a function to all values flowing downstream
map id = cat map (g . f) = map f >-> map g
mapM :: Monad m => (a -> m b) -> Pipe a b m r Source #
Apply a monadic function to all values flowing downstream
mapM return = cat mapM (f >=> g) = mapM f >-> mapM g
mapFoldable :: forall (m :: Type -> Type) t a b r. (Functor m, Foldable t) => (a -> t b) -> Pipe a b m r Source #
Apply a function to all values flowing downstream, and forward each element of the result.
filter :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a a m r Source #
(filter predicate) only forwards values that satisfy the predicate.
filter (pure True) = cat filter (liftA2 (&&) p1 p2) = filter p1 >-> filter p2 filter f = mapMaybe (\a -> a <$ guard (f a))
mapMaybe :: forall (m :: Type -> Type) a b r. Functor m => (a -> Maybe b) -> Pipe a b m r Source #
(mapMaybe f) yields Just results of f.
Basic laws:
mapMaybe (f >=> g) = mapMaybe f >-> mapMaybe g mapMaybe (pure @Maybe . f) = mapMaybe (Just . f) = map f mapMaybe (const Nothing) = drain
As a result of the second law,
mapMaybe return = mapMaybe Just = cat
filterM :: Monad m => (a -> m Bool) -> Pipe a a m r Source #
(filterM predicate) only forwards values that satisfy the monadic
    predicate
filterM (pure (pure True)) = cat filterM (liftA2 (liftA2 (&&)) p1 p2) = filterM p1 >-> filterM p2 filterM f = wither (\a -> (\b -> a <$ guard b) <$> f a)
wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r Source #
(wither f) forwards Just values produced by the
    monadic action.
Basic laws:
wither (runMaybeT . (MaybeT . f >=> MaybeT . g)) = wither f >-> wither g wither (runMaybeT . lift . f) = wither (fmap Just . f) = mapM f wither (pure . f) = mapMaybe f
As a result of the second law,
wither (runMaybeT . return) = cat
As a result of the third law,
wither (pure . const Nothing) = wither (const (pure Nothing)) = drain
take :: forall (m :: Type -> Type) a. Functor m => Int -> Pipe a a m () Source #
(take n) only allows n values to pass through
take 0 = return () take (m + n) = take m >> take n
take <infinity> = cat take (min m n) = take m >-> take n
takeWhile :: forall (m :: Type -> Type) a. Functor m => (a -> Bool) -> Pipe a a m () Source #
(takeWhile p) allows values to pass downstream so long as they satisfy
    the predicate p.
takeWhile (pure True) = cat takeWhile (liftA2 (&&) p1 p2) = takeWhile p1 >-> takeWhile p2
takeWhile' :: forall (m :: Type -> Type) a. Functor m => (a -> Bool) -> Pipe a a m a Source #
(takeWhile' p) is a version of takeWhile that returns the value failing
    the predicate.
takeWhile' (pure True) = cat takeWhile' (liftA2 (&&) p1 p2) = takeWhile' p1 >-> takeWhile' p2
drop :: forall (m :: Type -> Type) a r. Functor m => Int -> Pipe a a m r Source #
(drop n) discards n values going downstream
drop 0 = cat drop (m + n) = drop m >-> drop n
dropWhile :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a a m r Source #
(dropWhile p) discards values going downstream until one violates the
    predicate p.
dropWhile (pure False) = cat dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2
concat :: forall (m :: Type -> Type) f a r. (Functor m, Foldable f) => Pipe (f a) a m r Source #
Flatten all Foldable elements flowing downstream
elemIndices :: forall (m :: Type -> Type) a r. (Functor m, Eq a) => a -> Pipe a Int m r Source #
Outputs the indices of all elements that match the given element
findIndices :: forall (m :: Type -> Type) a r. Functor m => (a -> Bool) -> Pipe a Int m r Source #
Outputs the indices of all elements that satisfied the predicate
scan :: forall (m :: Type -> Type) x a b r. Functor m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r Source #
Strict left scan
Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r
scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r Source #
Strict, monadic left scan
Control.Foldl.impurely scanM :: Monad m => FoldM m a b -> Pipe a b m r
chain :: Monad m => (a -> m ()) -> Pipe a a m r Source #
Apply an action to all values flowing downstream
chain (pure (return ())) = cat chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2
read :: forall (m :: Type -> Type) a r. (Functor m, Read a) => Pipe String a m r Source #
Parse Readable values, only forwarding the value if the parse succeeds
seq :: forall (m :: Type -> Type) a r. Functor m => Pipe a a m r Source #
Evaluate all values flowing downstream to WHNF
ListT
Folds
Use these to fold the output of a Producer.  Many of these folds will stop
    drawing elements if they can compute their result early, like any:
>>>P.any Prelude.null P.stdinLnTest<Enter> ABC<Enter> <Enter> True>>>
fold :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b Source #
Strict fold of the elements of a Producer
Control.Foldl.purely fold :: Monad m => Fold a b -> Producer a m () -> m b
fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r) Source #
Strict fold of the elements of a Producer that preserves the return value
Control.Foldl.purely fold' :: Monad m => Fold a b -> Producer a m r -> m (b, r)
foldM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b Source #
Strict, monadic fold of the elements of a Producer
Control.Foldl.impurely foldM :: Monad m => FoldM a b -> Producer a m () -> m b
foldM' :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r) Source #
Strict, monadic fold of the elements of a Producer
Control.Foldl.impurely foldM' :: Monad m => FoldM a b -> Producer a m r -> m (b, r)
all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool Source #
(all predicate p) determines whether all the elements of p satisfy the
    predicate.
any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool Source #
(any predicate p) determines whether any element of p satisfies the
    predicate.
find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a) Source #
Find the first element of a Producer that satisfies the predicate
findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int) Source #
Find the index of the first element of a Producer that satisfies the
    predicate
head :: Monad m => Producer a m () -> m (Maybe a) Source #
Retrieve the first element from a Producer
maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a) Source #
Find the maximum element of a Producer
minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a) Source #
Find the minimum element of a Producer
sum :: (Monad m, Num a) => Producer a m () -> m a Source #
Compute the sum of the elements of a Producer
product :: (Monad m, Num a) => Producer a m () -> m a Source #
Compute the product of the elements of a Producer
Zips
zip :: forall (m :: Type -> Type) a r b x' x. Monad m => Producer a m r -> Producer b m r -> Proxy x' x () (a, b) m r Source #
Zip two Producers
zipWith :: forall (m :: Type -> Type) a b c r x' x. Monad m => (a -> b -> c) -> Producer a m r -> Producer b m r -> Proxy x' x () c m r Source #
Zip two Producers using the provided combining function