{-| 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.
-}

{-# LANGUAGE RankNTypes, Trustworthy #-}
{-# OPTIONS_GHC -fno-warn-unused-do-bind #-}

module Pipes.Prelude (
    -- * Producers
    -- $producers
      stdinLn
    , readLn
    , fromHandle
    , repeatM
    , replicateM
    , unfoldr

    -- * Consumers
    -- $consumers
    , stdoutLn
    , stdoutLn'
    , mapM_
    , print
    , toHandle
    , drain

    -- * Pipes
    -- $pipes
    , map
    , mapM
    , sequence
    , mapFoldable
    , filter
    , mapMaybe
    , filterM
    , wither
    , take
    , takeWhile
    , takeWhile'
    , drop
    , dropWhile
    , concat
    , elemIndices
    , findIndices
    , scan
    , scanM
    , chain
    , read
    , show
    , seq

    -- *ListT
    , loop

    -- * Folds
    -- $folds
    , fold
    , fold'
    , foldM
    , foldM'
    , all
    , any
    , and
    , or
    , elem
    , notElem
    , find
    , findIndex
    , head
    , index
    , last
    , length
    , maximum
    , minimum
    , null
    , sum
    , product
    , toList
    , toListM
    , toListM'

    -- * Zips
    , zip
    , zipWith

    -- * Utilities
    , tee
    , generalize
    ) where

import Control.Exception (throwIO, try)
import Control.Monad (liftM, when, unless, (>=>))
import Control.Monad.Trans.State.Strict (get, put)
import Data.Functor.Identity (Identity, runIdentity)
import Foreign.C.Error (Errno(Errno), ePIPE)
import GHC.Exts (build)
import Pipes
import Pipes.Core
import Pipes.Internal
import Pipes.Lift (evalStateP)
import qualified GHC.IO.Exception as G
import qualified System.IO as IO
import qualified Prelude
import Prelude hiding (
      all
    , and
    , any
    , concat
    , drop
    , dropWhile
    , elem
    , filter
    , head
    , last
    , length
    , map
    , mapM
    , mapM_
    , maximum
    , minimum
    , notElem
    , null
    , or
    , print
    , product
    , read
    , readLn
    , sequence
    , show
    , seq
    , sum
    , take
    , takeWhile
    , zip
    , zipWith
    )

{- $producers
    Use 'for' loops to iterate over 'Producer's 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
...

-}

{-| Read 'String's from 'IO.stdin' using 'getLine'

    Terminates on end of input
-}
stdinLn :: MonadIO m => Producer' String m ()
stdinLn :: Producer' String m ()
stdinLn = Handle -> Proxy x' x () String m ()
forall (m :: * -> *) x' x.
MonadIO m =>
Handle -> Proxy x' x () String m ()
fromHandle Handle
IO.stdin
{-# INLINABLE stdinLn #-}

-- | 'read' values from 'IO.stdin', ignoring failed parses
readLn :: (MonadIO m, Read a) => Producer' a m ()
readLn :: Producer' a m ()
readLn = Proxy x' x () String m ()
forall (m :: * -> *). MonadIO m => Producer' String m ()
stdinLn Proxy x' x () String m ()
-> Proxy () String () a m () -> Proxy x' x () a m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Proxy () String () a m ()
forall (m :: * -> *) a r. (Functor m, Read a) => Pipe String a m r
read
{-# INLINABLE readLn #-}

{-| Read 'String's from a 'IO.Handle' using 'IO.hGetLine'

    Terminates on end of input

@
'fromHandle' :: 'MonadIO' m => 'IO.Handle' -> 'Producer' 'String' m ()
@
-}
fromHandle :: MonadIO m => IO.Handle -> Proxy x' x () String m ()
fromHandle :: Handle -> Proxy x' x () String m ()
fromHandle Handle
h = Proxy x' x () String m ()
forall x' x. Proxy x' x () String m ()
go
  where
    go :: Proxy x' x () String m ()
go = do
        Bool
eof <- IO Bool -> Proxy x' x () String m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> Proxy x' x () String m Bool)
-> IO Bool -> Proxy x' x () String m Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
IO.hIsEOF Handle
h
        Bool -> Proxy x' x () String m () -> Proxy x' x () String m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
eof (Proxy x' x () String m () -> Proxy x' x () String m ())
-> Proxy x' x () String m () -> Proxy x' x () String m ()
forall a b. (a -> b) -> a -> b
$ do
            String
str <- IO String -> Proxy x' x () String m String
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> Proxy x' x () String m String)
-> IO String -> Proxy x' x () String m String
forall a b. (a -> b) -> a -> b
$ Handle -> IO String
IO.hGetLine Handle
h
            String -> Proxy x' x () String m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield String
str
            Proxy x' x () String m ()
go
{-# INLINABLE fromHandle #-}

{-| Repeat a monadic action indefinitely, 'yield'ing each result

'repeatM' :: 'Monad' m => m a -> 'Producer' a m r
-}
repeatM :: Monad m => m a -> Proxy x' x () a m r
repeatM :: m a -> Proxy x' x () a m r
repeatM m a
m = m a -> Proxy x' x () a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m Proxy x' x () a m a -> Proxy () a () a m r -> Proxy x' x () a m r
forall (m :: * -> *) a' a y' y b c.
Functor m =>
Proxy a' a y' y m b -> Proxy () b y' y m c -> Proxy a' a y' y m c
>~ Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat
{-# INLINABLE [1] repeatM #-}

{-# RULES
  "repeatM m >-> p" forall m p . repeatM m >-> p = lift m >~ p
  #-}

{-| Repeat a monadic action a fixed number of times, 'yield'ing each result

> replicateM  0      x = return ()
>
> replicateM (m + n) x = replicateM m x >> replicateM n x  -- 0 <= {m,n}

@
'replicateM' :: 'Monad' m => Int -> m a -> 'Producer' a m ()
@
-}
replicateM :: Monad m => Int -> m a -> Proxy x' x () a m ()
replicateM :: Int -> m a -> Proxy x' x () a m ()
replicateM Int
n m a
m = m a -> Proxy x' x () a m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m Proxy x' x () a m a -> Proxy () a () a m () -> Proxy x' x () a m ()
forall (m :: * -> *) a' a y' y b c.
Functor m =>
Proxy a' a y' y m b -> Proxy () b y' y m c -> Proxy a' a y' y m c
>~ Int -> Proxy () a () a m ()
forall (m :: * -> *) a. Functor m => Int -> Pipe a a m ()
take Int
n
{-# INLINABLE replicateM #-}

{- $consumers
    Feed a 'Consumer' the same value repeatedly using ('>~'):

>>> runEffect $ lift getLine >~ P.stdoutLn
Test<Enter>
Test
ABC<Enter>
ABC
...

-}

{-| Write 'String's to 'IO.stdout' using 'putStrLn'

    Unlike 'toHandle', 'stdoutLn' gracefully terminates on a broken output pipe
-}
stdoutLn :: MonadIO m => Consumer' String m ()
stdoutLn :: Consumer' String m ()
stdoutLn = Proxy () String y' y m ()
Consumer' String m ()
go
  where
    go :: Proxy () String y' y m ()
go = do
        String
str <- Proxy () String y' y m String
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        Either IOException ()
x   <- IO (Either IOException ())
-> Proxy () String y' y m (Either IOException ())
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either IOException ())
 -> Proxy () String y' y m (Either IOException ()))
-> IO (Either IOException ())
-> Proxy () String y' y m (Either IOException ())
forall a b. (a -> b) -> a -> b
$ IO () -> IO (Either IOException ())
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ()
putStrLn String
str)
        case Either IOException ()
x of
           Left (G.IOError { ioe_type :: IOException -> IOErrorType
G.ioe_type  = IOErrorType
G.ResourceVanished
                           , ioe_errno :: IOException -> Maybe CInt
G.ioe_errno = Just CInt
ioe })
                | CInt -> Errno
Errno CInt
ioe Errno -> Errno -> Bool
forall a. Eq a => a -> a -> Bool
== Errno
ePIPE
                    -> () -> Proxy () String y' y m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
           Left  IOException
e  -> IO () -> Proxy () String y' y m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IOException -> IO ()
forall e a. Exception e => e -> IO a
throwIO IOException
e)
           Right () -> Proxy () String y' y m ()
go
{-# INLINABLE stdoutLn #-}

{-| Write 'String's to 'IO.stdout' using 'putStrLn'

    This does not handle a broken output pipe, but has a polymorphic return
    value
-}
stdoutLn' :: MonadIO m => Consumer' String m r
stdoutLn' :: Consumer' String m r
stdoutLn' = Proxy () String () String m r
-> (String -> Proxy () String y' y m ())
-> Proxy () String y' y m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () String () String m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\String
str -> IO () -> Proxy () String y' y m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
putStrLn String
str))
{-# INLINABLE [1] stdoutLn' #-}

{-# RULES
    "p >-> stdoutLn'" forall p .
        p >-> stdoutLn' = for p (\str -> liftIO (putStrLn str))
  #-}

-- | Consume all values using a monadic function
mapM_ :: Monad m => (a -> m ()) -> Consumer' a m r
mapM_ :: (a -> m ()) -> Consumer' a m r
mapM_ a -> m ()
f = Proxy () a () a m r
-> (a -> Proxy () a y' y m ()) -> Proxy () a y' y m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\a
a -> m () -> Proxy () a y' y m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m ()
f a
a))
{-# INLINABLE [1] mapM_ #-}

{-# RULES
    "p >-> mapM_ f" forall p f .
        p >-> mapM_ f = for p (\a -> lift (f a))
  #-}

-- | 'print' values to 'IO.stdout'
print :: (MonadIO m, Show a) => Consumer' a m r
print :: Consumer' a m r
print = Proxy () a () a m r
-> (a -> Proxy () a y' y m ()) -> Proxy () a y' y m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\a
a -> IO () -> Proxy () a y' y m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (a -> IO ()
forall a. Show a => a -> IO ()
Prelude.print a
a))
{-# INLINABLE [1] print #-}

{-# RULES
    "p >-> print" forall p .
        p >-> print = for p (\a -> liftIO (Prelude.print a))
  #-}

-- | Write 'String's to a 'IO.Handle' using 'IO.hPutStrLn'
toHandle :: MonadIO m => IO.Handle -> Consumer' String m r
toHandle :: Handle -> Consumer' String m r
toHandle Handle
handle = Proxy () String () String m r
-> (String -> Proxy () String y' y m ())
-> Proxy () String y' y m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () String () String m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\String
str -> IO () -> Proxy () String y' y m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Handle -> String -> IO ()
IO.hPutStrLn Handle
handle String
str))
{-# INLINABLE [1] toHandle #-}

{-# RULES
    "p >-> toHandle handle" forall p handle .
        p >-> toHandle handle = for p (\str -> liftIO (IO.hPutStrLn handle str))
  #-}

-- | 'discard' all incoming values
drain :: Functor m => Consumer' a m r
drain :: Consumer' a m r
drain = Proxy () a () a m r
-> (a -> Proxy () a y' y m ()) -> Proxy () a y' y m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat a -> Proxy () a y' y m ()
forall (m :: * -> *) a. Monad m => a -> m ()
discard
{-# INLINABLE [1] drain #-}

{-# RULES
    "p >-> drain" forall p .
        p >-> drain = for p discard
  #-}

{- $pipes
    Use ('>->') to connect 'Producer's, 'Pipe's, and 'Consumer's:

>>> runEffect $ P.stdinLn >-> P.takeWhile (/= "quit") >-> P.stdoutLn
Test<Enter>
Test
ABC<Enter>
ABC
quit<Enter>
>>>

-}

{-| Apply a function to all values flowing downstream

> map id = cat
>
> map (g . f) = map f >-> map g
-}
map :: Functor m => (a -> b) -> Pipe a b m r
map :: (a -> b) -> Pipe a b m r
map a -> b
f = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\a
a -> b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> b
f a
a))
{-# INLINABLE [1] map #-}

{-# RULES
    "p >-> map f" forall p f . p >-> map f = for p (\a -> yield (f a))

  ; "map f >-> p" forall p f . map f >-> p = (do
        a <- await
        return (f a) ) >~ p
  #-}

{-| Apply a monadic function to all values flowing downstream

> mapM return = cat
>
> mapM (f >=> g) = mapM f >-> mapM g
-}
mapM :: Monad m => (a -> m b) -> Pipe a b m r
mapM :: (a -> m b) -> Pipe a b m r
mapM a -> m b
f = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () b m ()) -> Pipe a b m r)
-> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    b
b <- m b -> Proxy () a () b m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m b
f a
a)
    b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield b
b
{-# INLINABLE [1] mapM #-}

{-# RULES
    "p >-> mapM f" forall p f . p >-> mapM f = for p (\a -> do
        b <- lift (f a)
        yield b )

  ; "mapM f >-> p" forall p f . mapM f >-> p = (do
        a <- await
        b <- lift (f a)
        return b ) >~ p
  #-}

-- | Convert a stream of actions to a stream of values
sequence :: Monad m => Pipe (m a) a m r
sequence :: Pipe (m a) a m r
sequence = (m a -> m a) -> Pipe (m a) a m r
forall (m :: * -> *) a b r. Monad m => (a -> m b) -> Pipe a b m r
mapM m a -> m a
forall a. a -> a
id
{-# INLINABLE sequence #-}

{- | Apply a function to all values flowing downstream, and
     forward each element of the result.
-}
mapFoldable :: (Functor m, Foldable t) => (a -> t b) -> Pipe a b m r
mapFoldable :: (a -> t b) -> Pipe a b m r
mapFoldable a -> t b
f = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (\a
a -> t b -> Proxy () a () b m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each (a -> t b
f a
a))
{-# INLINABLE [1] mapFoldable #-}

{-# RULES
    "p >-> mapFoldable f" forall p f .
        p >-> mapFoldable f = for p (\a -> each (f a))
  #-}

{-| @(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))
-}
filter :: Functor m => (a -> Bool) -> Pipe a a m r
filter :: (a -> Bool) -> Pipe a a m r
filter a -> Bool
predicate = Pipe a a m r -> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Pipe a a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () a m ()) -> Pipe a a m r)
-> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ \a
a -> Bool -> Proxy () a () a m () -> Proxy () a () a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
predicate a
a) (a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a)
{-# INLINABLE [1] filter #-}

{-# RULES
    "p >-> filter predicate" forall p predicate.
        p >-> filter predicate = for p (\a -> when (predicate a) (yield a))
  #-}

{-| @(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
-}
mapMaybe :: Functor m => (a -> Maybe b) -> Pipe a b m r
mapMaybe :: (a -> Maybe b) -> Pipe a b m r
mapMaybe a -> Maybe b
f = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () b m ()) -> Pipe a b m r)
-> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall a b. (a -> b) -> a -> b
$ Proxy () a () b m ()
-> (b -> Proxy () a () b m ()) -> Maybe b -> Proxy () a () b m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Proxy () a () b m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (Maybe b -> Proxy () a () b m ())
-> (a -> Maybe b) -> a -> Proxy () a () b m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
f
{-# INLINABLE [1] mapMaybe #-}

{-# RULES
    "p >-> mapMaybe f" forall p f.
        p >-> mapMaybe f = for p $ maybe (pure ()) yield . f
  #-}

{-| @(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)
-}
filterM :: Monad m => (a -> m Bool) -> Pipe a a m r
filterM :: (a -> m Bool) -> Pipe a a m r
filterM a -> m Bool
predicate = Pipe a a m r -> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Pipe a a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () a m ()) -> Pipe a a m r)
-> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    Bool
b <- m Bool -> Proxy () a () a m Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m Bool
predicate a
a)
    Bool -> Proxy () a () a m () -> Proxy () a () a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a)
{-# INLINABLE [1] filterM #-}

{-# RULES
    "p >-> filterM predicate" forall p predicate .
        p >-> filterM predicate = for p (\a -> do
            b <- lift (predicate a)
            when b (yield a) )
  #-}

{-| @(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
-}
wither :: Monad m => (a -> m (Maybe b)) -> Pipe a b m r
wither :: (a -> m (Maybe b)) -> Pipe a b m r
wither a -> m (Maybe b)
f = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () b m ()) -> Pipe a b m r)
-> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall a b. (a -> b) -> a -> b
$ m (Maybe b) -> Proxy () a () b m (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Maybe b) -> Proxy () a () b m (Maybe b))
-> (a -> m (Maybe b)) -> a -> Proxy () a () b m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m (Maybe b)
f (a -> Proxy () a () b m (Maybe b))
-> (Maybe b -> Proxy () a () b m ()) -> a -> Proxy () a () b m ()
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Proxy () a () b m ()
-> (b -> Proxy () a () b m ()) -> Maybe b -> Proxy () a () b m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Proxy () a () b m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield
{-# INLINABLE [1] wither #-}

{-# RULES
    "p >-> wither f" forall p f .
        p >-> wither f = for p $ lift . f >=> maybe (pure ()) yield
  #-}

{-| @(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
-}
take :: Functor m => Int -> Pipe a a m ()
take :: Int -> Pipe a a m ()
take = Int -> Pipe a a m ()
forall t (m :: * -> *) y.
(Eq t, Num t, Functor m) =>
t -> Proxy () y () y m ()
go
  where
    go :: t -> Proxy () y () y m ()
go t
0 = () -> Proxy () y () y m ()
forall (m :: * -> *) a. Monad m => a -> m a
return () 
    go t
n = do 
        y
a <- Proxy () y () y m y
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        y -> Proxy () y () y m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield y
a
        t -> Proxy () y () y m ()
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
{-# INLINABLE take #-}

{-| @(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 :: Functor m => (a -> Bool) -> Pipe a a m ()
takeWhile :: (a -> Bool) -> Pipe a a m ()
takeWhile a -> Bool
predicate = Pipe a a m ()
go
  where
    go :: Pipe a a m ()
go = do
        a
a <- Proxy () a () a m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        if (a -> Bool
predicate a
a)
            then do
                a -> Pipe a a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
                Pipe a a m ()
go
            else () -> Pipe a a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINABLE takeWhile #-}

{-| @(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
-}
takeWhile' :: Functor m => (a -> Bool) -> Pipe a a m a
takeWhile' :: (a -> Bool) -> Pipe a a m a
takeWhile' a -> Bool
predicate = Pipe a a m a
go
  where
    go :: Pipe a a m a
go = do
        a
a <- Pipe a a m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        if (a -> Bool
predicate a
a)
            then do
                a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
                Pipe a a m a
go
            else a -> Pipe a a m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
{-# INLINABLE takeWhile' #-}

{-| @(drop n)@ discards @n@ values going downstream

> drop 0 = cat
>
> drop (m + n) = drop m >-> drop n
-}
drop :: Functor m => Int -> Pipe a a m r
drop :: Int -> Pipe a a m r
drop = Int -> Pipe a a m r
forall t (m :: * -> *) a r.
(Eq t, Num t, Functor m) =>
t -> Proxy () a () a m r
go
  where
    go :: t -> Proxy () a () a m r
go t
0 = Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat
    go t
n =  do
        Proxy () a () a m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        t -> Proxy () a () a m r
go (t
nt -> t -> t
forall a. Num a => a -> a -> a
-t
1)
{-# INLINABLE drop #-}

{-| @(dropWhile p)@ discards values going downstream until one violates the
    predicate @p@.

> dropWhile (pure False) = cat
>
> dropWhile (liftA2 (||) p1 p2) = dropWhile p1 >-> dropWhile p2
-}
dropWhile :: Functor m => (a -> Bool) -> Pipe a a m r
dropWhile :: (a -> Bool) -> Pipe a a m r
dropWhile a -> Bool
predicate = Pipe a a m r
forall b. Proxy () a () a m b
go
  where
    go :: Proxy () a () a m b
go = do
        a
a <- Proxy () a () a m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        if (a -> Bool
predicate a
a)
            then Proxy () a () a m b
go
            else do
                a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
                Proxy () a () a m b
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat
{-# INLINABLE dropWhile #-}

-- | Flatten all 'Foldable' elements flowing downstream
concat :: (Functor m, Foldable f) => Pipe (f a) a m r
concat :: Pipe (f a) a m r
concat = Proxy () (f a) () (f a) m r
-> (f a -> Proxy () (f a) () a m ()) -> Pipe (f a) a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () (f a) () (f a) m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat f a -> Proxy () (f a) () a m ()
forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each
{-# INLINABLE [1] concat #-}

{-# RULES
    "p >-> concat" forall p . p >-> concat = for p each
  #-}

-- | Outputs the indices of all elements that match the given element
elemIndices :: (Functor m, Eq a) => a -> Pipe a Int m r
elemIndices :: a -> Pipe a Int m r
elemIndices a
a = (a -> Bool) -> Pipe a Int m r
forall (m :: * -> *) a r.
Functor m =>
(a -> Bool) -> Pipe a Int m r
findIndices (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elemIndices #-}

-- | Outputs the indices of all elements that satisfied the predicate
findIndices :: Functor m => (a -> Bool) -> Pipe a Int m r
findIndices :: (a -> Bool) -> Pipe a Int m r
findIndices a -> Bool
predicate = Int -> Pipe a Int m r
forall (m :: * -> *) a b.
(Functor m, Num a) =>
a -> Proxy () a () a m b
go Int
0
  where
    go :: a -> Proxy () a () a m b
go a
n = do
        a
a <- Proxy () a () a m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        Bool -> Proxy () a () a m () -> Proxy () a () a m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (a -> Bool
predicate a
a) (a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
n)
        a -> Proxy () a () a m b
go (a -> Proxy () a () a m b) -> a -> Proxy () a () a m b
forall a b. (a -> b) -> a -> b
$! a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
{-# INLINABLE findIndices #-}

{-| Strict left scan

> Control.Foldl.purely scan :: Monad m => Fold a b -> Pipe a b m r
-}
scan :: Functor m => (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
scan :: (x -> a -> x) -> x -> (x -> b) -> Pipe a b m r
scan x -> a -> x
step x
begin x -> b
done = x -> Pipe a b m r
forall (m :: * -> *) b. Functor m => x -> Proxy () a () b m b
go x
begin
  where
    go :: x -> Proxy () a () b m b
go x
x = do
        b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (x -> b
done x
x)
        a
a <- Proxy () a () b m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        let x' :: x
x' = x -> a -> x
step x
x a
a
        x -> Proxy () a () b m b
go (x -> Proxy () a () b m b) -> x -> Proxy () a () b m b
forall a b. (a -> b) -> a -> b
$! x
x'
{-# INLINABLE scan #-}

{-| Strict, monadic left scan

> Control.Foldl.impurely scanM :: Monad m => FoldM m a b -> Pipe a b m r
-}
scanM :: Monad m => (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r
scanM :: (x -> a -> m x) -> m x -> (x -> m b) -> Pipe a b m r
scanM x -> a -> m x
step m x
begin x -> m b
done = do
    x
x <- m x -> Proxy () a () b m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m x
begin
    x -> Pipe a b m r
forall b. x -> Proxy () a () b m b
go x
x
  where
    go :: x -> Proxy () a () b m b
go x
x = do
        b
b <- m b -> Proxy () a () b m b
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (x -> m b
done x
x)
        b -> Proxy () a () b m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield b
b
        a
a  <- Proxy () a () b m a
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        x
x' <- m x -> Proxy () a () b m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (x -> a -> m x
step x
x a
a)
        x -> Proxy () a () b m b
go (x -> Proxy () a () b m b) -> x -> Proxy () a () b m b
forall a b. (a -> b) -> a -> b
$! x
x'
{-# INLINABLE scanM #-}

{-| Apply an action to all values flowing downstream

> chain (pure (return ())) = cat
>
> chain (liftA2 (>>) m1 m2) = chain m1 >-> chain m2
-}
chain :: Monad m => (a -> m ()) -> Pipe a a m r
chain :: (a -> m ()) -> Pipe a a m r
chain a -> m ()
f = Pipe a a m r -> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Pipe a a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () a m ()) -> Pipe a a m r)
-> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    m () -> Proxy () a () a m ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> m ()
f a
a)
    a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
{-# INLINABLE [1] chain #-}

{-# RULES
    "p >-> chain f" forall p f .
        p >-> chain f = for p (\a -> do
            lift (f a)
            yield a )
  ; "chain f >-> p" forall p f .
        chain f >-> p = (do
            a <- await
            lift (f a)
            return a ) >~ p
  #-}

-- | Parse 'Read'able values, only forwarding the value if the parse succeeds
read :: (Functor m, Read a) => Pipe String a m r
read :: Pipe String a m r
read = Proxy () String () String m r
-> (String -> Proxy () String () a m ()) -> Pipe String a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () String () String m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((String -> Proxy () String () a m ()) -> Pipe String a m r)
-> (String -> Proxy () String () a m ()) -> Pipe String a m r
forall a b. (a -> b) -> a -> b
$ \String
str -> case (ReadS a
forall a. Read a => ReadS a
reads String
str) of
    [(a
a, String
"")] -> a -> Proxy () String () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
    [(a, String)]
_         -> () -> Proxy () String () a m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINABLE [1] read #-}

{-# RULES
    "p >-> read" forall p .
        p >-> read = for p (\str -> case (reads str) of
            [(a, "")] -> yield a
            _         -> return () )
  #-}

-- | Convert 'Show'able values to 'String's
show :: (Functor m, Show a) => Pipe a String m r
show :: Pipe a String m r
show = (a -> String) -> Pipe a String m r
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
map a -> String
forall a. Show a => a -> String
Prelude.show
{-# INLINABLE show #-}

-- | Evaluate all values flowing downstream to WHNF
seq :: Functor m => Pipe a a m r
seq :: Pipe a a m r
seq = Pipe a a m r -> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Pipe a a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat ((a -> Proxy () a () a m ()) -> Pipe a a m r)
-> (a -> Proxy () a () a m ()) -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ \a
a -> a -> Proxy () a () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> Proxy () a () a m ()) -> a -> Proxy () a () a m ()
forall a b. (a -> b) -> a -> b
$! a
a
{-# INLINABLE seq #-}

{-| Create a `Pipe` from a `ListT` transformation

> loop (k1 >=> k2) = loop k1 >-> loop k2
>
> loop return = cat
-}
loop :: Monad m => (a -> ListT m b) -> Pipe a b m r
loop :: (a -> ListT m b) -> Pipe a b m r
loop a -> ListT m b
k = Proxy () a () a m r -> (a -> Proxy () a () b m ()) -> Pipe a b m r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
for Proxy () a () a m r
forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat (ListT m b -> Proxy () a () b m ()
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a x' x.
(Monad m, Enumerable t) =>
t m a -> Proxy x' x () a m ()
every (ListT m b -> Proxy () a () b m ())
-> (a -> ListT m b) -> a -> Proxy () a () b m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ListT m b
k)
{-# INLINABLE loop #-}

{- $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.stdinLn
Test<Enter>
ABC<Enter>
<Enter>
True
>>>

-}

{-| 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 () -> m b
fold :: (x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold x -> a -> x
step x
begin x -> b
done Producer a m ()
p0 = Producer a m () -> x -> m b
forall (m :: * -> *) a r. Monad m => Proxy X a () a m r -> x -> m b
go Producer a m ()
p0 x
begin
  where
    go :: Proxy X a () a m r -> x -> m b
go Proxy X a () a m r
p x
x = case Proxy X a () a m r
p of
        Request X
v  a -> Proxy X a () a m r
_  -> X -> m b
forall a. X -> a
closed X
v
        Respond a
a  () -> Proxy X a () a m r
fu -> Proxy X a () a m r -> x -> m b
go (() -> Proxy X a () a m r
fu ()) (x -> m b) -> x -> m b
forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
        M          m (Proxy X a () a m r)
m  -> m (Proxy X a () a m r)
m m (Proxy X a () a m r) -> (Proxy X a () a m r -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Proxy X a () a m r
p' -> Proxy X a () a m r -> x -> m b
go Proxy X a () a m r
p' x
x
        Pure    r
_     -> b -> m b
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x)
{-# INLINABLE fold #-}

{-| 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)
-}
fold' :: Monad m => (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)
fold' :: (x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)
fold' x -> a -> x
step x
begin x -> b
done Producer a m r
p0 = Producer a m r -> x -> m (b, r)
forall (m :: * -> *) a b.
Monad m =>
Proxy X a () a m b -> x -> m (b, b)
go Producer a m r
p0 x
begin
  where
    go :: Proxy X a () a m b -> x -> m (b, b)
go Proxy X a () a m b
p x
x = case Proxy X a () a m b
p of
        Request X
v  a -> Proxy X a () a m b
_  -> X -> m (b, b)
forall a. X -> a
closed X
v
        Respond a
a  () -> Proxy X a () a m b
fu -> Proxy X a () a m b -> x -> m (b, b)
go (() -> Proxy X a () a m b
fu ()) (x -> m (b, b)) -> x -> m (b, b)
forall a b. (a -> b) -> a -> b
$! x -> a -> x
step x
x a
a
        M          m (Proxy X a () a m b)
m  -> m (Proxy X a () a m b)
m m (Proxy X a () a m b)
-> (Proxy X a () a m b -> m (b, b)) -> m (b, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Proxy X a () a m b
p' -> Proxy X a () a m b -> x -> m (b, b)
go Proxy X a () a m b
p' x
x
        Pure    b
r     -> (b, b) -> m (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (x -> b
done x
x, b
r)
{-# INLINABLE fold' #-}

{-| 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 () -> m b
foldM :: (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m () -> m b
foldM x -> a -> m x
step m x
begin x -> m b
done Producer a m ()
p0 = do
    x
x0 <- m x
begin
    Producer a m () -> x -> m b
forall a r. Proxy X a () a m r -> x -> m b
go Producer a m ()
p0 x
x0
  where
    go :: Proxy X a () a m r -> x -> m b
go Proxy X a () a m r
p x
x = case Proxy X a () a m r
p of
        Request X
v  a -> Proxy X a () a m r
_  -> X -> m b
forall a. X -> a
closed X
v
        Respond a
a  () -> Proxy X a () a m r
fu -> do
            x
x' <- x -> a -> m x
step x
x a
a
            Proxy X a () a m r -> x -> m b
go (() -> Proxy X a () a m r
fu ()) (x -> m b) -> x -> m b
forall a b. (a -> b) -> a -> b
$! x
x'
        M          m (Proxy X a () a m r)
m  -> m (Proxy X a () a m r)
m m (Proxy X a () a m r) -> (Proxy X a () a m r -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Proxy X a () a m r
p' -> Proxy X a () a m r -> x -> m b
go Proxy X a () a m r
p' x
x
        Pure    r
_     -> x -> m b
done x
x
{-# INLINABLE foldM #-}

{-| 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)
-}
foldM'
    :: Monad m
    => (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)
foldM' :: (x -> a -> m x) -> m x -> (x -> m b) -> Producer a m r -> m (b, r)
foldM' x -> a -> m x
step m x
begin x -> m b
done Producer a m r
p0 = do
    x
x0 <- m x
begin
    Producer a m r -> x -> m (b, r)
forall a b. Proxy X a () a m b -> x -> m (b, b)
go Producer a m r
p0 x
x0
  where
    go :: Proxy X a () a m b -> x -> m (b, b)
go Proxy X a () a m b
p x
x = case Proxy X a () a m b
p of
        Request X
v  a -> Proxy X a () a m b
_  -> X -> m (b, b)
forall a. X -> a
closed X
v
        Respond a
a  () -> Proxy X a () a m b
fu -> do
            x
x' <- x -> a -> m x
step x
x a
a
            Proxy X a () a m b -> x -> m (b, b)
go (() -> Proxy X a () a m b
fu ()) (x -> m (b, b)) -> x -> m (b, b)
forall a b. (a -> b) -> a -> b
$! x
x'
        M          m (Proxy X a () a m b)
m  -> m (Proxy X a () a m b)
m m (Proxy X a () a m b)
-> (Proxy X a () a m b -> m (b, b)) -> m (b, b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Proxy X a () a m b
p' -> Proxy X a () a m b -> x -> m (b, b)
go Proxy X a () a m b
p' x
x
        Pure    b
r     -> do
            b
b <- x -> m b
done x
x
            (b, b) -> m (b, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (b
b, b
r)
{-# INLINABLE foldM' #-}

{-| @(all predicate p)@ determines whether all the elements of @p@ satisfy the
    predicate.
-}
all :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
all :: (a -> Bool) -> Producer a m () -> m Bool
all a -> Bool
predicate Producer a m ()
p = Producer a m () -> m Bool
forall (m :: * -> *) a. Monad m => Producer a m () -> m Bool
null (Producer a m () -> m Bool) -> Producer a m () -> m Bool
forall a b. (a -> b) -> a -> b
$ Producer a m ()
p Producer a m () -> Proxy () a () a m () -> Producer a m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> Bool) -> Proxy () a () a m ()
forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
filter (\a
a -> Bool -> Bool
not (a -> Bool
predicate a
a))
{-# INLINABLE all #-}

{-| @(any predicate p)@ determines whether any element of @p@ satisfies the
    predicate.
-}
any :: Monad m => (a -> Bool) -> Producer a m () -> m Bool
any :: (a -> Bool) -> Producer a m () -> m Bool
any a -> Bool
predicate Producer a m ()
p = (Bool -> Bool) -> m Bool -> m Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Bool -> Bool
not (m Bool -> m Bool) -> m Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Producer a m () -> m Bool
forall (m :: * -> *) a. Monad m => Producer a m () -> m Bool
null (Producer a m ()
p Producer a m () -> Proxy () a () a m () -> Producer a m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> Bool) -> Proxy () a () a m ()
forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
filter a -> Bool
predicate)
{-# INLINABLE any #-}

-- | Determines whether all elements are 'True'
and :: Monad m => Producer Bool m () -> m Bool
and :: Producer Bool m () -> m Bool
and = (Bool -> Bool) -> Producer Bool m () -> m Bool
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Producer a m () -> m Bool
all Bool -> Bool
forall a. a -> a
id
{-# INLINABLE and #-}

-- | Determines whether any element is 'True'
or :: Monad m => Producer Bool m () -> m Bool
or :: Producer Bool m () -> m Bool
or = (Bool -> Bool) -> Producer Bool m () -> m Bool
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Producer a m () -> m Bool
any Bool -> Bool
forall a. a -> a
id
{-# INLINABLE or #-}

{-| @(elem a p)@ returns 'True' if @p@ has an element equal to @a@, 'False'
    otherwise
-}
elem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
elem :: a -> Producer a m () -> m Bool
elem a
a = (a -> Bool) -> Producer a m () -> m Bool
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Producer a m () -> m Bool
any (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
==)
{-# INLINABLE elem #-}

{-| @(notElem a)@ returns 'False' if @p@ has an element equal to @a@, 'True'
    otherwise
-}
notElem :: (Monad m, Eq a) => a -> Producer a m () -> m Bool
notElem :: a -> Producer a m () -> m Bool
notElem a
a = (a -> Bool) -> Producer a m () -> m Bool
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> Producer a m () -> m Bool
all (a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/=)
{-# INLINABLE notElem #-}

-- | Find the first element of a 'Producer' that satisfies the predicate
find :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe a)
find :: (a -> Bool) -> Producer a m () -> m (Maybe a)
find a -> Bool
predicate Producer a m ()
p = Producer a m () -> m (Maybe a)
forall (m :: * -> *) a. Monad m => Producer a m () -> m (Maybe a)
head (Producer a m ()
p Producer a m () -> Proxy () a () a m () -> Producer a m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> Bool) -> Proxy () a () a m ()
forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
filter a -> Bool
predicate)
{-# INLINABLE find #-}

{-| Find the index of the first element of a 'Producer' that satisfies the
    predicate
-}
findIndex :: Monad m => (a -> Bool) -> Producer a m () -> m (Maybe Int)
findIndex :: (a -> Bool) -> Producer a m () -> m (Maybe Int)
findIndex a -> Bool
predicate Producer a m ()
p = Producer Int m () -> m (Maybe Int)
forall (m :: * -> *) a. Monad m => Producer a m () -> m (Maybe a)
head (Producer a m ()
p Producer a m () -> Proxy () a () Int m () -> Producer Int m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (a -> Bool) -> Proxy () a () Int m ()
forall (m :: * -> *) a r.
Functor m =>
(a -> Bool) -> Pipe a Int m r
findIndices a -> Bool
predicate)
{-# INLINABLE findIndex #-}

-- | Retrieve the first element from a 'Producer'
head :: Monad m => Producer a m () -> m (Maybe a)
head :: Producer a m () -> m (Maybe a)
head Producer a m ()
p = do
    Either () (a, Producer a m ())
x <- Producer a m () -> m (Either () (a, Producer a m ()))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m ()
p
    Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case Either () (a, Producer a m ())
x of
        Left   ()
_     -> Maybe a
forall a. Maybe a
Nothing
        Right (a
a, Producer a m ()
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
{-# INLINABLE head #-}

-- | Index into a 'Producer'
index :: Monad m => Int -> Producer a m () -> m (Maybe a)
index :: Int -> Producer a m () -> m (Maybe a)
index Int
n Producer a m ()
p = Producer a m () -> m (Maybe a)
forall (m :: * -> *) a. Monad m => Producer a m () -> m (Maybe a)
head (Producer a m ()
p Producer a m () -> Proxy () a () a m () -> Producer a m ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> Int -> Proxy () a () a m ()
forall (m :: * -> *) a r. Functor m => Int -> Pipe a a m r
drop Int
n)
{-# INLINABLE index #-}

-- | Retrieve the last element from a 'Producer'
last :: Monad m => Producer a m () -> m (Maybe a)
last :: Producer a m () -> m (Maybe a)
last Producer a m ()
p0 = do
    Either () (a, Producer a m ())
x <- Producer a m () -> m (Either () (a, Producer a m ()))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m ()
p0
    case Either () (a, Producer a m ())
x of
        Left   ()
_      -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
        Right (a
a, Producer a m ()
p') -> a -> Producer a m () -> m (Maybe a)
forall (m :: * -> *) t r.
Monad m =>
t -> Producer t m r -> m (Maybe t)
go a
a Producer a m ()
p'
  where
    go :: t -> Producer t m r -> m (Maybe t)
go t
a Producer t m r
p = do
        Either r (t, Producer t m r)
x <- Producer t m r -> m (Either r (t, Producer t m r))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer t m r
p
        case Either r (t, Producer t m r)
x of
            Left   r
_       -> Maybe t -> m (Maybe t)
forall (m :: * -> *) a. Monad m => a -> m a
return (t -> Maybe t
forall a. a -> Maybe a
Just t
a)
            Right (t
a', Producer t m r
p') -> t -> Producer t m r -> m (Maybe t)
go t
a' Producer t m r
p'
{-# INLINABLE last #-}

-- | Count the number of elements in a 'Producer'
length :: Monad m => Producer a m () -> m Int
length :: Producer a m () -> m Int
length = (Int -> a -> Int)
-> Int -> (Int -> Int) -> Producer a m () -> m Int
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold (\Int
n a
_ -> Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int
0 Int -> Int
forall a. a -> a
id
{-# INLINABLE length #-}

-- | Find the maximum element of a 'Producer'
maximum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
maximum :: Producer a m () -> m (Maybe a)
maximum = (Maybe a -> a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Producer a m ()
-> m (Maybe a)
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold Maybe a -> a -> Maybe a
forall a. Ord a => Maybe a -> a -> Maybe a
step Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id
  where
    step :: Maybe a -> a -> Maybe a
step Maybe a
x a
a = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ case Maybe a
x of
        Maybe a
Nothing -> a
a
        Just a
a' -> a -> a -> a
forall a. Ord a => a -> a -> a
max a
a a
a'
{-# INLINABLE maximum #-}

-- | Find the minimum element of a 'Producer'
minimum :: (Monad m, Ord a) => Producer a m () -> m (Maybe a)
minimum :: Producer a m () -> m (Maybe a)
minimum = (Maybe a -> a -> Maybe a)
-> Maybe a
-> (Maybe a -> Maybe a)
-> Producer a m ()
-> m (Maybe a)
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold Maybe a -> a -> Maybe a
forall a. Ord a => Maybe a -> a -> Maybe a
step Maybe a
forall a. Maybe a
Nothing Maybe a -> Maybe a
forall a. a -> a
id
  where
    step :: Maybe a -> a -> Maybe a
step Maybe a
x a
a = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> a -> Maybe a
forall a b. (a -> b) -> a -> b
$ case Maybe a
x of
        Maybe a
Nothing -> a
a
        Just a
a' -> a -> a -> a
forall a. Ord a => a -> a -> a
min a
a a
a'
{-# INLINABLE minimum #-}

-- | Determine if a 'Producer' is empty
null :: Monad m => Producer a m () -> m Bool
null :: Producer a m () -> m Bool
null Producer a m ()
p = do
    Either () (a, Producer a m ())
x <- Producer a m () -> m (Either () (a, Producer a m ()))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m ()
p
    Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ case Either () (a, Producer a m ())
x of
        Left  ()
_ -> Bool
True
        Right (a, Producer a m ())
_ -> Bool
False
{-# INLINABLE null #-}

-- | Compute the sum of the elements of a 'Producer'
sum :: (Monad m, Num a) => Producer a m () -> m a
sum :: Producer a m () -> m a
sum = (a -> a -> a) -> a -> (a -> a) -> Producer a m () -> m a
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0 a -> a
forall a. a -> a
id
{-# INLINABLE sum #-}

-- | Compute the product of the elements of a 'Producer'
product :: (Monad m, Num a) => Producer a m () -> m a
product :: Producer a m () -> m a
product = (a -> a -> a) -> a -> (a -> a) -> Producer a m () -> m a
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold a -> a -> a
forall a. Num a => a -> a -> a
(*) a
1 a -> a
forall a. a -> a
id
{-# INLINABLE product #-}

-- | Convert a pure 'Producer' into a list
toList :: Producer a Identity () -> [a]
toList :: Producer a Identity () -> [a]
toList Producer a Identity ()
prod0 = (forall b. (a -> b -> b) -> b -> b) -> [a]
forall a. (forall b. (a -> b -> b) -> b -> b) -> [a]
build (Producer a Identity () -> (a -> b -> b) -> b -> b
forall a t r p.
Proxy X a () t Identity r -> (t -> p -> p) -> p -> p
go Producer a Identity ()
prod0)
  where
    go :: Proxy X a () t Identity r -> (t -> p -> p) -> p -> p
go Proxy X a () t Identity r
prod t -> p -> p
cons p
nil =
      case Proxy X a () t Identity r
prod of
        Request X
v a -> Proxy X a () t Identity r
_  -> X -> p
forall a. X -> a
closed X
v
        Respond t
a () -> Proxy X a () t Identity r
fu -> t -> p -> p
cons t
a (Proxy X a () t Identity r -> (t -> p -> p) -> p -> p
go (() -> Proxy X a () t Identity r
fu ()) t -> p -> p
cons p
nil)
        M         Identity (Proxy X a () t Identity r)
m  -> Proxy X a () t Identity r -> (t -> p -> p) -> p -> p
go (Identity (Proxy X a () t Identity r) -> Proxy X a () t Identity r
forall a. Identity a -> a
runIdentity Identity (Proxy X a () t Identity r)
m) t -> p -> p
cons p
nil
        Pure    r
_    -> p
nil
{-# INLINE toList #-}

{-| Convert an effectful 'Producer' into a list

    Note: 'toListM' is not an idiomatic use of @pipes@, but I provide it for
    simple testing purposes.  Idiomatic @pipes@ style consumes the elements
    immediately as they are generated instead of loading all elements into
    memory.
-}
toListM :: Monad m => Producer a m () -> m [a]
toListM :: Producer a m () -> m [a]
toListM = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Producer a m ()
-> m [a]
forall (m :: * -> *) x a b.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m () -> m b
fold ([a] -> [a]) -> a -> [a] -> [a]
forall a c. ([a] -> c) -> a -> [a] -> c
step [a] -> [a]
forall a. a -> a
begin ([a] -> [a]) -> [a]
forall a t. ([a] -> t) -> t
done
  where
    step :: ([a] -> c) -> a -> [a] -> c
step [a] -> c
x a
a = [a] -> c
x ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
    begin :: a -> a
begin = a -> a
forall a. a -> a
id
    done :: ([a] -> t) -> t
done [a] -> t
x = [a] -> t
x []
{-# INLINABLE toListM #-}

{-| Convert an effectful 'Producer' into a list alongside the return value

    Note: 'toListM'' is not an idiomatic use of @pipes@, but I provide it for
    simple testing purposes.  Idiomatic @pipes@ style consumes the elements
    immediately as they are generated instead of loading all elements into
    memory.
-}
toListM' :: Monad m => Producer a m r -> m ([a], r)
toListM' :: Producer a m r -> m ([a], r)
toListM' = (([a] -> [a]) -> a -> [a] -> [a])
-> ([a] -> [a])
-> (([a] -> [a]) -> [a])
-> Producer a m r
-> m ([a], r)
forall (m :: * -> *) x a b r.
Monad m =>
(x -> a -> x) -> x -> (x -> b) -> Producer a m r -> m (b, r)
fold' ([a] -> [a]) -> a -> [a] -> [a]
forall a c. ([a] -> c) -> a -> [a] -> c
step [a] -> [a]
forall a. a -> a
begin ([a] -> [a]) -> [a]
forall a t. ([a] -> t) -> t
done
  where
    step :: ([a] -> c) -> a -> [a] -> c
step [a] -> c
x a
a = [a] -> c
x ([a] -> c) -> ([a] -> [a]) -> [a] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a
aa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)
    begin :: a -> a
begin = a -> a
forall a. a -> a
id
    done :: ([a] -> t) -> t
done [a] -> t
x = [a] -> t
x []
{-# INLINABLE toListM' #-}

-- | Zip two 'Producer's
zip :: Monad m
    => (Producer       a     m r)
    -> (Producer          b  m r)
    -> (Proxy x' x () (a, b) m r)
zip :: Producer a m r -> Producer b m r -> Proxy x' x () (a, b) m r
zip = (a -> b -> (a, b))
-> Producer a m r -> Producer b m r -> Proxy x' x () (a, b) m r
forall (m :: * -> *) 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
zipWith (,)
{-# INLINABLE zip #-}

-- | Zip two 'Producer's using the provided combining function
zipWith :: Monad m
    => (a -> b -> c)
    -> (Producer  a m r)
    -> (Producer  b m r)
    -> (Proxy x' x () c m r)
zipWith :: (a -> b -> c)
-> Producer a m r -> Producer b m r -> Proxy x' x () c m r
zipWith a -> b -> c
f = Producer a m r -> Producer b m r -> Proxy x' x () c m r
forall (m :: * -> *) b x' x.
Monad m =>
Producer a m b -> Producer b m b -> Proxy x' x () c m b
go
  where
    go :: Producer a m b -> Producer b m b -> Proxy x' x () c m b
go Producer a m b
p1 Producer b m b
p2 = do
        Either b (a, Producer a m b)
e1 <- m (Either b (a, Producer a m b))
-> Proxy x' x () c m (Either b (a, Producer a m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either b (a, Producer a m b))
 -> Proxy x' x () c m (Either b (a, Producer a m b)))
-> m (Either b (a, Producer a m b))
-> Proxy x' x () c m (Either b (a, Producer a m b))
forall a b. (a -> b) -> a -> b
$ Producer a m b -> m (Either b (a, Producer a m b))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer a m b
p1
        case Either b (a, Producer a m b)
e1 of
            Left b
r         -> b -> Proxy x' x () c m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
            Right (a
a, Producer a m b
p1') -> do
                Either b (b, Producer b m b)
e2 <- m (Either b (b, Producer b m b))
-> Proxy x' x () c m (Either b (b, Producer b m b))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m (Either b (b, Producer b m b))
 -> Proxy x' x () c m (Either b (b, Producer b m b)))
-> m (Either b (b, Producer b m b))
-> Proxy x' x () c m (Either b (b, Producer b m b))
forall a b. (a -> b) -> a -> b
$ Producer b m b -> m (Either b (b, Producer b m b))
forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next Producer b m b
p2
                case Either b (b, Producer b m b)
e2 of
                    Left b
r         -> b -> Proxy x' x () c m b
forall (m :: * -> *) a. Monad m => a -> m a
return b
r
                    Right (b
b, Producer b m b
p2') -> do
                        c -> Proxy x' x () c m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> b -> c
f a
a b
b)
                        Producer a m b -> Producer b m b -> Proxy x' x () c m b
go Producer a m b
p1' Producer b m b
p2'
{-# INLINABLE zipWith #-}

{-| Transform a 'Consumer' to a 'Pipe' that reforwards all values further
    downstream
-}
tee :: Monad m => Consumer a m r -> Pipe a a m r
tee :: Consumer a m r -> Pipe a a m r
tee Consumer a m r
p = Maybe a -> Proxy () a () a (StateT (Maybe a) m) r -> Pipe a a m r
forall (m :: * -> *) s a' a b' b r.
Monad m =>
s -> Proxy a' a b' b (StateT s m) r -> Proxy a' a b' b m r
evalStateP Maybe a
forall a. Maybe a
Nothing (Proxy () a () a (StateT (Maybe a) m) r -> Pipe a a m r)
-> Proxy () a () a (StateT (Maybe a) m) r -> Pipe a a m r
forall a b. (a -> b) -> a -> b
$ do
    r
r <- () -> Proxy () a () a (StateT (Maybe a) m) a
forall (m :: * -> *) b.
Monad m =>
() -> Proxy () b () b (StateT (Maybe b) m) b
up (() -> Proxy () a () a (StateT (Maybe a) m) a)
-> Proxy () a () a (StateT (Maybe a) m) r
-> Proxy () a () a (StateT (Maybe a) m) r
forall (m :: * -> *) b' a' a y' y b c.
Functor m =>
(b' -> Proxy a' a y' y m b)
-> Proxy b' b y' y m c -> Proxy a' a y' y m c
>\\ ((forall a. m a -> StateT (Maybe a) m a)
-> Consumer a m r -> Proxy () a () X (StateT (Maybe a) m) r
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> StateT (Maybe a) m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Consumer a m r
p Proxy () a () X (StateT (Maybe a) m) r
-> (X -> Proxy () a () a (StateT (Maybe a) m) ())
-> Proxy () a () a (StateT (Maybe a) m) r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
//> X -> Proxy () a () a (StateT (Maybe a) m) ()
forall a. X -> a
dn)
    Maybe a
ma <- StateT (Maybe a) m (Maybe a)
-> Proxy () a () a (StateT (Maybe a) m) (Maybe a)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Maybe a) m (Maybe a)
forall (m :: * -> *) s. Monad m => StateT s m s
get
    case Maybe a
ma of
        Maybe a
Nothing -> () -> Proxy () a () a (StateT (Maybe a) m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just a
a  -> a -> Proxy () a () a (StateT (Maybe a) m) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
    r -> Proxy () a () a (StateT (Maybe a) m) r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
  where
    up :: () -> Proxy () b () b (StateT (Maybe b) m) b
up () = do
        Maybe b
ma <- StateT (Maybe b) m (Maybe b)
-> Proxy () b () b (StateT (Maybe b) m) (Maybe b)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT (Maybe b) m (Maybe b)
forall (m :: * -> *) s. Monad m => StateT s m s
get
        case Maybe b
ma of
            Maybe b
Nothing -> () -> Proxy () b () b (StateT (Maybe b) m) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just b
a  -> b -> Proxy () b () b (StateT (Maybe b) m) ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield b
a
        b
a <- Proxy () b () b (StateT (Maybe b) m) b
forall (m :: * -> *) a. Functor m => Consumer' a m a
await
        StateT (Maybe b) m () -> Proxy () b () b (StateT (Maybe b) m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT (Maybe b) m () -> Proxy () b () b (StateT (Maybe b) m) ())
-> StateT (Maybe b) m () -> Proxy () b () b (StateT (Maybe b) m) ()
forall a b. (a -> b) -> a -> b
$ Maybe b -> StateT (Maybe b) m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (b -> Maybe b
forall a. a -> Maybe a
Just b
a)
        b -> Proxy () b () b (StateT (Maybe b) m) b
forall (m :: * -> *) a. Monad m => a -> m a
return b
a
    dn :: X -> a
dn X
v = X -> a
forall a. X -> a
closed X
v
{-# INLINABLE tee #-}

{-| Transform a unidirectional 'Pipe' to a bidirectional 'Proxy'

> generalize (f >-> g) = generalize f >+> generalize g
>
> generalize cat = pull
-}
generalize :: Monad m => Pipe a b m r -> x -> Proxy x a x b m r
generalize :: Pipe a b m r -> x -> Proxy x a x b m r
generalize Pipe a b m r
p x
x0 = x -> Proxy x a x b (StateT x m) r -> Proxy x a x b m r
forall (m :: * -> *) s a' a b' b r.
Monad m =>
s -> Proxy a' a b' b (StateT s m) r -> Proxy a' a b' b m r
evalStateP x
x0 (Proxy x a x b (StateT x m) r -> Proxy x a x b m r)
-> Proxy x a x b (StateT x m) r -> Proxy x a x b m r
forall a b. (a -> b) -> a -> b
$ () -> Proxy x a () b (StateT x m) a
forall (m :: * -> *) a' b y' y.
Monad m =>
() -> Proxy a' b y' y (StateT a' m) b
up (() -> Proxy x a () b (StateT x m) a)
-> Proxy () a () b (StateT x m) r -> Proxy x a () b (StateT x m) r
forall (m :: * -> *) b' a' a y' y b c.
Functor m =>
(b' -> Proxy a' a y' y m b)
-> Proxy b' b y' y m c -> Proxy a' a y' y m c
>\\ (forall a. m a -> StateT x m a)
-> Pipe a b m r -> Proxy () a () b (StateT x m) r
forall k (t :: (* -> *) -> k -> *) (m :: * -> *) (n :: * -> *)
       (b :: k).
(MFunctor t, Monad m) =>
(forall a. m a -> n a) -> t m b -> t n b
hoist forall a. m a -> StateT x m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Pipe a b m r
p Proxy x a () b (StateT x m) r
-> (b -> Proxy x a x b (StateT x m) ())
-> Proxy x a x b (StateT x m) r
forall (m :: * -> *) x' x b' b a' c' c.
Functor m =>
Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b') -> Proxy x' x c' c m a'
//> b -> Proxy x a x b (StateT x m) ()
forall (m :: * -> *) a x' x s.
Monad m =>
a -> Proxy x' x s a (StateT s m) ()
dn
  where
    up :: () -> Proxy a' b y' y (StateT a' m) b
up () = do
        a'
x <- StateT a' m a' -> Proxy a' b y' y (StateT a' m) a'
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift StateT a' m a'
forall (m :: * -> *) s. Monad m => StateT s m s
get
        a' -> Proxy a' b y' y (StateT a' m) b
forall (m :: * -> *) a' a y' y.
Functor m =>
a' -> Proxy a' a y' y m a
request a'
x
    dn :: a -> Proxy x' x s a (StateT s m) ()
dn a
a = do
        s
x <- a -> Proxy x' x s a (StateT s m) s
forall (m :: * -> *) a x' x a'.
Functor m =>
a -> Proxy x' x a' a m a'
respond a
a
        StateT s m () -> Proxy x' x s a (StateT s m) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (StateT s m () -> Proxy x' x s a (StateT s m) ())
-> StateT s m () -> Proxy x' x s a (StateT s m) ()
forall a b. (a -> b) -> a -> b
$ s -> StateT s m ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put s
x
{-# INLINABLE generalize #-}

{-| The natural unfold into a 'Producer' with a step function and a seed 

> unfoldr next = id
-}
unfoldr :: Monad m 
        => (s -> m (Either r (a, s))) -> s -> Producer a m r
unfoldr :: (s -> m (Either r (a, s))) -> s -> Producer a m r
unfoldr s -> m (Either r (a, s))
step = s -> Producer a m r
forall x' x. s -> Proxy x' x () a m r
go where
  go :: s -> Proxy x' x () a m r
go s
s0 = do
    Either r (a, s)
e <- m (Either r (a, s)) -> Proxy x' x () a m (Either r (a, s))
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (s -> m (Either r (a, s))
step s
s0)
    case Either r (a, s)
e of
      Left r
r -> r -> Proxy x' x () a m r
forall (m :: * -> *) a. Monad m => a -> m a
return r
r
      Right (a
a,s
s) -> do 
        a -> Proxy x' x () a m ()
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
        s -> Proxy x' x () a m r
go s
s
{-# INLINABLE unfoldr #-}