{-# LANGUAGE CPP #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE Trustworthy #-}
module Pipes (
Proxy
, X
, Effect
, Effect'
, runEffect
, Producer
, Producer'
, yield
, for
, (~>)
, (<~)
, Consumer
, Consumer'
, await
, (>~)
, (~<)
, Pipe
, cat
, (>->)
, (<-<)
, ListT(..)
, runListT
, Enumerable(..)
, next
, each
, every
, discard
, module Control.Monad
, module Control.Monad.IO.Class
, module Control.Monad.Trans.Class
, module Control.Monad.Morph
, Foldable
) where
import Control.Monad (void, MonadPlus(mzero, mplus))
import Control.Monad.Catch (MonadThrow(..), MonadCatch(..))
import Control.Monad.Except (MonadError(..))
import Control.Monad.Fail (MonadFail(..))
import Control.Monad.IO.Class (MonadIO(liftIO))
import Control.Monad.Reader (MonadReader(..))
import Control.Monad.State (MonadState(..))
import Control.Monad.Trans.Class (MonadTrans(lift))
import Control.Monad.Trans.Except (ExceptT, runExceptT)
import Control.Monad.Trans.Identity (IdentityT(runIdentityT))
import Control.Monad.Trans.Maybe (MaybeT(runMaybeT))
import Control.Monad.Writer (MonadWriter(..))
import Control.Monad.Zip (MonadZip(..))
import Pipes.Core
import Pipes.Internal (Proxy(..))
import qualified Data.Foldable as F
#if MIN_VERSION_base(4,8,0)
import Control.Applicative (Alternative(..))
#else
import Control.Applicative
import Data.Foldable (Foldable)
import Data.Traversable (Traversable(..))
#endif
import Data.Semigroup
import Control.Monad.Morph (MFunctor(hoist), MMonad(embed))
infixl 4 <~
infixr 4 ~>
infixl 5 ~<
infixr 5 >~
infixl 7 >->
infixr 7 <-<
yield :: Functor m => a -> Proxy x' x () a m ()
yield :: forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield = forall (m :: * -> *) a x' x a'.
Functor m =>
a -> Proxy x' x a' a m a'
respond
{-# INLINABLE [1] yield #-}
for :: 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 :: 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 = 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'
(//>)
{-# INLINABLE [0] for #-}
{-# RULES
"for (for p f) g" forall p f g . for (for p f) g = for p (\a -> for (f a) g)
; "for p yield" forall p . for p yield = p
; "for (yield x) f" forall x f . for (yield x) f = f x
; "for cat f" forall f .
for cat f =
let go = do
x <- await
f x
go
in go
; "f >~ (g >~ p)" forall f g p . f >~ (g >~ p) = (f >~ g) >~ p
; "await >~ p" forall p . await >~ p = p
; "p >~ await" forall p . p >~ await = p
; "m >~ cat" forall m .
m >~ cat =
let go = do
x <- m
yield x
go
in go
; "p1 >-> (p2 >-> p3)" forall p1 p2 p3 .
p1 >-> (p2 >-> p3) = (p1 >-> p2) >-> p3
; "p >-> cat" forall p . p >-> cat = p
; "cat >-> p" forall p . cat >-> p = p
#-}
(~>)
:: Functor m
=> (a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b')
-> (a -> Proxy x' x c' c m a')
~> :: forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
(~>) = forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
(/>/)
{-# INLINABLE (~>) #-}
(<~)
:: Functor m
=> (b -> Proxy x' x c' c m b')
-> (a -> Proxy x' x b' b m a')
-> (a -> Proxy x' x c' c m a')
b -> Proxy x' x c' c m b'
g <~ :: forall (m :: * -> *) b x' x c' c b' a a'.
Functor m =>
(b -> Proxy x' x c' c m b')
-> (a -> Proxy x' x b' b m a') -> a -> Proxy x' x c' c m a'
<~ a -> Proxy x' x b' b m a'
f = a -> Proxy x' x b' b m a'
f forall (m :: * -> *) a x' x b' b a' c' c.
Functor m =>
(a -> Proxy x' x b' b m a')
-> (b -> Proxy x' x c' c m b') -> a -> Proxy x' x c' c m a'
~> b -> Proxy x' x c' c m b'
g
{-# INLINABLE (<~) #-}
await :: Functor m => Consumer' a m a
await :: forall (m :: * -> *) a. Functor m => Consumer' a m a
await = forall (m :: * -> *) a' a y' y.
Functor m =>
a' -> Proxy a' a y' y m a
request ()
{-# INLINABLE [1] await #-}
(>~)
:: 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 y' y m b
p1 >~ :: 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 () b y' y m c
p2 = (\() -> Proxy a' a y' y m b
p1) 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
>\\ Proxy () b y' y m c
p2
{-# INLINABLE [1] (>~) #-}
(~<)
:: Functor m
=> Proxy () b y' y m c
-> Proxy a' a y' y m b
-> Proxy a' a y' y m c
Proxy () b y' y m c
p2 ~< :: forall (m :: * -> *) b y' y c a' a.
Functor m =>
Proxy () b y' y m c -> Proxy a' a y' y m b -> Proxy a' a y' y m c
~< Proxy a' a y' y m b
p1 = Proxy a' a y' y m b
p1 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 () b y' y m c
p2
{-# INLINABLE (~<) #-}
cat :: Functor m => Pipe a a m r
cat :: forall (m :: * -> *) a r. Functor m => Pipe a a m r
cat = forall (m :: * -> *) a' a r. Functor m => a' -> Proxy a' a a' a m r
pull ()
{-# INLINABLE [1] cat #-}
(>->)
:: Functor m
=> Proxy a' a () b m r
-> Proxy () b c' c m r
-> Proxy a' a c' c m r
Proxy a' a () b m r
p1 >-> :: 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 () b c' c m r
p2 = (\() -> Proxy a' a () b m r
p1) forall (m :: * -> *) b' a' a b r c' c.
Functor m =>
(b' -> Proxy a' a b' b m r)
-> Proxy b' b c' c m r -> Proxy a' a c' c m r
+>> Proxy () b c' c m r
p2
{-# INLINABLE [1] (>->) #-}
newtype ListT m a = Select { forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate :: Producer a m () }
instance Functor m => Functor (ListT m) where
fmap :: forall a b. (a -> b) -> ListT m a -> ListT m b
fmap a -> b
f ListT m a
p = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (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 (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
p) (\a
a -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> b
f a
a)))
{-# INLINE fmap #-}
instance Functor m => Applicative (ListT m) where
pure :: forall a. a -> ListT m a
pure a
a = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a)
{-# INLINE pure #-}
ListT m (a -> b)
mf <*> :: forall a b. ListT m (a -> b) -> ListT m a -> ListT m b
<*> ListT m a
mx = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (
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 (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m (a -> b)
mf) (\a -> b
f ->
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 (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
mx) (\a
x ->
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> b
f a
x) ) ) )
instance Monad m => Monad (ListT m) where
return :: forall a. a -> ListT m a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
{-# INLINE return #-}
ListT m a
m >>= :: forall a b. ListT m a -> (a -> ListT m b) -> ListT m b
>>= a -> ListT m b
f = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (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 (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
m) (\a
a -> forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (a -> ListT m b
f a
a)))
{-# INLINE (>>=) #-}
#if !MIN_VERSION_base(4,13,0)
fail _ = mzero
{-# INLINE fail #-}
#endif
instance Monad m => MonadFail (ListT m) where
fail :: forall a. String -> ListT m a
fail String
_ = forall (m :: * -> *) a. MonadPlus m => m a
mzero
{-# INLINE fail #-}
instance Foldable m => Foldable (ListT m) where
foldMap :: forall m a. Monoid m => (a -> m) -> ListT m a -> m
foldMap a -> m
f = forall {t :: * -> *} {a} {r}. Foldable t => Proxy X a () a t r -> m
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate
where
go :: Proxy X a () a t r -> m
go Proxy X a () a t r
p = case Proxy X a () a t r
p of
Request X
v a -> Proxy X a () a t r
_ -> forall a. X -> a
closed X
v
Respond a
a () -> Proxy X a () a t r
fu -> a -> m
f a
a forall a. Monoid a => a -> a -> a
`mappend` Proxy X a () a t r -> m
go (() -> Proxy X a () a t r
fu ())
M t (Proxy X a () a t r)
m -> forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
F.foldMap Proxy X a () a t r -> m
go t (Proxy X a () a t r)
m
Pure r
_ -> forall a. Monoid a => a
mempty
{-# INLINE foldMap #-}
instance (Functor m, Traversable m) => Traversable (ListT m) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ListT m a -> f (ListT m b)
traverse a -> f b
k (Select Producer a m ()
p) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall {m :: * -> *} {a} {r} {a'} {a} {b'}.
Traversable m =>
Proxy X a () a m r -> f (Proxy a' a b' b m r)
traverse_ Producer a m ()
p)
where
traverse_ :: Proxy X a () a m r -> f (Proxy a' a b' b m r)
traverse_ (Request X
v a -> Proxy X a () a m r
_ ) = forall a. X -> a
closed X
v
traverse_ (Respond a
a () -> Proxy X a () a m r
fu) = forall {b} {a'} {a} {b'} {m :: * -> *} {r}.
b -> Proxy a' a b' b m r -> Proxy a' a b' b m r
_Respond forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
k a
a forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Proxy X a () a m r -> f (Proxy a' a b' b m r)
traverse_ (() -> Proxy X a () a m r
fu ())
where
_Respond :: b -> Proxy a' a b' b m r -> Proxy a' a b' b m r
_Respond b
a_ Proxy a' a b' b m r
a' = forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Respond b
a_ (\b'
_ -> Proxy a' a b' b m r
a')
traverse_ (M m (Proxy X a () a m r)
m ) = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Proxy X a () a m r -> f (Proxy a' a b' b m r)
traverse_ m (Proxy X a () a m r)
m)
traverse_ (Pure r
r ) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure r
r)
instance MonadTrans ListT where
lift :: forall (m :: * -> *) a. Monad m => m a -> ListT m a
lift m a
m = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (do
a
a <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m a
m
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a )
instance (MonadIO m) => MonadIO (ListT m) where
liftIO :: forall a. IO a -> ListT m a
liftIO IO a
m = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO a
m)
{-# INLINE liftIO #-}
instance (Functor m) => Alternative (ListT m) where
empty :: forall a. ListT m a
empty = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINE empty #-}
ListT m a
p1 <|> :: forall a. ListT m a -> ListT m a -> ListT m a
<|> ListT m a
p2 = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (do
forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
p1
forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
p2 )
instance (Monad m) => MonadPlus (ListT m) where
mzero :: forall a. ListT m a
mzero = forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mzero #-}
mplus :: forall a. ListT m a -> ListT m a -> ListT m a
mplus = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
{-# INLINE mplus #-}
instance MFunctor ListT where
hoist :: forall (m :: * -> *) (n :: * -> *) b.
Monad m =>
(forall a. m a -> n a) -> ListT m b -> ListT n b
hoist forall a. m a -> n a
morph = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> n a
morph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate
{-# INLINE hoist #-}
instance MMonad ListT where
embed :: forall (n :: * -> *) (m :: * -> *) b.
Monad n =>
(forall a. m a -> ListT n a) -> ListT m b -> ListT n b
embed forall a. m a -> ListT n a
f (Select Producer b m ()
p0) = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall {b'} {b}. Proxy X () b' b m () -> Proxy X () b' b n ()
loop Producer b m ()
p0)
where
loop :: Proxy X () b' b m () -> Proxy X () b' b n ()
loop (Request X
a' () -> Proxy X () b' b m ()
fa ) = forall a' a b' b (m :: * -> *) r.
a' -> (a -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Request X
a' (\()
a -> Proxy X () b' b m () -> Proxy X () b' b n ()
loop (() -> Proxy X () b' b m ()
fa ()
a ))
loop (Respond b
b b' -> Proxy X () b' b m ()
fb') = forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Respond b
b (\b'
b' -> Proxy X () b' b m () -> Proxy X () b' b n ()
loop (b' -> Proxy X () b' b m ()
fb' b'
b'))
loop (M m (Proxy X () b' b m ())
m ) = 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 (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Proxy X () b' b m () -> Proxy X () b' b n ()
loop (forall a. m a -> ListT n a
f m (Proxy X () b' b m ())
m))) forall a. a -> a
id
loop (Pure ()
r ) = forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure ()
r
{-# INLINE embed #-}
instance (Functor m) => Semigroup (ListT m a) where
<> :: ListT m a -> ListT m a -> ListT m a
(<>) = forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
(<|>)
{-# INLINE (<>) #-}
instance (Functor m) => Monoid (ListT m a) where
mempty :: ListT m a
mempty = forall (f :: * -> *) a. Alternative f => f a
empty
{-# INLINE mempty #-}
#if !(MIN_VERSION_base(4,11,0))
mappend = (<|>)
{-# INLINE mappend #-}
#endif
instance (MonadState s m) => MonadState s (ListT m) where
get :: ListT m s
get = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall s (m :: * -> *). MonadState s m => m s
get
{-# INLINE get #-}
put :: s -> ListT m ()
put s
s = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *). MonadState s m => s -> m ()
put s
s)
{-# INLINE put #-}
state :: forall a. (s -> (a, s)) -> ListT m a
state s -> (a, s)
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall s (m :: * -> *) a. MonadState s m => (s -> (a, s)) -> m a
state s -> (a, s)
f)
{-# INLINE state #-}
instance (MonadWriter w m) => MonadWriter w (ListT m) where
writer :: forall a. (a, w) -> ListT m a
writer = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall w (m :: * -> *) a. MonadWriter w m => (a, w) -> m a
writer
{-# INLINE writer #-}
tell :: w -> ListT m ()
tell w
w = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell w
w)
{-# INLINE tell #-}
listen :: forall a. ListT m a -> ListT m (a, w)
listen ListT m a
l = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall {m :: * -> *} {a} {a'} {a} {b'} {a} {r}.
MonadWriter a m =>
Proxy a' a b' a m r -> a -> Proxy a' a b' (a, a) m r
go (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
l) forall a. Monoid a => a
mempty)
where
go :: Proxy a' a b' a m r -> a -> Proxy a' a b' (a, a) m r
go Proxy a' a b' a m r
p a
w = case Proxy a' a b' a m r
p of
Request a'
a' a -> Proxy a' a b' a m r
fa -> forall a' a b' b (m :: * -> *) r.
a' -> (a -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Request a'
a' (\a
a -> Proxy a' a b' a m r -> a -> Proxy a' a b' (a, a) m r
go (a -> Proxy a' a b' a m r
fa a
a ) a
w)
Respond a
b b' -> Proxy a' a b' a m r
fb' -> forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Respond (a
b, a
w) (\b'
b' -> Proxy a' a b' a m r -> a -> Proxy a' a b' (a, a) m r
go (b' -> Proxy a' a b' a m r
fb' b'
b') a
w)
M m (Proxy a' a b' a m r)
m -> forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (do
(Proxy a' a b' a m r
p', a
w') <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (Proxy a' a b' a m r)
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy a' a b' a m r -> a -> Proxy a' a b' (a, a) m r
go Proxy a' a b' a m r
p' forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend a
w a
w') )
Pure r
r -> forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure r
r
pass :: forall a. ListT m (a, w -> w) -> ListT m a
pass ListT m (a, w -> w)
l = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall {a} {m :: * -> *} {a'} {a} {b'} {b} {r}.
MonadWriter a m =>
Proxy a' a b' (b, a -> a) m r -> a -> Proxy a' a b' b m r
go (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m (a, w -> w)
l) forall a. Monoid a => a
mempty)
where
go :: Proxy a' a b' (b, a -> a) m r -> a -> Proxy a' a b' b m r
go Proxy a' a b' (b, a -> a) m r
p a
w = case Proxy a' a b' (b, a -> a) m r
p of
Request a'
a' a -> Proxy a' a b' (b, a -> a) m r
fa -> forall a' a b' b (m :: * -> *) r.
a' -> (a -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Request a'
a' (\a
a -> Proxy a' a b' (b, a -> a) m r -> a -> Proxy a' a b' b m r
go (a -> Proxy a' a b' (b, a -> a) m r
fa a
a ) a
w)
Respond (b
b, a -> a
f) b' -> Proxy a' a b' (b, a -> a) m r
fb' -> forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (forall w (m :: * -> *) a. MonadWriter w m => m (a, w -> w) -> m a
pass (forall (m :: * -> *) a. Monad m => a -> m a
return
(forall a' a b' b (m :: * -> *) r.
b -> (b' -> Proxy a' a b' b m r) -> Proxy a' a b' b m r
Respond b
b (\b'
b' -> Proxy a' a b' (b, a -> a) m r -> a -> Proxy a' a b' b m r
go (b' -> Proxy a' a b' (b, a -> a) m r
fb' b'
b') (a -> a
f a
w)), \a
_ -> a -> a
f a
w) ))
M m (Proxy a' a b' (b, a -> a) m r)
m -> forall a' a b' b (m :: * -> *) r.
m (Proxy a' a b' b m r) -> Proxy a' a b' b m r
M (do
(Proxy a' a b' (b, a -> a) m r
p', a
w') <- forall w (m :: * -> *) a. MonadWriter w m => m a -> m (a, w)
listen m (Proxy a' a b' (b, a -> a) m r)
m
forall (m :: * -> *) a. Monad m => a -> m a
return (Proxy a' a b' (b, a -> a) m r -> a -> Proxy a' a b' b m r
go Proxy a' a b' (b, a -> a) m r
p' forall a b. (a -> b) -> a -> b
$! forall a. Monoid a => a -> a -> a
mappend a
w a
w') )
Pure r
r -> forall a' a b' b (m :: * -> *) r. r -> Proxy a' a b' b m r
Pure r
r
instance (MonadReader i m) => MonadReader i (ListT m) where
ask :: ListT m i
ask = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall r (m :: * -> *). MonadReader r m => m r
ask
{-# INLINE ask #-}
local :: forall a. (i -> i) -> ListT m a -> ListT m a
local i -> i
f ListT m a
l = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local i -> i
f (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
l))
{-# INLINE local #-}
reader :: forall a. (i -> a) -> ListT m a
reader i -> a
f = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
reader i -> a
f)
{-# INLINE reader #-}
instance (MonadError e m) => MonadError e (ListT m) where
throwError :: forall a. e -> ListT m a
throwError e
e = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError e
e)
{-# INLINE throwError #-}
catchError :: forall a. ListT m a -> (e -> ListT m a) -> ListT m a
catchError ListT m a
l e -> ListT m a
k = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
l) (\e
e -> forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (e -> ListT m a
k e
e)))
{-# INLINE catchError #-}
instance MonadThrow m => MonadThrow (ListT m) where
throwM :: forall e a. Exception e => e -> ListT m a
throwM = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM
{-# INLINE throwM #-}
instance MonadCatch m => MonadCatch (ListT m) where
catch :: forall e a.
Exception e =>
ListT m a -> (e -> ListT m a) -> ListT m a
catch ListT m a
l e -> ListT m a
k = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select (forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
m a -> (e -> m a) -> m a
Control.Monad.Catch.catch (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
l) (\e
e -> forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (e -> ListT m a
k e
e)))
{-# INLINE catch #-}
instance Monad m => MonadZip (ListT m) where
mzipWith :: forall a b c. (a -> b -> c) -> ListT m a -> ListT m b -> ListT m c
mzipWith a -> b -> c
f = forall {m :: * -> *}.
Monad m =>
ListT m a -> ListT m b -> ListT m c
go
where
go :: ListT m a -> ListT m b -> ListT m c
go ListT m a
xs ListT m b
ys = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall a b. (a -> b) -> a -> b
$ do
Either () (a, Producer a m ())
xres <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m a
xs)
case Either () (a, Producer a m ())
xres of
Left ()
r -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
r
Right (a
x, Producer a m ()
xnext) -> do
Either () (b, Producer b m ())
yres <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate ListT m b
ys)
case Either () (b, Producer b m ())
yres of
Left ()
r -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
r
Right (b
y, Producer b m ()
ynext) -> do
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield (a -> b -> c
f a
x b
y)
forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (ListT m a -> ListT m b -> ListT m c
go (forall (m :: * -> *) a. Producer a m () -> ListT m a
Select Producer a m ()
xnext) (forall (m :: * -> *) a. Producer a m () -> ListT m a
Select Producer b m ()
ynext))
runListT :: Monad m => ListT m a -> m ()
runListT :: forall (m :: * -> *) a. Monad m => ListT m a -> m ()
runListT ListT m a
l = forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (forall (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (ListT m a
l forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. MonadPlus m => m a
mzero))
{-# INLINABLE runListT #-}
class Enumerable t where
toListT :: Monad m => t m a -> ListT m a
instance Enumerable ListT where
toListT :: forall (m :: * -> *) a. Monad m => ListT m a -> ListT m a
toListT = forall a. a -> a
id
instance Enumerable IdentityT where
toListT :: forall (m :: * -> *) a. Monad m => IdentityT m a -> ListT m a
toListT IdentityT m a
m = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall a b. (a -> b) -> a -> b
$ do
a
a <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT IdentityT m a
m
forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
instance Enumerable MaybeT where
toListT :: forall (m :: * -> *) a. Monad m => MaybeT m a -> ListT m a
toListT MaybeT m a
m = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall a b. (a -> b) -> a -> b
$ do
Maybe a
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT MaybeT m a
m
case Maybe a
x of
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
a -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
instance Enumerable (ExceptT e) where
toListT :: forall (m :: * -> *) a. Monad m => ExceptT e m a -> ListT m a
toListT ExceptT e m a
m = forall (m :: * -> *) a. Producer a m () -> ListT m a
Select forall a b. (a -> b) -> a -> b
$ do
Either e a
x <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT e m a
m
case Either e a
x of
Left e
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Right a
a -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a
next :: Monad m => Producer a m r -> m (Either r (a, Producer a m r))
next :: forall (m :: * -> *) a r.
Monad m =>
Producer a m r -> m (Either r (a, Producer a m r))
next = forall {m :: * -> *} {a} {a} {a}.
Monad m =>
Proxy X a () a m a -> m (Either a (a, Proxy X a () a m a))
go
where
go :: Proxy X a () a m a -> m (Either a (a, Proxy X a () a m a))
go Proxy X a () a m a
p = case Proxy X a () a m a
p of
Request X
v a -> Proxy X a () a m a
_ -> forall a. X -> a
closed X
v
Respond a
a () -> Proxy X a () a m a
fu -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right (a
a, () -> Proxy X a () a m a
fu ()))
M m (Proxy X a () a m a)
m -> m (Proxy X a () a m a)
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Proxy X a () a m a -> m (Either a (a, Proxy X a () a m a))
go
Pure a
r -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left a
r)
{-# INLINABLE next #-}
each :: (Functor m, Foldable f) => f a -> Proxy x' x () a m ()
each :: forall (m :: * -> *) (f :: * -> *) a x' x.
(Functor m, Foldable f) =>
f a -> Proxy x' x () a m ()
each = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
F.foldr (\a
a Proxy x' x () a m ()
p -> forall (m :: * -> *) a x' x. Functor m => a -> Proxy x' x () a m ()
yield a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Proxy x' x () a m ()
p) (forall (m :: * -> *) a. Monad m => a -> m a
return ())
{-# INLINABLE each #-}
every :: (Monad m, Enumerable t) => t m a -> Proxy x' x () a m ()
every :: forall (m :: * -> *) (t :: (* -> *) -> * -> *) a x' x.
(Monad m, Enumerable t) =>
t m a -> Proxy x' x () a m ()
every t m a
it = forall (m :: * -> *) a. Monad m => a -> m ()
discard 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 (m :: * -> *) a. ListT m a -> Producer a m ()
enumerate (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(Enumerable t, Monad m) =>
t m a -> ListT m a
toListT t m a
it)
{-# INLINABLE every #-}
discard :: Monad m => a -> m ()
discard :: forall (m :: * -> *) a. Monad m => a -> m ()
discard a
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
{-# INLINABLE discard #-}
(<-<)
:: Functor m
=> Proxy () b c' c m r
-> Proxy a' a () b m r
-> Proxy a' a c' c m r
Proxy () b c' c m r
p2 <-< :: forall (m :: * -> *) b c' c r a' a.
Functor m =>
Proxy () b c' c m r -> Proxy a' a () b m r -> Proxy a' a c' c m r
<-< Proxy a' a () b m r
p1 = Proxy a' a () b m r
p1 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 () b c' c m r
p2
{-# INLINABLE (<-<) #-}