{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE PolyKinds           #-}
{-# LANGUAGE RankNTypes          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.TypedProtocol.Stateful.ReqResp.Client
  ( ReqRespClient (..)
  , reqRespClientPeer
  ) where

import           Data.Typeable
import           Network.TypedProtocol.Stateful.Peer.Client
import           Network.TypedProtocol.Stateful.ReqResp.Type

data ReqRespClient req m a where
  SendMsgReq  :: Typeable resp
              => req resp
              -> (resp -> m (ReqRespClient req m a))
              -> ReqRespClient req m a

  SendMsgDone :: a
              -> ReqRespClient req m a


reqRespClientPeer
  :: Monad m
  => ReqRespClient req m a
  -> Client (ReqResp req) StIdle State m a

reqRespClientPeer :: forall (m :: * -> *) (req :: * -> *) a.
Monad m =>
ReqRespClient req m a -> Client (ReqResp req) 'StIdle State m a
reqRespClientPeer (SendMsgDone a
a) =
      State 'StDone
-> Message (ReqResp req) 'StIdle 'StDone
-> Client (ReqResp req) 'StDone State m a
-> Client (ReqResp req) 'StIdle State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a (st' :: ps).
(StateTokenI st, StateTokenI st',
 StateAgency st ~ 'ClientAgency) =>
f st'
-> Message ps st st' -> Client ps st' f m a -> Client ps st f m a
Yield State 'StDone
forall {req :: * -> *}. State 'StDone
StateDone Message (ReqResp req) 'StIdle 'StDone
forall (req :: * -> *). Message (ReqResp req) 'StIdle 'StDone
MsgDone (a -> Client (ReqResp req) 'StDone State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency) =>
a -> Client ps st f m a
Done a
a)

reqRespClientPeer (SendMsgReq req resp
req resp -> m (ReqRespClient req m a)
next) =
    State ('StBusy resp)
-> Message (ReqResp req) 'StIdle ('StBusy resp)
-> Client (ReqResp req) ('StBusy resp) State m a
-> Client (ReqResp req) 'StIdle State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a (st' :: ps).
(StateTokenI st, StateTokenI st',
 StateAgency st ~ 'ClientAgency) =>
f st'
-> Message ps st st' -> Client ps st' f m a -> Client ps st f m a
Yield (req resp -> State ('StBusy resp)
forall (req :: * -> *) result.
Typeable result =>
req result -> State ('StBusy result)
StateBusy req resp
req)
          (req resp -> Message (ReqResp req) 'StIdle ('StBusy resp)
forall resp (req :: * -> *).
Typeable resp =>
req resp -> Message (ReqResp req) 'StIdle ('StBusy resp)
MsgReq req resp
req) (Client (ReqResp req) ('StBusy resp) State m a
 -> Client (ReqResp req) 'StIdle State m a)
-> Client (ReqResp req) ('StBusy resp) State m a
-> Client (ReqResp req) 'StIdle State m a
forall a b. (a -> b) -> a -> b
$
    (forall (st' :: ReqResp req).
 State ('StBusy resp)
 -> Message (ReqResp req) ('StBusy resp) st'
 -> (Client (ReqResp req) st' State m a, State st'))
-> Client (ReqResp req) ('StBusy resp) State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency) =>
(forall (st' :: ps).
 f st -> Message ps st st' -> (Client ps st' f m a, f st'))
-> Client ps st f m a
Await ((forall (st' :: ReqResp req).
  State ('StBusy resp)
  -> Message (ReqResp req) ('StBusy resp) st'
  -> (Client (ReqResp req) st' State m a, State st'))
 -> Client (ReqResp req) ('StBusy resp) State m a)
-> (forall (st' :: ReqResp req).
    State ('StBusy resp)
    -> Message (ReqResp req) ('StBusy resp) st'
    -> (Client (ReqResp req) st' State m a, State st'))
-> Client (ReqResp req) ('StBusy resp) State m a
forall a b. (a -> b) -> a -> b
$ \State ('StBusy resp)
_ (MsgResp resp
resp) ->
      let client :: m (ReqRespClient req m a)
client = resp -> m (ReqRespClient req m a)
next resp
resp
resp
      in ( m (Client (ReqResp req) st' State m a)
-> Client (ReqResp req) st' State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
m (Client ps st f m a) -> Client ps st f m a
Effect (m (Client (ReqResp req) st' State m a)
 -> Client (ReqResp req) st' State m a)
-> m (Client (ReqResp req) st' State m a)
-> Client (ReqResp req) st' State m a
forall a b. (a -> b) -> a -> b
$ ReqRespClient req m a -> Client (ReqResp req) st' State m a
ReqRespClient req m a -> Client (ReqResp req) 'StIdle State m a
forall (m :: * -> *) (req :: * -> *) a.
Monad m =>
ReqRespClient req m a -> Client (ReqResp req) 'StIdle State m a
reqRespClientPeer (ReqRespClient req m a -> Client (ReqResp req) st' State m a)
-> m (ReqRespClient req m a)
-> m (Client (ReqResp req) st' State m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (ReqRespClient req m a)
client
         , State st'
State 'StIdle
forall {req :: * -> *}. State 'StIdle
StateIdle
         )