{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}

-- | A higher level API to implement clients for local message notification
-- miniprotocol.
--
-- For execution, 'localMsgNotificationClientPeer' reinterprets this high level
-- description into the underlying typed protocol representation.
--
module DMQ.Protocol.LocalMsgNotification.Client
  ( -- * Client API types
    LocalMsgNotificationClient (..)
  , LocalMsgNotificationClientStIdle (..)
    -- * Translates the client into a typed protocol
  , localMsgNotificationClientPeer
  ) where

import Data.List.NonEmpty (NonEmpty)

import DMQ.Protocol.LocalMsgNotification.Type
import Network.TypedProtocol.Peer.Client

-- | The high level client wrapper
--
newtype LocalMsgNotificationClient m msg a = LocalMsgNotificationClient {
  forall (m :: * -> *) msg a.
LocalMsgNotificationClient m msg a
-> m (LocalMsgNotificationClientStIdle m msg a)
runMsgNotificationClient :: m (LocalMsgNotificationClientStIdle m msg a)
  }


-- | The client API message types
--
data LocalMsgNotificationClientStIdle m msg a =
    SendMsgRequestBlocking
      !(   NonEmpty msg
        -> HasMore
        -> m (LocalMsgNotificationClientStIdle m msg a)) -- ^ a continuation
  | SendMsgRequestNonBlocking
      !(   [msg]
        -> HasMore
        -> m (LocalMsgNotificationClientStIdle m msg a))
  | SendMsgDone !(m a)


-- | A non-pipelined 'Peer' representing the 'LocalMsgNotificationClient'.
--
-- Translates the client into the typed protocol representation.
--
localMsgNotificationClientPeer
  :: forall m msg a. (Monad m)
  => LocalMsgNotificationClient m msg a
  -> Client (LocalMsgNotification msg) NonPipelined StIdle m a
localMsgNotificationClientPeer :: forall (m :: * -> *) msg a.
Monad m =>
LocalMsgNotificationClient m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
localMsgNotificationClientPeer (LocalMsgNotificationClient m (LocalMsgNotificationClientStIdle m msg a)
client) =
  m (Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall a b. (a -> b) -> a -> b
$ LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
go (LocalMsgNotificationClientStIdle m msg a
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> m (LocalMsgNotificationClientStIdle m msg a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (LocalMsgNotificationClientStIdle m msg a)
client
  where
    go :: LocalMsgNotificationClientStIdle m msg a
       -> Client (LocalMsgNotification msg) NonPipelined StIdle m a
    go :: LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
go (SendMsgRequestBlocking NonEmpty msg
-> HasMore -> m (LocalMsgNotificationClientStIdle m msg a)
k) =
      Message (LocalMsgNotification msg) StIdle (StBusy 'StBlocking)
-> Client
     (LocalMsgNotification msg) 'NonPipelined (StBusy 'StBlocking) m a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield (SingBlockingStyle 'StBlocking
-> Message (LocalMsgNotification msg) StIdle (StBusy 'StBlocking)
forall (blocking :: StBlockingStyle) msg.
SingI blocking =>
SingBlockingStyle blocking
-> Message (LocalMsgNotification msg) StIdle (StBusy blocking)
MsgRequest SingBlockingStyle 'StBlocking
SingBlocking)
      (Client
   (LocalMsgNotification msg) 'NonPipelined (StBusy 'StBlocking) m a
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> Client
     (LocalMsgNotification msg) 'NonPipelined (StBusy 'StBlocking) m a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall a b. (a -> b) -> a -> b
$ (forall (st' :: LocalMsgNotification msg).
 Message (LocalMsgNotification msg) (StBusy 'StBlocking) st'
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client
     (LocalMsgNotification msg) 'NonPipelined (StBusy 'StBlocking) m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await \case
          MsgReply (BlockingReply NonEmpty msg
msgs) HasMore
more -> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
go (LocalMsgNotificationClientStIdle m msg a
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> m (LocalMsgNotificationClientStIdle m msg a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty msg
-> HasMore -> m (LocalMsgNotificationClientStIdle m msg a)
k NonEmpty msg
msgs HasMore
more

    go (SendMsgRequestNonBlocking [msg] -> HasMore -> m (LocalMsgNotificationClientStIdle m msg a)
k) =
      Message (LocalMsgNotification msg) StIdle (StBusy 'StNonBlocking)
-> Client
     (LocalMsgNotification msg)
     'NonPipelined
     (StBusy 'StNonBlocking)
     m
     a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield (SingBlockingStyle 'StNonBlocking
-> Message
     (LocalMsgNotification msg) StIdle (StBusy 'StNonBlocking)
forall (blocking :: StBlockingStyle) msg.
SingI blocking =>
SingBlockingStyle blocking
-> Message (LocalMsgNotification msg) StIdle (StBusy blocking)
MsgRequest SingBlockingStyle 'StNonBlocking
SingNonBlocking)
      (Client
   (LocalMsgNotification msg)
   'NonPipelined
   (StBusy 'StNonBlocking)
   m
   a
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> Client
     (LocalMsgNotification msg)
     'NonPipelined
     (StBusy 'StNonBlocking)
     m
     a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall a b. (a -> b) -> a -> b
$ (forall (st' :: LocalMsgNotification msg).
 Message (LocalMsgNotification msg) (StBusy 'StNonBlocking) st'
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client
     (LocalMsgNotification msg)
     'NonPipelined
     (StBusy 'StNonBlocking)
     m
     a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'ServerAgency,
 Outstanding pl ~ 'Z) =>
(forall (st' :: ps). Message ps st st' -> Client ps pl st' m a)
-> Client ps pl st m a
Await \case
          MsgReply (NonBlockingReply [msg]
msgs) HasMore
more -> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
forall a b. (a -> b) -> a -> b
$ LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined st' m a
LocalMsgNotificationClientStIdle m msg a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
go (LocalMsgNotificationClientStIdle m msg a
 -> Client (LocalMsgNotification msg) 'NonPipelined st' m a)
-> m (LocalMsgNotificationClientStIdle m msg a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined st' m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [msg] -> HasMore -> m (LocalMsgNotificationClientStIdle m msg a)
k [msg]
msgs HasMore
more

    go (SendMsgDone m a
done) =
      Message (LocalMsgNotification msg) StIdle StDone
-> Client (LocalMsgNotification msg) 'NonPipelined StDone m a
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a
       (st' :: ps).
(StateTokenI st, StateTokenI st', StateAgency st ~ 'ClientAgency,
 Outstanding pl ~ 'Z) =>
Message ps st st' -> Client ps pl st' m a -> Client ps pl st m a
Yield Message (LocalMsgNotification msg) StIdle StDone
forall msg. Message (LocalMsgNotification msg) StIdle StDone
MsgClientDone (Client (LocalMsgNotification msg) 'NonPipelined StDone m a
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> (m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
    -> Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
-> Client (LocalMsgNotification msg) 'NonPipelined StDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
m (Client ps pl st m a) -> Client ps pl st m a
Effect (m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
 -> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a)
-> m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
-> Client (LocalMsgNotification msg) 'NonPipelined StIdle m a
forall a b. (a -> b) -> a -> b
$ a -> Client (LocalMsgNotification msg) 'NonPipelined StDone m a
forall ps (pl :: IsPipelined) (st :: ps) (m :: * -> *) a.
(StateTokenI st, StateAgency st ~ 'NobodyAgency,
 Outstanding pl ~ 'Z) =>
a -> Client ps pl st m a
Done (a -> Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
-> m a
-> m (Client (LocalMsgNotification msg) 'NonPipelined StDone m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
done