{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RecordWildCards #-}
module Network.TypedProtocol.ReqResp.Server where
import Network.TypedProtocol.Core
import Network.TypedProtocol.ReqResp.Type
data ReqRespServer req resp m a = ReqRespServer {
ReqRespServer req resp m a
-> req -> m (resp, ReqRespServer req resp m a)
recvMsgReq :: req -> m (resp, ReqRespServer req resp m a)
, ReqRespServer req resp m a -> m a
recvMsgDone :: m a
}
reqRespServerPeer
:: Monad m
=> ReqRespServer req resp m a
-> Peer (ReqResp req resp) AsServer StIdle m a
reqRespServerPeer :: ReqRespServer req resp m a
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a
reqRespServerPeer ReqRespServer{m a
req -> m (resp, ReqRespServer req resp m a)
recvMsgDone :: m a
recvMsgReq :: req -> m (resp, ReqRespServer req resp m a)
recvMsgDone :: forall req resp (m :: * -> *) a. ReqRespServer req resp m a -> m a
recvMsgReq :: forall req resp (m :: * -> *) a.
ReqRespServer req resp m a
-> req -> m (resp, ReqRespServer req resp m a)
..} =
TheyHaveAgency 'AsServer 'StIdle
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StIdle st'
-> Peer (ReqResp req resp) 'AsServer st' m a)
-> Peer (ReqResp req resp) 'AsServer 'StIdle 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 (ClientHasAgency 'StIdle -> PeerHasAgency 'AsClient 'StIdle
forall ps (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall k k (req :: k) (resp :: k). ClientHasAgency 'StIdle
TokIdle) ((forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StIdle st'
-> Peer (ReqResp req resp) 'AsServer st' m a)
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a)
-> (forall (st' :: ReqResp req resp).
Message (ReqResp req resp) 'StIdle st'
-> Peer (ReqResp req resp) 'AsServer st' m a)
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a
forall a b. (a -> b) -> a -> b
$ \Message (ReqResp req resp) 'StIdle st'
msg ->
case Message (ReqResp req resp) 'StIdle st'
msg of
Message (ReqResp req resp) 'StIdle st'
MsgDone -> m (Peer (ReqResp req resp) 'AsServer 'StDone m a)
-> Peer (ReqResp req resp) 'AsServer 'StDone 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) 'AsServer 'StDone m a)
-> Peer (ReqResp req resp) 'AsServer 'StDone m a)
-> m (Peer (ReqResp req resp) 'AsServer 'StDone m a)
-> Peer (ReqResp req resp) 'AsServer 'StDone m a
forall a b. (a -> b) -> a -> b
$ NobodyHasAgency 'StDone
-> a -> Peer (ReqResp req resp) 'AsServer '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 -> Peer (ReqResp req resp) 'AsServer 'StDone m a)
-> m a -> m (Peer (ReqResp req resp) 'AsServer 'StDone m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
recvMsgDone
MsgReq req -> m (Peer (ReqResp req resp) 'AsServer 'StBusy m a)
-> Peer (ReqResp req resp) 'AsServer 'StBusy 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) 'AsServer 'StBusy m a)
-> Peer (ReqResp req resp) 'AsServer 'StBusy m a)
-> m (Peer (ReqResp req resp) 'AsServer 'StBusy m a)
-> Peer (ReqResp req resp) 'AsServer 'StBusy m a
forall a b. (a -> b) -> a -> b
$ do
(resp
resp, ReqRespServer req resp m a
next) <- req -> m (resp, ReqRespServer req resp m a)
recvMsgReq req
req
req
Peer (ReqResp req resp) 'AsServer 'StBusy m a
-> m (Peer (ReqResp req resp) 'AsServer 'StBusy m a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Peer (ReqResp req resp) 'AsServer 'StBusy m a
-> m (Peer (ReqResp req resp) 'AsServer 'StBusy m a))
-> Peer (ReqResp req resp) 'AsServer 'StBusy m a
-> m (Peer (ReqResp req resp) 'AsServer 'StBusy m a)
forall a b. (a -> b) -> a -> b
$ WeHaveAgency 'AsServer 'StBusy
-> Message (ReqResp req resp) 'StBusy 'StIdle
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a
-> Peer (ReqResp req resp) 'AsServer 'StBusy 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 (ServerHasAgency 'StBusy -> WeHaveAgency 'AsServer 'StBusy
forall ps (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StBusy
forall k k (req :: k) (resp :: k). ServerHasAgency 'StBusy
TokBusy) (resp -> Message (ReqResp req resp) 'StBusy 'StIdle
forall k resp (req :: k).
resp -> Message (ReqResp req resp) 'StBusy 'StIdle
MsgResp resp
resp) (ReqRespServer req resp m a
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a
forall (m :: * -> *) req resp a.
Monad m =>
ReqRespServer req resp m a
-> Peer (ReqResp req resp) 'AsServer 'StIdle m a
reqRespServerPeer ReqRespServer req resp m a
next)