{-# LANGUAGE RankNTypes, Trustworthy #-}
module Pipes.Core (
Proxy
, runEffect
, respond
, (/>/)
, (//>)
, request
, (\>\)
, (>\\)
, push
, (>~>)
, (>>~)
, pull
, (>+>)
, (+>>)
, reflect
, X
, Effect
, Producer
, Pipe
, Consumer
, Client
, Server
, Effect'
, Producer'
, Consumer'
, Client'
, Server'
, (\<\)
, (/</)
, (<~<)
, (~<<)
, (<+<)
, (<\\)
, (//<)
, (<<+)
, closed
) where
import Pipes.Internal (Proxy(..), X, closed)
runEffect :: Monad m => Effect m r -> m r
runEffect = go
where
go p = case p of
Request v _ -> closed v
Respond v _ -> closed v
M m -> m >>= go
Pure r -> return r
infixl 3 //>
infixr 3 <\\
infixr 4 />/, >\\
infixl 4 \<\, //<
infixl 5 \>\
infixr 5 /</
infixl 6 <<+
infixr 6 +>>
infixl 7 >+>, >>~
infixr 7 <+<, ~<<
infixl 8 <~<
infixr 8 >~>
respond :: Monad m => a -> Proxy x' x a' a m a'
respond a = Respond a Pure
(/>/)
:: Monad 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')
(fa />/ fb) a = fa a //> fb
(//>)
:: Monad m
=> Proxy x' x b' b m a'
-> (b -> Proxy x' x c' c m b')
-> Proxy x' x c' c m a'
p0 //> fb = go p0
where
go p = case p of
Request x' fx -> Request x' (\x -> go (fx x))
Respond b fb' -> fb b >>= \b' -> go (fb' b')
M m -> M (m >>= \p' -> return (go p'))
Pure a -> Pure a
{-# RULES
"(Request x' fx ) //> fb" forall x' fx fb .
(Request x' fx ) //> fb = Request x' (\x -> fx x //> fb);
"(Respond b fb') //> fb" forall b fb' fb .
(Respond b fb') //> fb = fb b >>= \b' -> fb' b' //> fb;
"(M m ) //> fb" forall m fb .
(M m ) //> fb = M (m >>= \p' -> return (p' //> fb));
"(Pure a ) //> fb" forall a fb .
(Pure a ) //> fb = Pure a;
#-}
request :: Monad m => a' -> Proxy a' a y' y m a
request a' = Request a' Pure
(\>\)
:: Monad m
=> (b' -> Proxy a' a y' y m b)
-> (c' -> Proxy b' b y' y m c)
-> (c' -> Proxy a' a y' y m c)
(fb' \>\ fc') c' = fb' >\\ fc' c'
(>\\)
:: Monad m
=> (b' -> Proxy a' a y' y m b)
-> Proxy b' b y' y m c
-> Proxy a' a y' y m c
fb' >\\ p0 = go p0
where
go p = case p of
Request b' fb -> fb' b' >>= \b -> go (fb b)
Respond x fx' -> Respond x (\x' -> go (fx' x'))
M m -> M (m >>= \p' -> return (go p'))
Pure a -> Pure a
{-# RULES
"fb' >\\ (Request b' fb )" forall fb' b' fb .
fb' >\\ (Request b' fb ) = fb' b' >>= \b -> fb' >\\ fb b;
"fb' >\\ (Respond x fx')" forall fb' x fx' .
fb' >\\ (Respond x fx') = Respond x (\x' -> fb' >\\ fx' x');
"fb' >\\ (M m )" forall fb' m .
fb' >\\ (M m ) = M (m >>= \p' -> return (fb' >\\ p'));
"fb' >\\ (Pure a )" forall fb' a .
fb' >\\ (Pure a ) = Pure a;
#-}
push :: Monad m => a -> Proxy a' a a' a m r
push = go
where
go a = Respond a (\a' -> Request a' go)
(>~>)
:: Monad m
=> (_a -> Proxy a' a b' b m r)
-> ( b -> Proxy b' b c' c m r)
-> (_a -> Proxy a' a c' c m r)
(fa >~> fb) a = fa a >>~ fb
(>>~)
:: Monad m
=> Proxy a' a b' b m r
-> (b -> Proxy b' b c' c m r)
-> Proxy a' a c' c m r
p >>~ fb = case p of
Request a' fa -> Request a' (\a -> fa a >>~ fb)
Respond b fb' -> fb' +>> fb b
M m -> M (m >>= \p' -> return (p' >>~ fb))
Pure r -> Pure r
pull :: Monad m => a' -> Proxy a' a a' a m r
pull = go
where
go a' = Request a' (\a -> Respond a go)
(>+>)
:: Monad m
=> ( b' -> Proxy a' a b' b m r)
-> (_c' -> Proxy b' b c' c m r)
-> (_c' -> Proxy a' a c' c m r)
(fb' >+> fc') c' = fb' +>> fc' c'
(+>>)
:: Monad m
=> (b' -> Proxy a' a b' b m r)
-> Proxy b' b c' c m r
-> Proxy a' a c' c m r
fb' +>> p = case p of
Request b' fb -> fb' b' >>~ fb
Respond c fc' -> Respond c (\c' -> fb' +>> fc' c')
M m -> M (m >>= \p' -> return (fb' +>> p'))
Pure r -> Pure r
reflect :: Monad m => Proxy a' a b' b m r -> Proxy b b' a a' m r
reflect = go
where
go p = case p of
Request a' fa -> Respond a' (\a -> go (fa a ))
Respond b fb' -> Request b (\b' -> go (fb' b'))
M m -> M (m >>= \p' -> return (go p'))
Pure r -> Pure r
type Effect = Proxy X () () X
type Producer b = Proxy X () () b
type Pipe a b = Proxy () a () b
type Consumer a = Proxy () a () X
type Client a' a = Proxy a' a () X
type Server b' b = Proxy X () b' b
type Effect' m r = forall x' x y' y . Proxy x' x y' y m r
type Producer' b m r = forall x' x . Proxy x' x () b m r
type Consumer' a m r = forall y' y . Proxy () a y' y m r
type Server' b' b m r = forall x' x . Proxy x' x b' b m r
type Client' a' a m r = forall y' y . Proxy a' a y' y m r
(\<\)
:: Monad 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')
p1 \<\ p2 = p2 />/ p1
(/</)
:: Monad m
=> (c' -> Proxy b' b x' x m c)
-> (b' -> Proxy a' a x' x m b)
-> (c' -> Proxy a' a x' x m c)
p1 /</ p2 = p2 \>\ p1
(<~<)
:: Monad m
=> (b -> Proxy b' b c' c m r)
-> (a -> Proxy a' a b' b m r)
-> (a -> Proxy a' a c' c m r)
p1 <~< p2 = p2 >~> p1
(<+<)
:: Monad m
=> (c' -> Proxy b' b c' c m r)
-> (b' -> Proxy a' a b' b m r)
-> (c' -> Proxy a' a c' c m r)
p1 <+< p2 = p2 >+> p1
(<\\)
:: Monad m
=> (b -> Proxy x' x c' c m b')
-> Proxy x' x b' b m a'
-> Proxy x' x c' c m a'
f <\\ p = p //> f
(//<)
:: Monad m
=> Proxy b' b y' y m c
-> (b' -> Proxy a' a y' y m b)
-> Proxy a' a y' y m c
p //< f = f >\\ p
(~<<)
:: Monad m
=> (b -> Proxy b' b c' c m r)
-> Proxy a' a b' b m r
-> Proxy a' a c' c m r
k ~<< p = p >>~ k
(<<+)
:: Monad m
=> Proxy b' b c' c m r
-> (b' -> Proxy a' a b' b m r)
-> Proxy a' a c' c m r
k <<+ p = p +>> k
{-# RULES
"(p //> f) //> g" forall p f g . (p //> f) //> g = p //> (\x -> f x //> g)
; "p //> respond" forall p . p //> respond = p
; "respond x //> f" forall x f . respond x //> f = f x
; "f >\\ (g >\\ p)" forall f g p . f >\\ (g >\\ p) = (\x -> f >\\ g x) >\\ p
; "request >\\ p" forall p . request >\\ p = p
; "f >\\ request x" forall f x . f >\\ request x = f x
; "(p >>~ f) >>~ g" forall p f g . (p >>~ f) >>~ g = p >>~ (\x -> f x >>~ g)
; "p >>~ push" forall p . p >>~ push = p
; "push x >>~ f" forall x f . push x >>~ f = f x
; "f +>> (g +>> p)" forall f g p . f +>> (g +>> p) = (\x -> f +>> g x) +>> p
; "pull +>> p" forall p . pull +>> p = p
; "f +>> pull x" forall f x . f +>> pull x = f x
#-}