{-# LANGUAGE FunctionalDependencies #-}

-- | Server handlers
module Network.GRPC.Server.StreamType (
    -- * Handler type
    ServerHandler'(..)
  , ServerHandler
    -- * Construct server handler
  , mkNonStreaming
  , mkClientStreaming
  , mkServerStreaming
  , mkBiDiStreaming
    -- * Server API
  , Methods(..)
  , Services(..)
  , fromMethod
  , fromMethods
  , fromServices
    -- ** Hoisting
  , hoistMethods
  , hoistServices
    -- * Varargs API
  , simpleMethods
  ) where

import Control.Monad.IO.Class
import Data.Kind

import Network.GRPC.Common
import Network.GRPC.Common.NextElem qualified as NextElem
import Network.GRPC.Server
import Network.GRPC.Spec

{-------------------------------------------------------------------------------
  Construct server handler

  It may sometimes be useful to use explicit type applications with these
  functions, which is why the @rpc@ type variable is always first.
-------------------------------------------------------------------------------}

mkNonStreaming :: forall rpc m.
     SupportsStreamingType rpc NonStreaming
  => (    Input rpc
       -> m (Output rpc)
     )
  -> ServerHandler' NonStreaming m rpc
mkNonStreaming :: forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'NonStreaming =>
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
mkNonStreaming = Handler 'Server 'NonStreaming m rpc
-> ServerHandler' 'NonStreaming m rpc
(Input rpc -> m (Output rpc)) -> ServerHandler' 'NonStreaming m rpc
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
SupportsStreamingType rpc styp =>
Handler 'Server styp m rpc -> ServerHandler' styp m rpc
ServerHandler

mkClientStreaming :: forall rpc m.
     SupportsStreamingType rpc ClientStreaming
  => (    IO (NextElem (Input rpc))
       -> m (Output rpc)
     )
  -> ServerHandler' ClientStreaming m rpc
mkClientStreaming :: forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'ClientStreaming =>
(IO (NextElem (Input rpc)) -> m (Output rpc))
-> ServerHandler' 'ClientStreaming m rpc
mkClientStreaming = Handler 'Server 'ClientStreaming m rpc
-> ServerHandler' 'ClientStreaming m rpc
Positive m (Recv (Input rpc)) (Output rpc)
-> ServerHandler' 'ClientStreaming m rpc
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
SupportsStreamingType rpc styp =>
Handler 'Server styp m rpc -> ServerHandler' styp m rpc
ServerHandler

mkServerStreaming :: forall rpc m.
     SupportsStreamingType rpc ServerStreaming
  => (    Input rpc
       -> (NextElem (Output rpc) -> IO ())
       -> m ()
     )
  -> ServerHandler' ServerStreaming m rpc
mkServerStreaming :: forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'ServerStreaming =>
(Input rpc -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'ServerStreaming m rpc
mkServerStreaming = Handler 'Server 'ServerStreaming m rpc
-> ServerHandler' 'ServerStreaming m rpc
(Input rpc -> Positive m (Send (Output rpc)) ())
-> ServerHandler' 'ServerStreaming m rpc
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
SupportsStreamingType rpc styp =>
Handler 'Server styp m rpc -> ServerHandler' styp m rpc
ServerHandler

mkBiDiStreaming :: forall rpc m.
     SupportsStreamingType rpc BiDiStreaming
  => (    IO (NextElem (Input rpc))
       -> (NextElem (Output rpc) -> IO ())
       -> m ()
     )
  -> ServerHandler' BiDiStreaming m rpc
mkBiDiStreaming :: forall {k} (rpc :: k) (m :: * -> *).
SupportsStreamingType rpc 'BiDiStreaming =>
(IO (NextElem (Input rpc))
 -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'BiDiStreaming m rpc
mkBiDiStreaming = Handler 'Server 'BiDiStreaming m rpc
-> ServerHandler' 'BiDiStreaming m rpc
Positive
  m (IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ()) ()
-> ServerHandler' 'BiDiStreaming m rpc
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
SupportsStreamingType rpc styp =>
Handler 'Server styp m rpc -> ServerHandler' styp m rpc
ServerHandler (Positive
   m (IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ()) ()
 -> ServerHandler' 'BiDiStreaming m rpc)
-> ((IO (NextElem (Input rpc))
     -> (NextElem (Output rpc) -> IO ()) -> m ())
    -> Positive
         m (IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ()) ())
-> (IO (NextElem (Input rpc))
    -> (NextElem (Output rpc) -> IO ()) -> m ())
-> ServerHandler' 'BiDiStreaming m rpc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IO (NextElem (Input rpc))
 -> (NextElem (Output rpc) -> IO ()) -> m ())
-> Positive
     m (IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ()) ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry

{-------------------------------------------------------------------------------
  Run server handler (used internally only)
-------------------------------------------------------------------------------}

nonStreaming ::
     ServerHandler' NonStreaming m rpc
  -> Input rpc
  -> m (Output rpc)
nonStreaming :: forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'NonStreaming m rpc -> Input rpc -> m (Output rpc)
nonStreaming (ServerHandler Handler 'Server 'NonStreaming m rpc
h) = Handler 'Server 'NonStreaming m rpc
Input rpc -> m (Output rpc)
h

clientStreaming ::
     ServerHandler' ClientStreaming m rpc
  -> IO (NextElem (Input rpc))
  -> m (Output rpc)
clientStreaming :: forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'ClientStreaming m rpc
-> IO (NextElem (Input rpc)) -> m (Output rpc)
clientStreaming (ServerHandler Handler 'Server 'ClientStreaming m rpc
h) = Handler 'Server 'ClientStreaming m rpc
Positive m (Recv (Input rpc)) (Output rpc)
h

serverStreaming ::
     ServerHandler' ServerStreaming m rpc
  -> Input rpc
  -> (NextElem (Output rpc) -> IO ())
  -> m ()
serverStreaming :: forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'ServerStreaming m rpc
-> Input rpc -> (NextElem (Output rpc) -> IO ()) -> m ()
serverStreaming (ServerHandler Handler 'Server 'ServerStreaming m rpc
h) = Handler 'Server 'ServerStreaming m rpc
Input rpc -> Positive m (Send (Output rpc)) ()
h

biDiStreaming ::
    ServerHandler' BiDiStreaming m rpc
 -> IO (NextElem (Input rpc))
 -> (NextElem (Output rpc) -> IO ())
 -> m ()
biDiStreaming :: forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'BiDiStreaming m rpc
-> IO (NextElem (Input rpc))
-> (NextElem (Output rpc) -> IO ())
-> m ()
biDiStreaming (ServerHandler Handler 'Server 'BiDiStreaming m rpc
h) = ((IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ())
 -> m ())
-> IO (NextElem (Input rpc))
-> (NextElem (Output rpc) -> IO ())
-> m ()
forall a b c. ((a, b) -> c) -> a -> b -> c
curry Handler 'Server 'BiDiStreaming m rpc
(IO (NextElem (Input rpc)), NextElem (Output rpc) -> IO ()) -> m ()
h

{-------------------------------------------------------------------------------
  Construct 'RpcHandler'
-------------------------------------------------------------------------------}

class FromStreamingHandler (styp :: StreamingType) where
  -- | Construct 'RpcHandler' from streaming type specific handler
  --
  -- Most applications will probably not need to call this function directly,
  -- instead relying on 'fromMethods'\/'fromServices'. If however you want to
  -- construct a list of 'RpcHandler's manually, without a type-level
  -- specification of the server's API, you can use 'fromStreamingHandler'.
  fromStreamingHandler :: forall k (rpc :: k) m.
        ( SupportsServerRpc rpc
        , Default (ResponseInitialMetadata rpc)
        , Default (ResponseTrailingMetadata rpc)
        , MonadIO m
        )
     => ServerHandler' styp m rpc -> RpcHandler m rpc

instance FromStreamingHandler NonStreaming where
  fromStreamingHandler :: forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' 'NonStreaming m rpc -> RpcHandler m rpc
fromStreamingHandler ServerHandler' 'NonStreaming m rpc
h = (Call rpc -> m ()) -> RpcHandler m rpc
forall {k} (rpc :: k) (m :: * -> *).
(Default (ResponseInitialMetadata rpc), MonadIO m) =>
(Call rpc -> m ()) -> RpcHandler m rpc
mkRpcHandler ((Call rpc -> m ()) -> RpcHandler m rpc)
-> (Call rpc -> m ()) -> RpcHandler m rpc
forall a b. (a -> b) -> a -> b
$ \Call rpc
call -> do
      inp <- IO (Input rpc) -> m (Input rpc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Input rpc) -> m (Input rpc))
-> IO (Input rpc) -> m (Input rpc)
forall a b. (a -> b) -> a -> b
$ Call rpc -> IO (Input rpc)
forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc)
recvFinalInput Call rpc
call
      out <- nonStreaming h inp
      liftIO $ sendFinalOutput call (out, def)

instance FromStreamingHandler ClientStreaming where
  fromStreamingHandler :: forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' 'ClientStreaming m rpc -> RpcHandler m rpc
fromStreamingHandler ServerHandler' 'ClientStreaming m rpc
h = (Call rpc -> m ()) -> RpcHandler m rpc
forall {k} (rpc :: k) (m :: * -> *).
(Default (ResponseInitialMetadata rpc), MonadIO m) =>
(Call rpc -> m ()) -> RpcHandler m rpc
mkRpcHandler ((Call rpc -> m ()) -> RpcHandler m rpc)
-> (Call rpc -> m ()) -> RpcHandler m rpc
forall a b. (a -> b) -> a -> b
$ \Call rpc
call -> do
      out <- ServerHandler' 'ClientStreaming m rpc
-> IO (NextElem (Input rpc)) -> m (Output rpc)
forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'ClientStreaming m rpc
-> IO (NextElem (Input rpc)) -> m (Output rpc)
clientStreaming ServerHandler' 'ClientStreaming m rpc
h (IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc)))
-> IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc))
forall a b. (a -> b) -> a -> b
$ Call rpc -> IO (NextElem (Input rpc))
forall {k} (rpc :: k).
HasCallStack =>
Call rpc -> IO (NextElem (Input rpc))
recvNextInputElem Call rpc
call)
      liftIO $ sendFinalOutput call (out, def)

instance FromStreamingHandler ServerStreaming where
  fromStreamingHandler :: forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' 'ServerStreaming m rpc -> RpcHandler m rpc
fromStreamingHandler ServerHandler' 'ServerStreaming m rpc
h = (Call rpc -> m ()) -> RpcHandler m rpc
forall {k} (rpc :: k) (m :: * -> *).
(Default (ResponseInitialMetadata rpc), MonadIO m) =>
(Call rpc -> m ()) -> RpcHandler m rpc
mkRpcHandler ((Call rpc -> m ()) -> RpcHandler m rpc)
-> (Call rpc -> m ()) -> RpcHandler m rpc
forall a b. (a -> b) -> a -> b
$ \Call rpc
call -> do
      inp <- IO (Input rpc) -> m (Input rpc)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Input rpc) -> m (Input rpc))
-> IO (Input rpc) -> m (Input rpc)
forall a b. (a -> b) -> a -> b
$ Call rpc -> IO (Input rpc)
forall {k} (rpc :: k). HasCallStack => Call rpc -> IO (Input rpc)
recvFinalInput Call rpc
call
      serverStreaming h inp (liftIO . sendOutput call . fromNextElem call)

instance FromStreamingHandler BiDiStreaming where
  fromStreamingHandler :: forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' 'BiDiStreaming m rpc -> RpcHandler m rpc
fromStreamingHandler ServerHandler' 'BiDiStreaming m rpc
h = (Call rpc -> m ()) -> RpcHandler m rpc
forall {k} (rpc :: k) (m :: * -> *).
(Default (ResponseInitialMetadata rpc), MonadIO m) =>
(Call rpc -> m ()) -> RpcHandler m rpc
mkRpcHandler ((Call rpc -> m ()) -> RpcHandler m rpc)
-> (Call rpc -> m ()) -> RpcHandler m rpc
forall a b. (a -> b) -> a -> b
$ \Call rpc
call -> do
      ServerHandler' 'BiDiStreaming m rpc
-> IO (NextElem (Input rpc))
-> (NextElem (Output rpc) -> IO ())
-> m ()
forall {k} (m :: * -> *) (rpc :: k).
ServerHandler' 'BiDiStreaming m rpc
-> IO (NextElem (Input rpc))
-> (NextElem (Output rpc) -> IO ())
-> m ()
biDiStreaming ServerHandler' 'BiDiStreaming m rpc
h
        (IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc))
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc)))
-> IO (NextElem (Input rpc)) -> IO (NextElem (Input rpc))
forall a b. (a -> b) -> a -> b
$ Call rpc -> IO (NextElem (Input rpc))
forall {k} (rpc :: k).
HasCallStack =>
Call rpc -> IO (NextElem (Input rpc))
recvNextInputElem Call rpc
call)
        (IO () -> IO ()
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ())
-> (NextElem (Output rpc) -> IO ())
-> NextElem (Output rpc)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Call rpc
-> StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO ()
forall {k} (rpc :: k).
HasCallStack =>
Call rpc
-> StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO ()
sendOutput Call rpc
call (StreamElem (ResponseTrailingMetadata rpc) (Output rpc) -> IO ())
-> (NextElem (Output rpc)
    -> StreamElem (ResponseTrailingMetadata rpc) (Output rpc))
-> NextElem (Output rpc)
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Call rpc
-> NextElem (Output rpc)
-> StreamElem (ResponseTrailingMetadata rpc) (Output rpc)
forall {k} (rpc :: k) (proxy :: k -> *) out.
Default (ResponseTrailingMetadata rpc) =>
proxy rpc
-> NextElem out -> StreamElem (ResponseTrailingMetadata rpc) out
fromNextElem Call rpc
call)

{-------------------------------------------------------------------------------
  Internal: dealing with metadata
-------------------------------------------------------------------------------}

fromNextElem ::
     Default (ResponseTrailingMetadata rpc)
  => proxy rpc
  -> NextElem out
  -> StreamElem (ResponseTrailingMetadata rpc) out
fromNextElem :: forall {k} (rpc :: k) (proxy :: k -> *) out.
Default (ResponseTrailingMetadata rpc) =>
proxy rpc
-> NextElem out -> StreamElem (ResponseTrailingMetadata rpc) out
fromNextElem proxy rpc
_ = ResponseTrailingMetadata rpc
-> NextElem out -> StreamElem (ResponseTrailingMetadata rpc) out
forall b a. b -> NextElem a -> StreamElem b a
NextElem.toStreamElem ResponseTrailingMetadata rpc
forall a. Default a => a
def

{-------------------------------------------------------------------------------
  Methods
-------------------------------------------------------------------------------}

-- | Declare handlers for a set of RPCs
--
-- See also 'simpleMethods' for an alternative API if you only need the 'Method'
-- constructor.
--
-- == Example usage
--
-- Example that provides methods for the gRPC
-- [RouteGuide](https://grpc.io/docs/languages/python/basics/) API:
--
-- > handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide)
-- > handlers db =
-- >      Method (mkNonStreaming    $ getFeature   db)
-- >    $ Method (mkServerStreaming $ listFeatures db)
-- >    $ Method (mkClientStreaming $ recordRoute  db)
-- >    $ Method (mkBiDiStreaming   $ routeChat    db)
-- >    $ NoMoreMethods
--
-- It is also possibly to define your own list of RPC, instead of computing it
-- using @ProtobufMethodsOf@ (indeed, there is no need to use Protobuf at all).
--
-- == Taking advantage of type inference
--
-- Provided that you give a top-level type annotation, then type inference can
-- guide this definition:
--
-- > handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide)
-- > handlers db = _methods
--
-- This will reveal that we need four methods:
--
-- > _methods :: Methods IO '[
-- >     Protobuf RouteGuide "getFeature"
-- >   , Protobuf RouteGuide "listFeatures"
-- >   , Protobuf RouteGuide "recordRoute"
-- >   , Protobuf RouteGuide "routeChat"
-- >   ]
--
-- We can use this to make a skeleton definition, with holes for each handler:
--
-- > handlers :: [Feature] -> Methods IO (ProtobufMethodsOf RouteGuide)
-- > handlers db =
-- >       Method _getFeature
-- >     $ Method _listFeatures
-- >     $ Method _recordRoute
-- >     $ Method _routeChar
-- >     $ NoMoreMethods
--
-- This will reveal types such as this:
--
-- > _getFeature :: ServerHandler' NonStreaming IO (Protobuf RouteGuide "getFeature")
--
-- which we can simplify to
--
-- > _getFeature :: ServerHandler IO (Protobuf RouteGuide "getFeature")
--
-- (the non-primed version of 'ServerHandler' infers the streaming type from
-- the RPC, when possible). Finally, if we then refine the skeleton to
--
-- > Method (mkNonStreaming $ _getFeature)
--
-- ghc will tell us
--
-- > _getFeature :: Proto Point -> IO (Proto Feature)
data Methods (m :: Type -> Type) (rpcs :: [k]) where
  -- | All methods of the service handled
  NoMoreMethods :: Methods m '[]

  -- | Define the next method of the service, inferring the streaming type
  --
  -- In the most common case (Protobuf), the streaming type can be inferred
  -- from the method. In this case, it is convenient to use 'Method', as type
  -- inference will tell you what kind of handler you need to define (see also
  -- the example above).
  Method ::
       ( SupportsServerRpc rpc
       , Default (ResponseInitialMetadata rpc)
       , Default (ResponseTrailingMetadata rpc)
       , SupportsStreamingType rpc styp
       )
    => ServerHandler' styp m rpc
    -> Methods m rpcs
    -> Methods m (rpc ': rpcs)

  -- | Define a method that uses uses the raw (core) API instead
  --
  -- This is useful when the communication pattern does not fall neatly into the
  -- four streaming types (non-streaming, client-side streaming, server-side
  -- streaming, or bidirectional streaming), or when you need access to lower
  -- level features such as request or response metadata, compression options,
  -- etc.
  RawMethod ::
       SupportsServerRpc rpc
    => RpcHandler m rpc
    -> Methods m rpcs
    -> Methods m (rpc ': rpcs)

  -- | Declare that this particular @rpc@ method is not supported by this server
  UnsupportedMethod ::
       Methods m rpcs
    -> Methods m (rpc ': rpcs)

-- | Declare handlers for a set of services
--
-- See also 'fromServices'.
--
-- Example usage:
--
-- > services :: [Feature] -> Services IO (ProtobufServices '[Greeter, RouteGuide])
-- > services db =
-- >       Service Greeter.handlers
-- >     $ Service (RouteGuide.handlers db)
-- >     $ NoMoreServices
data Services m (servs :: [[k]]) where
  NoMoreServices :: Services m '[]

  Service ::
       Methods m serv
    -> Services m servs
    -> Services m (serv : servs)

-- | Construct 'SomeRpcHandler' from a streaming handler
--
-- Most users will not need to call this function, but it can occassionally be
-- useful when using the lower-level API. Depending on usage you may need to
-- provide a type argument to fix the @rpc@, for example
--
-- > Server.fromMethod @EmptyCall $ ServerHandler $ \(_ ::Empty) ->
-- >   return (defMessage :: Empty)
--
-- If the streaming type cannot be deduced, you might need to specify that also:
--
-- > Server.fromMethod @Ping @NonStreaming $ ServerHandler $ ..
--
-- Alternatively, use one of the handler construction functions, such as
--
-- > Server.fromMethod @Ping $ Server.mkNonStreaming $ ..
fromMethod :: forall rpc styp m.
     ( SupportsServerRpc rpc
     , ValidStreamingType styp
     , Default (ResponseInitialMetadata rpc)
     , Default (ResponseTrailingMetadata rpc)
     , MonadIO m
     )
  => ServerHandler' styp m rpc -> SomeRpcHandler m
fromMethod :: forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
(SupportsServerRpc rpc, ValidStreamingType styp,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> SomeRpcHandler m
fromMethod =
    case Proxy styp -> SStreamingType styp
forall (styp :: StreamingType).
ValidStreamingType styp =>
Proxy styp -> SStreamingType styp
validStreamingType (forall {k} (t :: k). Proxy t
forall (t :: StreamingType). Proxy t
Proxy @styp) of
      SStreamingType styp
SNonStreaming    -> RpcHandler m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (m :: * -> *).
SupportsServerRpc rpc =>
RpcHandler m rpc -> SomeRpcHandler m
someRpcHandler (RpcHandler m rpc -> SomeRpcHandler m)
-> (ServerHandler' styp m rpc -> RpcHandler m rpc)
-> ServerHandler' styp m rpc
-> SomeRpcHandler m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' styp m rpc -> RpcHandler m rpc
forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
forall (styp :: StreamingType) k (rpc :: k) (m :: * -> *).
(FromStreamingHandler styp, SupportsServerRpc rpc,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
fromStreamingHandler
      SStreamingType styp
SClientStreaming -> RpcHandler m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (m :: * -> *).
SupportsServerRpc rpc =>
RpcHandler m rpc -> SomeRpcHandler m
someRpcHandler (RpcHandler m rpc -> SomeRpcHandler m)
-> (ServerHandler' styp m rpc -> RpcHandler m rpc)
-> ServerHandler' styp m rpc
-> SomeRpcHandler m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' styp m rpc -> RpcHandler m rpc
forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
forall (styp :: StreamingType) k (rpc :: k) (m :: * -> *).
(FromStreamingHandler styp, SupportsServerRpc rpc,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
fromStreamingHandler
      SStreamingType styp
SServerStreaming -> RpcHandler m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (m :: * -> *).
SupportsServerRpc rpc =>
RpcHandler m rpc -> SomeRpcHandler m
someRpcHandler (RpcHandler m rpc -> SomeRpcHandler m)
-> (ServerHandler' styp m rpc -> RpcHandler m rpc)
-> ServerHandler' styp m rpc
-> SomeRpcHandler m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' styp m rpc -> RpcHandler m rpc
forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
forall (styp :: StreamingType) k (rpc :: k) (m :: * -> *).
(FromStreamingHandler styp, SupportsServerRpc rpc,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
fromStreamingHandler
      SStreamingType styp
SBiDiStreaming   -> RpcHandler m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (m :: * -> *).
SupportsServerRpc rpc =>
RpcHandler m rpc -> SomeRpcHandler m
someRpcHandler (RpcHandler m rpc -> SomeRpcHandler m)
-> (ServerHandler' styp m rpc -> RpcHandler m rpc)
-> ServerHandler' styp m rpc
-> SomeRpcHandler m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' styp m rpc -> RpcHandler m rpc
forall k (rpc :: k) (m :: * -> *).
(SupportsServerRpc rpc, Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
forall (styp :: StreamingType) k (rpc :: k) (m :: * -> *).
(FromStreamingHandler styp, SupportsServerRpc rpc,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> RpcHandler m rpc
fromStreamingHandler

-- | List handlers for all methods of a given service.
--
-- This can be used to verify at the type level that all methods of the given
-- service are handled. A typical definition of the 'Methods' might have a type
-- such as this:
--
-- > methods :: Methods IO (ProtobufMethodsOf RouteGuide)
--
-- See also 'fromServices' if you are defining more than one service.
fromMethods :: forall m rpcs.
     MonadIO m
  => Methods m rpcs -> [SomeRpcHandler m]
fromMethods :: forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods = Methods m rpcs -> [SomeRpcHandler m]
forall {k} (rpcs' :: [k]). Methods m rpcs' -> [SomeRpcHandler m]
go
  where
    go :: Methods m rpcs' -> [SomeRpcHandler m]
    go :: forall {k} (rpcs' :: [k]). Methods m rpcs' -> [SomeRpcHandler m]
go Methods m rpcs'
NoMoreMethods          = []
    go (Method ServerHandler' styp m rpc
m Methods m rpcs
ms)          = ServerHandler' styp m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (styp :: StreamingType) (m :: * -> *).
(SupportsServerRpc rpc, ValidStreamingType styp,
 Default (ResponseInitialMetadata rpc),
 Default (ResponseTrailingMetadata rpc), MonadIO m) =>
ServerHandler' styp m rpc -> SomeRpcHandler m
fromMethod     ServerHandler' styp m rpc
m SomeRpcHandler m -> [SomeRpcHandler m] -> [SomeRpcHandler m]
forall a. a -> [a] -> [a]
: Methods m rpcs -> [SomeRpcHandler m]
forall {k} (rpcs' :: [k]). Methods m rpcs' -> [SomeRpcHandler m]
go Methods m rpcs
ms
    go (RawMethod RpcHandler m rpc
m Methods m rpcs
ms)       = RpcHandler m rpc -> SomeRpcHandler m
forall {k} (rpc :: k) (m :: * -> *).
SupportsServerRpc rpc =>
RpcHandler m rpc -> SomeRpcHandler m
someRpcHandler RpcHandler m rpc
m SomeRpcHandler m -> [SomeRpcHandler m] -> [SomeRpcHandler m]
forall a. a -> [a] -> [a]
: Methods m rpcs -> [SomeRpcHandler m]
forall {k} (rpcs' :: [k]). Methods m rpcs' -> [SomeRpcHandler m]
go Methods m rpcs
ms
    go (UnsupportedMethod Methods m rpcs
ms) =                    Methods m rpcs -> [SomeRpcHandler m]
forall {k} (rpcs' :: [k]). Methods m rpcs' -> [SomeRpcHandler m]
go Methods m rpcs
ms

-- | List handlers for all methods of all services.
--
-- This can be used to verify at the type level that all methods of all services
-- are handled. A typical definition of the 'Services' might have a type such as
-- this:
--
-- > services :: Services IO (ProtobufServices '[Greeter, RouteGuide])
--
-- See also 'fromMethods' if you are only defining one service.
fromServices :: forall m servs.
     MonadIO m
  => Services m servs -> [SomeRpcHandler m]
fromServices :: forall {k} (m :: * -> *) (servs :: [[k]]).
MonadIO m =>
Services m servs -> [SomeRpcHandler m]
fromServices = [[SomeRpcHandler m]] -> [SomeRpcHandler m]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[SomeRpcHandler m]] -> [SomeRpcHandler m])
-> (Services m servs -> [[SomeRpcHandler m]])
-> Services m servs
-> [SomeRpcHandler m]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Services m servs -> [[SomeRpcHandler m]]
forall {k} (servs' :: [[k]]).
Services m servs' -> [[SomeRpcHandler m]]
go
  where
    go :: Services m servs' -> [[SomeRpcHandler m]]
    go :: forall {k} (servs' :: [[k]]).
Services m servs' -> [[SomeRpcHandler m]]
go Services m servs'
NoMoreServices = []
    go (Service Methods m serv
s Services m servs
ss) = Methods m serv -> [SomeRpcHandler m]
forall {k} (m :: * -> *) (rpcs :: [k]).
MonadIO m =>
Methods m rpcs -> [SomeRpcHandler m]
fromMethods Methods m serv
s [SomeRpcHandler m] -> [[SomeRpcHandler m]] -> [[SomeRpcHandler m]]
forall a. a -> [a] -> [a]
: Services m servs -> [[SomeRpcHandler m]]
forall {k} (servs' :: [[k]]).
Services m servs' -> [[SomeRpcHandler m]]
go Services m servs
ss

{-------------------------------------------------------------------------------
  Hoisting
-------------------------------------------------------------------------------}

hoistMethods :: forall m n rpcs.
     (forall a. m a -> n a)
  -> Methods m rpcs
  -> Methods n rpcs
hoistMethods :: forall {k} (m :: * -> *) (n :: * -> *) (rpcs :: [k]).
(forall a. m a -> n a) -> Methods m rpcs -> Methods n rpcs
hoistMethods forall a. m a -> n a
f = Methods m rpcs -> Methods n rpcs
forall {k} (rpcs' :: [k]). Methods m rpcs' -> Methods n rpcs'
go
  where
    go :: forall rpcs'. Methods m rpcs' -> Methods n rpcs'
    go :: forall {k} (rpcs' :: [k]). Methods m rpcs' -> Methods n rpcs'
go Methods m rpcs'
NoMoreMethods          = Methods n rpcs'
Methods n '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods
    go (Method          ServerHandler' styp m rpc
h Methods m rpcs
ms) = ServerHandler' styp n rpc
-> Methods n rpcs -> Methods n (rpc : rpcs)
forall {k} (serv :: k) (servs :: StreamingType) (m :: * -> *)
       (rpcs :: [k]).
(SupportsServerRpc serv, Default (ResponseInitialMetadata serv),
 Default (ResponseTrailingMetadata serv),
 SupportsStreamingType serv servs) =>
ServerHandler' servs m serv
-> Methods m rpcs -> Methods m (serv : rpcs)
Method ((forall a. m a -> n a)
-> ServerHandler' styp m rpc -> ServerHandler' styp n rpc
forall {k} (styp :: StreamingType) (m :: * -> *) (n :: * -> *)
       (rpc :: k).
ValidStreamingType styp =>
(forall a. m a -> n a)
-> ServerHandler' styp m rpc -> ServerHandler' styp n rpc
hoistServerHandler m a -> n a
forall a. m a -> n a
f ServerHandler' styp m rpc
h) (Methods m rpcs -> Methods n rpcs
forall {k} (rpcs' :: [k]). Methods m rpcs' -> Methods n rpcs'
go Methods m rpcs
ms)
    go (RawMethod       RpcHandler m rpc
h Methods m rpcs
ms) = RpcHandler n rpc -> Methods n rpcs -> Methods n (rpc : rpcs)
forall {k} (serv :: k) (m :: * -> *) (servs :: [k]).
SupportsServerRpc serv =>
RpcHandler m serv -> Methods m servs -> Methods m (serv : servs)
RawMethod ((forall a. m a -> n a) -> RpcHandler m rpc -> RpcHandler n rpc
forall {k} (m :: * -> *) (n :: * -> *) (rpc :: k).
(forall a. m a -> n a) -> RpcHandler m rpc -> RpcHandler n rpc
hoistRpcHandler m a -> n a
forall a. m a -> n a
f RpcHandler m rpc
h) (Methods m rpcs -> Methods n rpcs
forall {k} (rpcs' :: [k]). Methods m rpcs' -> Methods n rpcs'
go Methods m rpcs
ms)
    go (UnsupportedMethod Methods m rpcs
ms) = Methods n rpcs -> Methods n (rpc : rpcs)
forall {k} (m :: * -> *) (serv :: [k]) (servs :: k).
Methods m serv -> Methods m (servs : serv)
UnsupportedMethod (Methods m rpcs -> Methods n rpcs
forall {k} (rpcs' :: [k]). Methods m rpcs' -> Methods n rpcs'
go Methods m rpcs
ms)

hoistServices :: forall m n servs.
     (forall a. m a -> n a)
  -> Services m servs
  -> Services n servs
hoistServices :: forall {k} (m :: * -> *) (n :: * -> *) (servs :: [[k]]).
(forall a. m a -> n a) -> Services m servs -> Services n servs
hoistServices forall a. m a -> n a
f = Services m servs -> Services n servs
forall {k} (servs' :: [[k]]).
Services m servs' -> Services n servs'
go
  where
    go :: forall servs'. Services m servs' -> Services n servs'
    go :: forall {k} (servs' :: [[k]]).
Services m servs' -> Services n servs'
go Services m servs'
NoMoreServices = Services n servs'
Services n '[]
forall {k} (m :: * -> *). Services m '[]
NoMoreServices
    go (Service Methods m serv
s Services m servs
ss) = Methods n serv -> Services n servs -> Services n (serv : servs)
forall {k} (m :: * -> *) (serv :: [k]) (servs :: [[k]]).
Methods m serv -> Services m servs -> Services m (serv : servs)
Service ((forall a. m a -> n a) -> Methods m serv -> Methods n serv
forall {k} (m :: * -> *) (n :: * -> *) (rpcs :: [k]).
(forall a. m a -> n a) -> Methods m rpcs -> Methods n rpcs
hoistMethods m a -> n a
forall a. m a -> n a
f Methods m serv
s) (Services m servs -> Services n servs
forall {k} (servs' :: [[k]]).
Services m servs' -> Services n servs'
go Services m servs
ss)

{-------------------------------------------------------------------------------
  Varargs API
-------------------------------------------------------------------------------}

class SimpleMethods m (rpcs :: [k]) (rpcs' :: [k]) a | a -> m rpcs rpcs' where
  simpleMethods' :: (Methods m rpcs -> Methods m rpcs') -> a

instance SimpleMethods m '[] rpcs (Methods m rpcs) where
  simpleMethods' :: (Methods m '[] -> Methods m rpcs) -> Methods m rpcs
simpleMethods' Methods m '[] -> Methods m rpcs
f = Methods m '[] -> Methods m rpcs
f Methods m '[]
forall {k} (m :: * -> *). Methods m '[]
NoMoreMethods

instance
    ( -- Requirements inherited from the 'Method' constructor
      SupportsServerRpc rpc
    , Default (ResponseInitialMetadata rpc)
    , Default (ResponseTrailingMetadata rpc)
    , SupportsStreamingType rpc (RpcStreamingType rpc)
      -- Requirements for the vararg construction
    , b ~ ServerHandler' (RpcStreamingType rpc) m rpc
    , SimpleMethods m rpcs rpcs' a
    ) => SimpleMethods m (rpc : rpcs) rpcs' (b -> a) where
  simpleMethods' :: (Methods m (rpc : rpcs) -> Methods m rpcs') -> b -> a
simpleMethods' Methods m (rpc : rpcs) -> Methods m rpcs'
f b
h = (Methods m rpcs -> Methods m rpcs') -> a
forall k (m :: * -> *) (rpcs :: [k]) (rpcs' :: [k]) a.
SimpleMethods m rpcs rpcs' a =>
(Methods m rpcs -> Methods m rpcs') -> a
simpleMethods' (Methods m (rpc : rpcs) -> Methods m rpcs'
f (Methods m (rpc : rpcs) -> Methods m rpcs')
-> (Methods m rpcs -> Methods m (rpc : rpcs))
-> Methods m rpcs
-> Methods m rpcs'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ServerHandler' (RpcStreamingType rpc) m rpc
-> Methods m rpcs -> Methods m (rpc : rpcs)
forall {k} (serv :: k) (servs :: StreamingType) (m :: * -> *)
       (rpcs :: [k]).
(SupportsServerRpc serv, Default (ResponseInitialMetadata serv),
 Default (ResponseTrailingMetadata serv),
 SupportsStreamingType serv servs) =>
ServerHandler' servs m serv
-> Methods m rpcs -> Methods m (serv : rpcs)
Method b
ServerHandler' (RpcStreamingType rpc) m rpc
h)

-- | Alternative way to construct 'Methods'
--
-- == Example usage
--
-- Listing the handlers for the gRPC routeguide server using 'Methods' directly
-- looks like this:
--
-- >   Method (mkNonStreaming    $ getFeature   db)
-- > $ Method (mkServerStreaming $ listFeatures db)
-- > $ Method (mkClientStreaming $ recordRoute  db)
-- > $ Method (mkBiDiStreaming   $ routeChat    db)
-- > $ NoMoreMethods
--
-- Since we only use 'Method' here, we can instead write this as
--
-- > simpleMethods
-- >   (mkNonStreaming    $ getFeature   db)
-- >   (mkServerStreaming $ listFeatures db)
-- >   (mkClientStreaming $ recordRoute  db)
-- >   (mkBiDiStreaming   $ routeChat    db)
--
-- Which API you prefer is mostly just a matter of taste.
simpleMethods :: SimpleMethods m rpcs rpcs a => a
simpleMethods :: forall {k} (m :: * -> *) (rpcs :: [k]) a.
SimpleMethods m rpcs rpcs a =>
a
simpleMethods = (Methods m rpcs -> Methods m rpcs) -> a
forall k (m :: * -> *) (rpcs :: [k]) (rpcs' :: [k]) a.
SimpleMethods m rpcs rpcs' a =>
(Methods m rpcs -> Methods m rpcs') -> a
simpleMethods' Methods m rpcs -> Methods m rpcs
forall a. a -> a
id