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

module Network.TypedProtocol.Stateful.ReqResp.Server
  ( ReqRespServer (..)
  , reqRespServerPeer
  ) where

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


data ReqRespServer req m a = ReqRespServer {
    forall (req :: * -> *) (m :: * -> *) a. ReqRespServer req m a -> a
reqRespServerDone :: a,
    forall (req :: * -> *) (m :: * -> *) a.
ReqRespServer req m a
-> forall resp.
   Typeable resp =>
   req resp -> m (resp, ReqRespServer req m a)
reqRespHandleReq  :: forall resp. Typeable resp => req resp -> m (resp, ReqRespServer req m a)
  }

reqRespServerPeer :: Functor m
                  => ReqRespServer req m a
                  -> Server (ReqResp req) StIdle State m a
reqRespServerPeer :: forall (m :: * -> *) (req :: * -> *) a.
Functor m =>
ReqRespServer req m a -> Server (ReqResp req) 'StIdle State m a
reqRespServerPeer ReqRespServer { reqRespServerDone :: forall (req :: * -> *) (m :: * -> *) a. ReqRespServer req m a -> a
reqRespServerDone = a
a,
                                  reqRespHandleReq :: forall (req :: * -> *) (m :: * -> *) a.
ReqRespServer req m a
-> forall resp.
   Typeable resp =>
   req resp -> m (resp, ReqRespServer req m a)
reqRespHandleReq  = forall resp.
Typeable resp =>
req resp -> m (resp, ReqRespServer req m a)
k } =
  (forall (st' :: ReqResp req).
 State 'StIdle
 -> Message (ReqResp req) 'StIdle st'
 -> (Server (ReqResp req) st' State m a, State st'))
-> Server (ReqResp req) 'StIdle State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ClientAgency) =>
(forall (st' :: ps).
 f st -> Message ps st st' -> (Server ps st' f m a, f st'))
-> Server ps st f m a
Await ((forall (st' :: ReqResp req).
  State 'StIdle
  -> Message (ReqResp req) 'StIdle st'
  -> (Server (ReqResp req) st' State m a, State st'))
 -> Server (ReqResp req) 'StIdle State m a)
-> (forall (st' :: ReqResp req).
    State 'StIdle
    -> Message (ReqResp req) 'StIdle st'
    -> (Server (ReqResp req) st' State m a, State st'))
-> Server (ReqResp req) 'StIdle State m a
forall a b. (a -> b) -> a -> b
$ \State 'StIdle
_ -> \case
    Message (ReqResp req) 'StIdle st'
R:MessageReqRespfromto req 'StIdle st'
MsgDone -> (a -> Server (ReqResp req) st' State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency) =>
a -> Server ps st f m a
Done a
a, State st'
State 'StDone
forall {req :: * -> *}. State 'StDone
StateDone)
    MsgReq req resp
req ->
      ( m (Server (ReqResp req) st' State m a)
-> Server (ReqResp req) st' State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a.
m (Server ps st f m a) -> Server ps st f m a
Effect (m (Server (ReqResp req) st' State m a)
 -> Server (ReqResp req) st' State m a)
-> m (Server (ReqResp req) st' State m a)
-> Server (ReqResp req) st' State m a
forall a b. (a -> b) -> a -> b
$
              (\(resp
resp, ReqRespServer req m a
k') -> State st'
-> State 'StIdle
-> Message (ReqResp req) st' 'StIdle
-> Server (ReqResp req) 'StIdle State m a
-> Server (ReqResp req) st' State m a
forall ps (st :: ps) (f :: ps -> *) (m :: * -> *) a (st' :: ps).
(StateTokenI st, StateTokenI st',
 StateAgency st ~ 'ServerAgency) =>
f st
-> f st'
-> Message ps st st'
-> Server ps st' f m a
-> Server 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) State 'StIdle
forall {req :: * -> *}. State 'StIdle
StateIdle (resp -> Message (ReqResp req) ('StBusy resp) 'StIdle
forall resp (req :: * -> *).
Typeable resp =>
resp -> Message (ReqResp req) ('StBusy resp) 'StIdle
MsgResp resp
resp) (ReqRespServer req m a -> Server (ReqResp req) 'StIdle State m a
forall (m :: * -> *) (req :: * -> *) a.
Functor m =>
ReqRespServer req m a -> Server (ReqResp req) 'StIdle State m a
reqRespServerPeer  ReqRespServer req m a
k'))
          ((resp, ReqRespServer req m a)
 -> Server (ReqResp req) st' State m a)
-> m (resp, ReqRespServer req m a)
-> m (Server (ReqResp req) st' State m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> req resp -> m (resp, ReqRespServer req m a)
forall resp.
Typeable resp =>
req resp -> m (resp, ReqRespServer req m a)
k req resp
req
      , req resp -> State ('StBusy resp)
forall (req :: * -> *) result.
Typeable result =>
req result -> State ('StBusy result)
StateBusy req resp
req
      )