{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module Network.TypedProtocol.ReqResp.Client (
ReqRespClient(..),
reqRespClientPeer,
ReqRespClientPipelined(..),
ReqRespSender(..),
reqRespClientPeerPipelined,
) where
import Network.TypedProtocol.Core
import Network.TypedProtocol.Pipelined
import Network.TypedProtocol.ReqResp.Type
data ReqRespClient req resp m a where
SendMsgReq :: req
-> (resp -> m (ReqRespClient req resp m a))
-> ReqRespClient req resp m a
SendMsgDone :: m a -> ReqRespClient req resp m a
reqRespClientPeer
:: Monad m
=> ReqRespClient req resp m a
-> Peer (ReqResp req resp) AsClient StIdle m a
reqRespClientPeer :: ReqRespClient req resp m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
reqRespClientPeer (SendMsgDone m a
result) =
m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$ do
a
r <- m a
result
Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a))
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
forall a b. (a -> b) -> a -> b
$ WeHaveAgency 'AsClient 'StIdle
-> Message (ReqResp req resp) 'StIdle 'StDone
-> Peer (ReqResp req resp) 'AsClient 'StDone m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ClientHasAgency 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k (req :: k) (resp :: k). ClientHasAgency 'StIdle
TokIdle) Message (ReqResp req resp) 'StIdle 'StDone
forall k k (req :: k) (resp :: k).
Message (ReqResp req resp) 'StIdle 'StDone
MsgDone (NobodyHasAgency 'StDone
-> a -> Peer (ReqResp req resp) 'AsClient 'StDone m a
forall ps (st :: ps) a (pr :: PeerRole) (m :: * -> *).
NobodyHasAgency st -> a -> Peer ps pr st m a
Done NobodyHasAgency 'StDone
forall k k (req :: k) (resp :: k). NobodyHasAgency 'StDone
TokDone a
r)
reqRespClientPeer (SendMsgReq req
req resp -> m (ReqRespClient req resp m a)
next) =
WeHaveAgency 'AsClient 'StIdle
-> Message (ReqResp req resp) 'StIdle 'StBusy
-> Peer (ReqResp req resp) 'AsClient 'StBusy m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (m :: * -> *) a.
WeHaveAgency pr st
-> Message ps st st' -> Peer ps pr st' m a -> Peer ps pr st m a
Yield (ClientHasAgency 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k (req :: k) (resp :: k). ClientHasAgency 'StIdle
TokIdle) (req -> Message (ReqResp req resp) 'StIdle 'StBusy
forall k req (resp :: k).
req -> Message (ReqResp req resp) 'StIdle 'StBusy
MsgReq req
req) (Peer (ReqResp req resp) 'AsClient 'StBusy m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StBusy m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$
TheyHaveAgency 'AsClient 'StBusy
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> Peer (ReqResp req resp) 'AsClient st' m a)
-> Peer (ReqResp req resp) 'AsClient 'StBusy m a
forall (pr :: PeerRole) ps (st :: ps) (m :: * -> *) a.
TheyHaveAgency pr st
-> (forall (st' :: ps). Message ps st st' -> Peer ps pr st' m a)
-> Peer ps pr st m a
Await (ServerHasAgency 'StBusy -> PeerHasAgency 'AsServer 'StBusy
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StBusy
forall k k (req :: k) (resp :: k). ServerHasAgency 'StBusy
TokBusy) ((forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> Peer (ReqResp req resp) 'AsClient st' m a)
-> Peer (ReqResp req resp) 'AsClient 'StBusy m a)
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> Peer (ReqResp req resp) 'AsClient st' m a)
-> Peer (ReqResp req resp) 'AsClient 'StBusy m a
forall a b. (a -> b) -> a -> b
$ \(MsgResp resp) ->
m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) a.
m (Peer ps pr st m a) -> Peer ps pr st m a
Effect (m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall a b. (a -> b) -> a -> b
$ do
ReqRespClient req resp m a
client <- resp -> m (ReqRespClient req resp m a)
next resp
resp
resp
Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a))
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
-> m (Peer (ReqResp req resp) 'AsClient 'StIdle m a)
forall a b. (a -> b) -> a -> b
$ ReqRespClient req resp m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
forall (m :: * -> *) req resp a.
Monad m =>
ReqRespClient req resp m a
-> Peer (ReqResp req resp) 'AsClient 'StIdle m a
reqRespClientPeer ReqRespClient req resp m a
client
data ReqRespClientPipelined req resp m a where
ReqRespClientPipelined ::
ReqRespSender req resp Z c m a
-> ReqRespClientPipelined req resp m a
data ReqRespSender req resp n c m a where
SendMsgReqPipelined
:: req
-> (resp -> m c)
-> ReqRespSender req resp (S n) c m a
-> ReqRespSender req resp n c m a
CollectPipelined
:: Maybe (ReqRespSender req resp (S n) c m a)
-> (c -> ReqRespSender req resp n c m a)
-> ReqRespSender req resp (S n) c m a
SendMsgDonePipelined
:: a -> ReqRespSender req resp Z c m a
reqRespClientPeerPipelined
:: Monad m
=> ReqRespClientPipelined req resp m a
-> PeerPipelined (ReqResp req resp) AsClient StIdle m a
reqRespClientPeerPipelined :: ReqRespClientPipelined req resp m a
-> PeerPipelined (ReqResp req resp) 'AsClient 'StIdle m a
reqRespClientPeerPipelined (ReqRespClientPipelined ReqRespSender req resp 'Z c m a
peer) =
PeerSender (ReqResp req resp) 'AsClient 'StIdle 'Z c m a
-> PeerPipelined (ReqResp req resp) 'AsClient 'StIdle m a
forall ps (pr :: PeerRole) (st :: ps) c (m :: * -> *) a.
PeerSender ps pr st 'Z c m a -> PeerPipelined ps pr st m a
PeerPipelined (ReqRespSender req resp 'Z c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle 'Z c m a
forall (m :: * -> *) req resp (n :: N) c a.
Monad m =>
ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
reqRespClientPeerSender ReqRespSender req resp 'Z c m a
peer)
reqRespClientPeerSender
:: Monad m
=> ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) AsClient StIdle n c m a
reqRespClientPeerSender :: ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
reqRespClientPeerSender (SendMsgDonePipelined a
result) =
WeHaveAgency 'AsClient 'StIdle
-> Message (ReqResp req resp) 'StIdle 'StDone
-> PeerSender (ReqResp req resp) 'AsClient 'StDone 'Z c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle 'Z c m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) c (m :: * -> *)
a.
WeHaveAgency pr st
-> Message ps st st'
-> PeerSender ps pr st' 'Z c m a
-> PeerSender ps pr st 'Z c m a
SenderYield
(ClientHasAgency 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k (req :: k) (resp :: k). ClientHasAgency 'StIdle
TokIdle)
Message (ReqResp req resp) 'StIdle 'StDone
forall k k (req :: k) (resp :: k).
Message (ReqResp req resp) 'StIdle 'StDone
MsgDone
(NobodyHasAgency 'StDone
-> a -> PeerSender (ReqResp req resp) 'AsClient 'StDone 'Z c m a
forall ps (st :: ps) a (pr :: PeerRole) c (m :: * -> *).
NobodyHasAgency st -> a -> PeerSender ps pr st 'Z c m a
SenderDone NobodyHasAgency 'StDone
forall k k (req :: k) (resp :: k). NobodyHasAgency 'StDone
TokDone a
result)
reqRespClientPeerSender (SendMsgReqPipelined req
req resp -> m c
receive ReqRespSender req resp ('S n) c m a
next) =
WeHaveAgency 'AsClient 'StIdle
-> Message (ReqResp req resp) 'StIdle 'StBusy
-> PeerReceiver (ReqResp req resp) 'AsClient 'StBusy 'StIdle m c
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps) (st'' :: ps)
(m :: * -> *) c (n :: N) a.
WeHaveAgency pr st
-> Message ps st st'
-> PeerReceiver ps pr st' st'' m c
-> PeerSender ps pr st'' ('S n) c m a
-> PeerSender ps pr st n c m a
SenderPipeline
(ClientHasAgency 'StIdle -> WeHaveAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k (req :: k) (resp :: k). ClientHasAgency 'StIdle
TokIdle)
(req -> Message (ReqResp req resp) 'StIdle 'StBusy
forall k req (resp :: k).
req -> Message (ReqResp req resp) 'StIdle 'StBusy
MsgReq req
req)
(TheyHaveAgency 'AsClient 'StBusy
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> PeerReceiver (ReqResp req resp) 'AsClient st' 'StIdle m c)
-> PeerReceiver (ReqResp req resp) 'AsClient 'StBusy 'StIdle m c
forall (pr :: PeerRole) ps (st :: ps) (stdone :: ps) (m :: * -> *)
c.
TheyHaveAgency pr st
-> (forall (st' :: ps).
Message ps st st' -> PeerReceiver ps pr st' stdone m c)
-> PeerReceiver ps pr st stdone m c
ReceiverAwait (ServerHasAgency 'StBusy -> PeerHasAgency 'AsServer 'StBusy
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StBusy
forall k k (req :: k) (resp :: k). ServerHasAgency 'StBusy
TokBusy) ((forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> PeerReceiver (ReqResp req resp) 'AsClient st' 'StIdle m c)
-> PeerReceiver (ReqResp req resp) 'AsClient 'StBusy 'StIdle m c)
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StBusy st'
-> PeerReceiver (ReqResp req resp) 'AsClient st' 'StIdle m c)
-> PeerReceiver (ReqResp req resp) 'AsClient 'StBusy 'StIdle m c
forall a b. (a -> b) -> a -> b
$ \(MsgResp resp) ->
m (PeerReceiver (ReqResp req resp) 'AsClient st' st' m c)
-> PeerReceiver (ReqResp req resp) 'AsClient st' st' m c
forall (m :: * -> *) ps (pr :: PeerRole) (st :: ps) (stdone :: ps)
c.
m (PeerReceiver ps pr st stdone m c)
-> PeerReceiver ps pr st stdone m c
ReceiverEffect (m (PeerReceiver (ReqResp req resp) 'AsClient st' st' m c)
-> PeerReceiver (ReqResp req resp) 'AsClient st' st' m c)
-> m (PeerReceiver (ReqResp req resp) 'AsClient st' st' m c)
-> PeerReceiver (ReqResp req resp) 'AsClient st' st' m c
forall a b. (a -> b) -> a -> b
$ do
c
x <- resp -> m c
receive resp
resp
resp
PeerReceiver (ReqResp req resp) 'AsClient st' st' m c
-> m (PeerReceiver (ReqResp req resp) 'AsClient st' st' m c)
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> PeerReceiver (ReqResp req resp) 'AsClient st' st' m c
forall c ps (pr :: PeerRole) (st :: ps) (m :: * -> *).
c -> PeerReceiver ps pr st st m c
ReceiverDone c
x))
(ReqRespSender req resp ('S n) c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a
forall (m :: * -> *) req resp (n :: N) c a.
Monad m =>
ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
reqRespClientPeerSender ReqRespSender req resp ('S n) c m a
next)
reqRespClientPeerSender (CollectPipelined Maybe (ReqRespSender req resp ('S n) c m a)
mNone c -> ReqRespSender req resp n c m a
collect) =
Maybe
(PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a)
-> (c -> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a)
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a
forall ps (pr :: PeerRole) (st :: ps) (n1 :: N) c (m :: * -> *) a.
Maybe (PeerSender ps pr st ('S n1) c m a)
-> (c -> PeerSender ps pr st n1 c m a)
-> PeerSender ps pr st ('S n1) c m a
SenderCollect
((ReqRespSender req resp ('S n) c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a)
-> Maybe (ReqRespSender req resp ('S n) c m a)
-> Maybe
(PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ReqRespSender req resp ('S n) c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle ('S n) c m a
forall (m :: * -> *) req resp (n :: N) c a.
Monad m =>
ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
reqRespClientPeerSender Maybe (ReqRespSender req resp ('S n) c m a)
mNone)
(ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
forall (m :: * -> *) req resp (n :: N) c a.
Monad m =>
ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
reqRespClientPeerSender (ReqRespSender req resp n c m a
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a)
-> (c -> ReqRespSender req resp n c m a)
-> c
-> PeerSender (ReqResp req resp) 'AsClient 'StIdle n c m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> ReqRespSender req resp n c m a
collect)