{-# language AllowAmbiguousTypes       #-}
{-# language CPP                       #-}
{-# language ConstraintKinds           #-}
{-# language DataKinds                 #-}
{-# language ExistentialQuantification #-}
{-# language FlexibleContexts          #-}
{-# language FlexibleInstances         #-}
{-# language FunctionalDependencies    #-}
{-# language GADTs                     #-}
{-# language PatternSynonyms           #-}
{-# language PolyKinds                 #-}
{-# language RankNTypes                #-}
{-# language ScopedTypeVariables       #-}
{-# language TypeApplications          #-}
{-# language TypeFamilies              #-}
{-# language TypeOperators             #-}
{-# language UndecidableInstances      #-}
{-# language ViewPatterns              #-}
{-|
Description : Protocol-independent declaration of servers.

A server (represented by 'ServerT') is a sequence
of handlers (represented by 'HandlersT'), one for each
operation in the corresponding Mu service declaration.

In general, you can declare a server by naming
each of the methods with their handlers:

> server :: MonadServer m => ServerT MyService m _
> server = singleService ( method @"m1" h1
>                        , method @"m2" h2
>                        , ... )

or by position:

> server :: MonadServer m => ServerT MyService m _
> server = Server (h1 :<|>: h2 :<|>: ... :<|>: H0)

where each of @h1@, @h2@, ... handles each method in
@MyService@ /in the order they were declared/.

In both cases, the @_@ in the type allows GHC to fill
in the boring and long type you would need to write
there otherwise.

/Implementation note/: exceptions raised in handlers
produce an error to be sent as response to the client.
We recommend you to catch exceptions and return custom
'ServerError's instead.
-}
module Mu.Server (
  -- * Servers and handlers
  MonadServer, ServiceChain, noContext
, wrapServer
  -- ** Definitions by name
, singleService
, method, methodWithInfo
, resolver, object, union
, field, fieldWithInfo
, UnionChoice(..), unionChoice
, NamedList(..)
  -- ** Definitions by position
, SingleServerT, pattern Server
, ServerT(..), ServicesT(..), ServiceT(..), HandlersT(.., (:<||>:), (:<|>:))
  -- ** Simple servers using only IO
, ServerErrorIO, ServerIO
  -- * Errors which might be raised
, serverError, ServerError(..), ServerErrorCode(..)
  -- ** Useful when you do not want to deal with errors
, alwaysOk
  -- * For internal use
, Handles, FromRef, ToRef
) where

import           Control.Exception    (Exception)
import           Control.Monad.Except
import           Data.Conduit
import           Data.Kind
import           Data.Typeable
import           GHC.TypeLits

import           Mu.Rpc
import           Mu.Schema

#if __GLASGOW_HASKELL__ < 808
import           Unsafe.Coerce        (unsafeCoerce)
#endif

-- | Constraint for monads that can be used as servers
type MonadServer m = (MonadError ServerError m, MonadIO m)
-- | Simplest monad which satisfies 'MonadServer'.
type ServerErrorIO = ExceptT ServerError IO

-- | Simple 'ServerT' which uses only 'IO' and errors,
--   and whose service has no back-references.
type ServerIO info srv = ServerT '[] info srv ServerErrorIO

-- | Stop the current handler,
--   returning an error to the client.
serverError :: (MonadError ServerError m)
            => ServerError -> m a
serverError :: ServerError -> m a
serverError = ServerError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError

-- | Wrapper for handlers which do not use errors.
--   Remember that any exception raised in 'IO'
--   is propagated to the client.
alwaysOk :: (MonadIO m)
         => IO a -> m a
alwaysOk :: IO a -> m a
alwaysOk = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO

-- | To declare that the function doesn't use
--   its context.
noContext :: b -> a1 -> a2 -> b
noContext :: b -> a1 -> a2 -> b
noContext b
x a1
_ a2
_ = b
x

-- | Errors raised in a handler.
data ServerError
  = ServerError ServerErrorCode String
  deriving Int -> ServerError -> ShowS
[ServerError] -> ShowS
ServerError -> String
(Int -> ServerError -> ShowS)
-> (ServerError -> String)
-> ([ServerError] -> ShowS)
-> Show ServerError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerError] -> ShowS
$cshowList :: [ServerError] -> ShowS
show :: ServerError -> String
$cshow :: ServerError -> String
showsPrec :: Int -> ServerError -> ShowS
$cshowsPrec :: Int -> ServerError -> ShowS
Show

instance Exception ServerError

-- | Possible types of errors.
--   Some of these are handled in a special way
--   by different transpoprt layers.
data ServerErrorCode
  = Unknown
  | Unavailable
  | Unimplemented
  | Unauthenticated
  | Internal
  | Invalid
  | NotFound
  deriving (ServerErrorCode -> ServerErrorCode -> Bool
(ServerErrorCode -> ServerErrorCode -> Bool)
-> (ServerErrorCode -> ServerErrorCode -> Bool)
-> Eq ServerErrorCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerErrorCode -> ServerErrorCode -> Bool
$c/= :: ServerErrorCode -> ServerErrorCode -> Bool
== :: ServerErrorCode -> ServerErrorCode -> Bool
$c== :: ServerErrorCode -> ServerErrorCode -> Bool
Eq, Int -> ServerErrorCode -> ShowS
[ServerErrorCode] -> ShowS
ServerErrorCode -> String
(Int -> ServerErrorCode -> ShowS)
-> (ServerErrorCode -> String)
-> ([ServerErrorCode] -> ShowS)
-> Show ServerErrorCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ServerErrorCode] -> ShowS
$cshowList :: [ServerErrorCode] -> ShowS
show :: ServerErrorCode -> String
$cshow :: ServerErrorCode -> String
showsPrec :: Int -> ServerErrorCode -> ShowS
$cshowsPrec :: Int -> ServerErrorCode -> ShowS
Show)

-- | Defines a mapping between outcome of
--   a service, and its representation as
--   Haskell type.
type ServiceChain snm = Mappings snm Type

-- | A server for a single service,
--   like most RPC ones.
type SingleServerT = ServerT '[]

-- | Definition of a complete server
--   for a set of services, with possible
--   references between them.
data ServerT (chn :: ServiceChain snm) (info :: Type)
             (s :: Package snm mnm anm (TypeRef snm))
             (m :: Type -> Type) (hs :: [[Type]]) where
  Services :: ServicesT chn info s m hs
           -> ServerT chn info ('Package pname s) m hs

pattern Server :: (MappingRight chn sname ~ ())
               => HandlersT chn info () methods m hs
               -> ServerT chn info ('Package pname '[ 'Service sname methods ]) m '[hs]
pattern $bServer :: HandlersT chn info () methods m hs
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
$mServer :: forall r serviceName mnm anm (chn :: Mappings serviceName *)
       (sname :: serviceName) info
       (methods :: [Method serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [*]) (pname :: Maybe serviceName).
(MappingRight chn sname ~ ()) =>
ServerT
  chn info ('Package pname '[ 'Service sname methods]) m '[hs]
-> (HandlersT chn info () methods m hs -> r) -> (Void# -> r) -> r
Server svr = Services (ProperSvc svr :<&>: S0)

infixr 3 :<&>:
-- | Definition of a complete server for a service.
data ServicesT (chn :: ServiceChain snm) (info :: Type)
               (s :: [Service snm mnm anm (TypeRef snm)])
               (m :: Type -> Type) (hs :: [[Type]]) where
  S0 :: ServicesT chn info '[] m '[]
  (:<&>:) :: ServiceT chn info svc m hs
          -> ServicesT chn info rest m hss
          -> ServicesT chn info (svc ': rest) m (hs ': hss)

type family InUnion (x :: k) (xs :: [k]) :: Constraint where
  InUnion x '[] = TypeError ('ShowType x ':<>: 'Text " is not part of the union")
  InUnion x (x ': xs) = ()
  InUnion x (y ': xs) = InUnion x xs

data UnionChoice chn elts where
  UnionChoice :: (InUnion elt elts, Typeable elt)
              => Proxy elt -> MappingRight chn elt
              -> UnionChoice chn elts

unionChoice :: forall elt elts chn.
               (InUnion elt elts, Typeable elt)
            => MappingRight chn elt -> UnionChoice chn elts
unionChoice :: MappingRight chn elt -> UnionChoice chn elts
unionChoice = Proxy elt -> MappingRight chn elt -> UnionChoice chn elts
forall a (elt :: a) (elts :: [a]) (chn :: Mappings a *).
(InUnion elt elts, Typeable elt) =>
Proxy elt -> MappingRight chn elt -> UnionChoice chn elts
UnionChoice (Proxy elt
forall k (t :: k). Proxy t
Proxy @elt)

-- | Definition of different kinds of services.
data ServiceT chn info svc m hs where
  ProperSvc :: HandlersT chn info (MappingRight chn sname) methods m hs
            -> ServiceT chn info ('Service sname methods) m hs
  OneOfSvc  :: (MappingRight chn sname -> m (UnionChoice chn elts))
            -> ServiceT chn info ('OneOf sname elts) m '[]

-- | 'HandlersT' is a sequence of handlers.
--   Note that the handlers for your service
--   must appear __in the same order__ as they
--   are defined.
--
--   In general you can choose any type you want
--   for your handlers, due to the following restrictions:
--
--   * Haskell types must be convertible to the
--     corresponding schema type. In other words,
--     they must implement 'FromSchema' if they are
--     inputs, and 'ToSchema' if they are outputs.
--   * Normal returns are represented by returning
--     the corresponding Haskell type.
--   * Input streams turn into @Conduit () t m ()@,
--     where @t@ is the Haskell type for that schema type.
--   * Output streams turn into an __additional argument__
--     of type @Conduit t Void m ()@. This stream should
--     be connected to a source to get the elements.
data HandlersT (chn :: ServiceChain snm) (info :: Type)
               (inh :: *) (methods :: [Method snm mnm anm (TypeRef snm)])
               (m :: Type -> Type) (hs :: [Type]) where
  H0 :: HandlersT chn info inh '[] m '[]
  Hmore :: Handles chn args ret m h
        => Proxy args -> Proxy ret
        -> (RpcInfo info -> inh -> h)
        -> HandlersT chn info inh ms m hs
        -> HandlersT chn info inh ('Method name args ret ': ms) m (h ': hs)

infixr 4 :<||>:
pattern (:<||>:) :: Handles chn args ret m h
                 => (RpcInfo info -> inh -> h) -> HandlersT chn info inh ms m hs
                 -> HandlersT chn info inh ('Method name args ret ': ms) m (h ': hs)
pattern x $b:<||>: :: (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
$m:<||>: :: forall r serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info inh (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
-> ((RpcInfo info -> inh -> h)
    -> HandlersT chn info inh ms m hs -> r)
-> (Void# -> r)
-> r
:<||>: xs <- Hmore _ _ x xs where
  RpcInfo info -> inh -> h
x :<||>: HandlersT chn info inh ms m hs
xs = Proxy args
-> Proxy ret
-> (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
forall serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info inh (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
Proxy args
-> Proxy ret
-> (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
Hmore Proxy args
forall k (t :: k). Proxy t
Proxy Proxy ret
forall k (t :: k). Proxy t
Proxy RpcInfo info -> inh -> h
x HandlersT chn info inh ms m hs
xs

infixr 4 :<|>:
pattern (:<|>:) :: (Handles chn args ret m h)
                => h -> HandlersT chn info () ms m hs
                -> HandlersT chn info () ('Method name args ret ': ms) m (h ': hs)
pattern x $b:<|>: :: h
-> HandlersT chn info () ms m hs
-> HandlersT chn info () ('Method name args ret : ms) m (h : hs)
$m:<|>: :: forall r serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
HandlersT chn info () ('Method name args ret : ms) m (h : hs)
-> (h -> HandlersT chn info () ms m hs -> r) -> (Void# -> r) -> r
:<|>: xs <- (($ ()) . ($ NoRpcInfo) -> x) :<||>: xs where
  h
x :<|>: HandlersT chn info () ms m hs
xs = h -> RpcInfo info -> () -> h
forall b a1 a2. b -> a1 -> a2 -> b
noContext h
x (RpcInfo info -> () -> h)
-> HandlersT chn info () ms m hs
-> HandlersT chn info () ('Method name args ret : ms) m (h : hs)
forall serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info inh (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
(RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
:<||>: HandlersT chn info () ms m hs
xs

-- | Defines a relation for handling.
class Handles (chn :: ServiceChain snm)
              (args :: [Argument snm anm (TypeRef snm)])
              (ret :: Return snm (TypeRef snm))
              (m :: Type -> Type) (h :: Type) where
  wrapHandler :: Proxy '(chn, m) -> Proxy args -> Proxy ret
              -> (forall a. m a -> m a) -> h -> h
-- | Defines whether a given type @t@
--   can be turned into the 'TypeRef' @ref@.
class ToRef   (chn :: ServiceChain snm)
              (ref :: TypeRef snm) (t :: Type)
-- | Defines whether a given type @t@
--   can be obtained from the 'TypeRef' @ref@.
class FromRef (chn :: ServiceChain snm)
              (ref :: TypeRef snm) (t :: Type)

-- Type references
instance t ~ s => ToRef chn ('PrimitiveRef t) s
instance ToSchema sch sty t => ToRef chn ('SchemaRef sch sty) t
instance MappingRight chn ref ~ t => ToRef chn ('ObjectRef ref) t
instance t ~ s => ToRef chn ('RegistryRef subject t last) s
instance (ToRef chn ref t, [t] ~ s) => ToRef chn ('ListRef ref) s
instance (ToRef chn ref t, Maybe t ~ s) => ToRef chn ('OptionalRef ref) s

instance t ~ s => FromRef chn ('PrimitiveRef t) s
instance FromSchema sch sty t => FromRef chn ('SchemaRef sch sty) t
instance MappingRight chn ref ~ t => FromRef chn ('ObjectRef ref) t
instance t ~ s => FromRef chn ('RegistryRef subject t last) s
instance (FromRef chn ref t, [t] ~ s) => FromRef chn ('ListRef ref) s
instance (FromRef chn ref t, Maybe t ~ s) => FromRef chn ('OptionalRef ref) s

-- Arguments
instance forall chn ref args ret m handler h t aname.
         ( FromRef chn ref t, Handles chn args ret m h
         , handler ~ (t -> h) )
         => Handles chn ('ArgSingle aname ref ': args) ret m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy ('ArgSingle aname ref : args)
-> Proxy ret
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
pchn Proxy ('ArgSingle aname ref : args)
_ Proxy ret
pr forall a. m a -> m a
f handler
h = Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
forall snm anm (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (ret :: Return snm (TypeRef snm)) (m :: * -> *) h.
Handles chn args ret m h =>
Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
wrapHandler Proxy '(chn, m)
pchn (Proxy args
forall k (t :: k). Proxy t
Proxy @args) Proxy ret
pr forall a. m a -> m a
f (h -> h) -> (t -> h) -> t -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handler
t -> h
h
instance (MonadError ServerError m, FromRef chn ref t, Handles chn args ret m h,
          handler ~ (ConduitT () t m () -> h))
         => Handles chn ('ArgStream aname ref ': args) ret m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy ('ArgStream aname ref : args)
-> Proxy ret
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
pchn Proxy ('ArgStream aname ref : args)
_ Proxy ret
pr forall a. m a -> m a
f handler
h = Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
forall snm anm (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (ret :: Return snm (TypeRef snm)) (m :: * -> *) h.
Handles chn args ret m h =>
Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
wrapHandler Proxy '(chn, m)
pchn (Proxy args
forall k (t :: k). Proxy t
Proxy @args) Proxy ret
pr forall a. m a -> m a
f (h -> h) -> (ConduitT () t m () -> h) -> ConduitT () t m () -> h
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handler
ConduitT () t m () -> h
h
-- Result with exception
instance (MonadError ServerError m, handler ~ m ())
         => Handles chn '[] 'RetNothing m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy '[]
-> Proxy 'RetNothing
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
_ Proxy '[]
_ Proxy 'RetNothing
_ forall a. m a -> m a
f handler
h = m () -> m ()
forall a. m a -> m a
f handler
m ()
h
instance ( MonadError ServerError m, ToRef chn eref e, ToRef chn vref v
         , handler ~ m (Either e v) )
         => Handles chn '[] ('RetThrows eref vref) m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy '[]
-> Proxy ('RetThrows eref vref)
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
_ Proxy '[]
_ Proxy ('RetThrows eref vref)
_ forall a. m a -> m a
f handler
h = m (Either e v) -> m (Either e v)
forall a. m a -> m a
f handler
m (Either e v)
h
instance (MonadError ServerError m, ToRef chn ref v, handler ~ m v)
         => Handles chn '[] ('RetSingle ref) m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy '[]
-> Proxy ('RetSingle ref)
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
_ Proxy '[]
_ Proxy ('RetSingle ref)
_ forall a. m a -> m a
f handler
h = m v -> m v
forall a. m a -> m a
f handler
m v
h
instance ( MonadError ServerError m, ToRef chn ref v
         , handler ~ (ConduitT v Void m () -> m ()) )
         => Handles chn '[] ('RetStream ref) m handler where
  wrapHandler :: Proxy '(chn, m)
-> Proxy '[]
-> Proxy ('RetStream ref)
-> (forall a. m a -> m a)
-> handler
-> handler
wrapHandler Proxy '(chn, m)
_ Proxy '[]
_ Proxy ('RetStream ref)
_ forall a. m a -> m a
f handler
h = m () -> m ()
forall a. m a -> m a
f (m () -> m ())
-> (ConduitT v Void m () -> m ()) -> ConduitT v Void m () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. handler
ConduitT v Void m () -> m ()
h

-- SIMPLER WAY TO DECLARE SERVICES

-- | Declares the handler for a method in the service.
--   Intended to be used with @TypeApplications@:
--
--   > method @"myMethod" myHandler
method :: forall n a p. p -> Named n (a -> () -> p)
method :: p -> Named n (a -> () -> p)
method p
f = (a -> () -> p) -> Named n (a -> () -> p)
forall k (n :: k) h. h -> Named n h
Named (\a
_ ()
_ -> p
f)

-- | Declares the handler for a method in the service,
--   which is passed additional information about the call.
--   Intended to be used with @TypeApplications@:
--
--   > methodWithInfo @"myMethod" myHandler
methodWithInfo :: forall n p info. (RpcInfo info -> p) -> Named n (RpcInfo info -> () -> p)
methodWithInfo :: (RpcInfo info -> p) -> Named n (RpcInfo info -> () -> p)
methodWithInfo RpcInfo info -> p
f = (RpcInfo info -> () -> p) -> Named n (RpcInfo info -> () -> p)
forall k (n :: k) h. h -> Named n h
Named (\RpcInfo info
x () -> RpcInfo info -> p
f RpcInfo info
x)

-- | Declares the handler for a field in an object.
--   Intended to be used with @TypeApplications@:
--
--   > field @"myField" myHandler
field :: forall n h info. h -> Named n (RpcInfo info -> h)
field :: h -> Named n (RpcInfo info -> h)
field h
f = (RpcInfo info -> h) -> Named n (RpcInfo info -> h)
forall k (n :: k) h. h -> Named n h
Named (h -> RpcInfo info -> h
forall a b. a -> b -> a
const h
f)

-- | Declares the handler for a field in an object,
--   which is passed additional information about the call.
--   Intended to be used with @TypeApplications@:
--
--   > fieldWithInfo @"myField" myHandler
fieldWithInfo :: forall n h info. (RpcInfo info -> h) -> Named n (RpcInfo info -> h)
fieldWithInfo :: (RpcInfo info -> h) -> Named n (RpcInfo info -> h)
fieldWithInfo  = (RpcInfo info -> h) -> Named n (RpcInfo info -> h)
forall k (n :: k) h. h -> Named n h
Named

-- | Defines a server for a package with a single service.
--   Intended to be used with a tuple of 'method's:
--
--   > singleService (method @"m1" h1, method @"m2" h2)
singleService
  :: ( ToNamedList p nl
     , ToHandlers chn info () methods m hs nl
     , MappingRight chn sname ~ () )
  => p -> ServerT chn info ('Package pname '[ 'Service sname methods ]) m '[hs]
singleService :: p
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
singleService p
nl = HandlersT chn info () methods m hs
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
forall serviceName mnm anm (chn :: Mappings serviceName *)
       (sname :: serviceName) info
       (methods :: [Method serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [*]) (pname :: Maybe serviceName).
(MappingRight chn sname ~ ()) =>
HandlersT chn info () methods m hs
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
Server (HandlersT chn info () methods m hs
 -> ServerT
      chn info ('Package pname '[ 'Service sname methods]) m '[hs])
-> HandlersT chn info () methods m hs
-> ServerT
     chn info ('Package pname '[ 'Service sname methods]) m '[hs]
forall a b. (a -> b) -> a -> b
$ NamedList nl -> HandlersT chn info () methods m hs
forall snm mnm anm (chn :: ServiceChain snm) info inh
       (ms :: [Method snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [*]) (nl :: [(Symbol, *)]).
ToHandlers chn info inh ms m hs nl =>
NamedList nl -> HandlersT chn info inh ms m hs
toHandlers (NamedList nl -> HandlersT chn info () methods m hs)
-> NamedList nl -> HandlersT chn info () methods m hs
forall a b. (a -> b) -> a -> b
$ p -> NamedList nl
forall p (nl :: [(Symbol, *)]).
ToNamedList p nl =>
p -> NamedList nl
toNamedList p
nl

-- | Defines the implementation of a single GraphQL object,
--   which translates as a single Mu service.
--   Intended to be used with @TypeApplications@
--   and a tuple of 'field's:
--
--   > object @"myObject" (field @"f1" h1, fielf @"f2" h2)
--
--   Note: for the root objects in GraphQL (query, mutation, subscription)
--   use 'method' instead of 'object'.
object
  :: forall sname p nl chn info ms m hs.
     ( ToNamedList p nl
     , ToHandlers chn info (MappingRight chn sname) ms m hs nl )
  => p -> Named sname (HandlersT chn info (MappingRight chn sname) ms m hs)
object :: p
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
object p
nl = HandlersT chn info (MappingRight chn sname) ms m hs
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
forall k (n :: k) h. h -> Named n h
Named (HandlersT chn info (MappingRight chn sname) ms m hs
 -> Named
      sname (HandlersT chn info (MappingRight chn sname) ms m hs))
-> HandlersT chn info (MappingRight chn sname) ms m hs
-> Named
     sname (HandlersT chn info (MappingRight chn sname) ms m hs)
forall a b. (a -> b) -> a -> b
$ NamedList nl -> HandlersT chn info (MappingRight chn sname) ms m hs
forall snm mnm anm (chn :: ServiceChain snm) info inh
       (ms :: [Method snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [*]) (nl :: [(Symbol, *)]).
ToHandlers chn info inh ms m hs nl =>
NamedList nl -> HandlersT chn info inh ms m hs
toHandlers (NamedList nl
 -> HandlersT chn info (MappingRight chn sname) ms m hs)
-> NamedList nl
-> HandlersT chn info (MappingRight chn sname) ms m hs
forall a b. (a -> b) -> a -> b
$ p -> NamedList nl
forall p (nl :: [(Symbol, *)]).
ToNamedList p nl =>
p -> NamedList nl
toNamedList p
nl

union :: forall sname chn m elts.
         (MappingRight chn sname -> m (UnionChoice chn elts))
      -> Named sname (MappingRight chn sname -> m (UnionChoice chn elts))
union :: (MappingRight chn sname -> m (UnionChoice chn elts))
-> Named sname (MappingRight chn sname -> m (UnionChoice chn elts))
union = (MappingRight chn sname -> m (UnionChoice chn elts))
-> Named sname (MappingRight chn sname -> m (UnionChoice chn elts))
forall k (n :: k) h. h -> Named n h
Named

-- | Combines the implementation of several GraphQL objects,
--   which means a whole Mu service for a GraphQL server.
--   Intented to be used with a tuple of 'objects':
--
--   > resolver (object @"o1" ..., object @"o2" ...)
resolver
  :: (ToNamedList p nl, ToServices chn info ss m hs nl)
  => p -> ServerT chn info ('Package pname ss) m hs
resolver :: p -> ServerT chn info ('Package pname ss) m hs
resolver p
nl = ServicesT chn info ss m hs
-> ServerT chn info ('Package pname ss) m hs
forall serviceName mnm anm (chn :: ServiceChain serviceName) info
       (s :: [Service serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [[*]]) (pname :: Maybe serviceName).
ServicesT chn info s m hs
-> ServerT chn info ('Package pname s) m hs
Services (ServicesT chn info ss m hs
 -> ServerT chn info ('Package pname ss) m hs)
-> ServicesT chn info ss m hs
-> ServerT chn info ('Package pname ss) m hs
forall a b. (a -> b) -> a -> b
$ NamedList nl -> ServicesT chn info ss m hs
forall snm mnm anm (chn :: ServiceChain snm) info
       (ss :: [Service snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [[*]]) (nl :: [(Symbol, *)]).
ToServices chn info ss m hs nl =>
NamedList nl -> ServicesT chn info ss m hs
toServices (NamedList nl -> ServicesT chn info ss m hs)
-> NamedList nl -> ServicesT chn info ss m hs
forall a b. (a -> b) -> a -> b
$ p -> NamedList nl
forall p (nl :: [(Symbol, *)]).
ToNamedList p nl =>
p -> NamedList nl
toNamedList p
nl

-- | A value tagged with a type-level name.
data Named n h where
  Named :: forall n h. h -> Named n h

infixr 4 :|:
-- | Heterogeneous list in which each element
--   is tagged with a type-level name.
data NamedList (hs :: [(Symbol, *)]) where
  N0    :: NamedList '[]
  (:|:) :: Named n h -> NamedList hs
        -> NamedList ('(n, h) ': hs)

-- | Used to turn tuples into 'NamedList's.
class ToNamedList p nl | p -> nl where
  toNamedList :: p -> NamedList nl

instance ToNamedList (NamedList nl) nl where
  toNamedList :: NamedList nl -> NamedList nl
toNamedList = NamedList nl -> NamedList nl
forall a. a -> a
id
instance ToNamedList () '[] where
  toNamedList :: () -> NamedList '[]
toNamedList ()
_ = NamedList '[]
N0
instance ToNamedList (Named n h) '[ '(n, h) ] where
  toNamedList :: Named n h -> NamedList '[ '(n, h)]
toNamedList Named n h
n = Named n h
n Named n h -> NamedList '[] -> NamedList '[ '(n, h)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2)
                     '[ '(n1, h1), '(n2, h2) ] where
  toNamedList :: (Named n1 h1, Named n2 h2) -> NamedList '[ '(n1, h1), '(n2, h2)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2) = Named n1 h1
n1 Named n1 h1
-> NamedList '[ '(n2, h2)] -> NamedList '[ '(n1, h1), '(n2, h2)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2 -> NamedList '[] -> NamedList '[ '(n2, h2)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3)
-> NamedList '[ '(n1, h1), '(n2, h2), '(n3, h3)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3) = Named n1 h1
n1 Named n1 h1
-> NamedList '[ '(n2, h2), '(n3, h3)]
-> NamedList '[ '(n1, h1), '(n2, h2), '(n3, h3)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList '[ '(n3, h3)] -> NamedList '[ '(n2, h2), '(n3, h3)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3 -> NamedList '[] -> NamedList '[ '(n3, h3)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4)
-> NamedList '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4) = Named n1 h1
n1 Named n1 h1
-> NamedList '[ '(n2, h2), '(n3, h3), '(n4, h4)]
-> NamedList '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList '[ '(n3, h3), '(n4, h4)]
-> NamedList '[ '(n2, h2), '(n3, h3), '(n4, h4)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList '[ '(n4, h4)] -> NamedList '[ '(n3, h3), '(n4, h4)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4 -> NamedList '[] -> NamedList '[ '(n4, h4)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5)
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4, Named n5 h5
n5) = Named n1 h1
n1 Named n1 h1
-> NamedList '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5)]
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList '[ '(n3, h3), '(n4, h4), '(n5, h5)]
-> NamedList '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList '[ '(n4, h4), '(n5, h5)]
-> NamedList '[ '(n3, h3), '(n4, h4), '(n5, h5)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4
-> NamedList '[ '(n5, h5)] -> NamedList '[ '(n4, h4), '(n5, h5)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n5 h5
n5 Named n5 h5 -> NamedList '[] -> NamedList '[ '(n5, h5)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5, Named n6 h6)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5,
 Named n6 h6)
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4, Named n5 h5
n5, Named n6 h6
n6) = Named n1 h1
n1 Named n1 h1
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6)]
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6)]
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList '[ '(n4, h4), '(n5, h5), '(n6, h6)]
-> NamedList '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4
-> NamedList '[ '(n5, h5), '(n6, h6)]
-> NamedList '[ '(n4, h4), '(n5, h5), '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n5 h5
n5 Named n5 h5
-> NamedList '[ '(n6, h6)] -> NamedList '[ '(n5, h5), '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n6 h6
n6 Named n6 h6 -> NamedList '[] -> NamedList '[ '(n6, h6)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5, Named n6 h6, Named n7 h7)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5,
 Named n6 h6, Named n7 h7)
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4, Named n5 h5
n5, Named n6 h6
n6, Named n7 h7
n7) = Named n1 h1
n1 Named n1 h1
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7)]
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7)]
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7)]
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4
-> NamedList '[ '(n5, h5), '(n6, h6), '(n7, h7)]
-> NamedList '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n5 h5
n5 Named n5 h5
-> NamedList '[ '(n6, h6), '(n7, h7)]
-> NamedList '[ '(n5, h5), '(n6, h6), '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n6 h6
n6 Named n6 h6
-> NamedList '[ '(n7, h7)] -> NamedList '[ '(n6, h6), '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n7 h7
n7 Named n7 h7 -> NamedList '[] -> NamedList '[ '(n7, h7)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5, Named n6 h6, Named n7 h7, Named n8 h8)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5,
 Named n6 h6, Named n7 h7, Named n8 h8)
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7), '(n8, h8)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4, Named n5 h5
n5, Named n6 h6
n6, Named n7 h7
n7, Named n8 h8
n8) = Named n1 h1
n1 Named n1 h1
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7), '(n8, h8)]
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7),
        '(n8, h8)]
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList
     '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8)]
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7),
        '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4
-> NamedList '[ '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8)]
-> NamedList
     '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n5 h5
n5 Named n5 h5
-> NamedList '[ '(n6, h6), '(n7, h7), '(n8, h8)]
-> NamedList '[ '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n6 h6
n6 Named n6 h6
-> NamedList '[ '(n7, h7), '(n8, h8)]
-> NamedList '[ '(n6, h6), '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n7 h7
n7 Named n7 h7
-> NamedList '[ '(n8, h8)] -> NamedList '[ '(n7, h7), '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n8 h8
n8 Named n8 h8 -> NamedList '[] -> NamedList '[ '(n8, h8)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0
instance ToNamedList (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5, Named n6 h6, Named n7 h7, Named n8 h8, Named n9 h9)
                     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9) ] where
  toNamedList :: (Named n1 h1, Named n2 h2, Named n3 h3, Named n4 h4, Named n5 h5,
 Named n6 h6, Named n7 h7, Named n8 h8, Named n9 h9)
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
toNamedList (Named n1 h1
n1, Named n2 h2
n2, Named n3 h3
n3, Named n4 h4
n4, Named n5 h5
n5, Named n6 h6
n6, Named n7 h7
n7, Named n8 h8
n8, Named n9 h9
n9) = Named n1 h1
n1 Named n1 h1
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7), '(n8, h8), '(n9, h9)]
-> NamedList
     '[ '(n1, h1), '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5),
        '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n2 h2
n2 Named n2 h2
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7),
        '(n8, h8), '(n9, h9)]
-> NamedList
     '[ '(n2, h2), '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6),
        '(n7, h7), '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n3 h3
n3 Named n3 h3
-> NamedList
     '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8),
        '(n9, h9)]
-> NamedList
     '[ '(n3, h3), '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7),
        '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n4 h4
n4 Named n4 h4
-> NamedList
     '[ '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
-> NamedList
     '[ '(n4, h4), '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8),
        '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n5 h5
n5 Named n5 h5
-> NamedList '[ '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
-> NamedList
     '[ '(n5, h5), '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n6 h6
n6 Named n6 h6
-> NamedList '[ '(n7, h7), '(n8, h8), '(n9, h9)]
-> NamedList '[ '(n6, h6), '(n7, h7), '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n7 h7
n7 Named n7 h7
-> NamedList '[ '(n8, h8), '(n9, h9)]
-> NamedList '[ '(n7, h7), '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n8 h8
n8 Named n8 h8
-> NamedList '[ '(n9, h9)] -> NamedList '[ '(n8, h8), '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: Named n9 h9
n9 Named n9 h9 -> NamedList '[] -> NamedList '[ '(n9, h9)]
forall (n :: Symbol) h (hs :: [(Symbol, *)]).
Named n h -> NamedList hs -> NamedList ('(n, h) : hs)
:|: NamedList '[]
N0

class ToHandlers chn info inh ms m hs nl | chn inh ms m nl -> hs where
  toHandlers :: NamedList nl
             -> HandlersT chn info inh ms m hs

instance ToHandlers chn info inh '[] m '[] nl where
  toHandlers :: NamedList nl -> HandlersT chn info inh '[] m '[]
toHandlers NamedList nl
_ = HandlersT chn info inh '[] m '[]
forall snm mnm anm (chn :: ServiceChain snm) info inh
       (m :: * -> *).
HandlersT chn info inh '[] m '[]
H0
instance ( FindHandler name info inh h nl
         , Handles chn args ret m h
         , ToHandlers chn info inh ms m hs nl )
         => ToHandlers chn info inh ('Method name args ret ': ms) m (h ': hs) nl where
  toHandlers :: NamedList nl
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
toHandlers NamedList nl
nl = Proxy name -> NamedList nl -> RpcInfo info -> inh -> h
forall k (name :: k) info inh h (nl :: [(Symbol, *)]).
FindHandler name info inh h nl =>
Proxy name -> NamedList nl -> RpcInfo info -> inh -> h
findHandler (Proxy name
forall k (t :: k). Proxy t
Proxy @name) NamedList nl
nl (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
forall serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info inh (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
(RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
:<||>: NamedList nl -> HandlersT chn info inh ms m hs
forall snm mnm anm (chn :: ServiceChain snm) info inh
       (ms :: [Method snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [*]) (nl :: [(Symbol, *)]).
ToHandlers chn info inh ms m hs nl =>
NamedList nl -> HandlersT chn info inh ms m hs
toHandlers NamedList nl
nl

class FindHandler name info inh h nl | name nl -> inh h where
  findHandler :: Proxy name -> NamedList nl -> RpcInfo info -> inh -> h
instance (inh ~ h, h ~ TypeError ('Text "cannot find handler for " ':<>: 'ShowType name))
         => FindHandler name info inh h '[] where
  findHandler :: Proxy name -> NamedList '[] -> RpcInfo info -> inh -> h
findHandler = String -> Proxy name -> NamedList '[] -> RpcInfo info -> inh -> h
forall a. HasCallStack => String -> a
error String
"this should never be called"
instance {-# OVERLAPS #-} (RpcInfo info ~ rpc', inh ~ inh', h ~ h')
         => FindHandler name info inh h ( '(name, rpc' -> inh' -> h') ': rest ) where
  findHandler :: Proxy name
-> NamedList ('(name, rpc' -> inh' -> h') : rest)
-> RpcInfo info
-> inh
-> h
findHandler Proxy name
_ (Named h
f :|: NamedList hs
_) = h
RpcInfo info -> inh -> h
f
instance {-# OVERLAPPABLE #-} FindHandler name info inh h rest
         => FindHandler name info inh h (thing ': rest) where
  findHandler :: Proxy name -> NamedList (thing : rest) -> RpcInfo info -> inh -> h
findHandler Proxy name
p (Named n h
_ :|: NamedList hs
rest) = Proxy name -> NamedList hs -> RpcInfo info -> inh -> h
forall k (name :: k) info inh h (nl :: [(Symbol, *)]).
FindHandler name info inh h nl =>
Proxy name -> NamedList nl -> RpcInfo info -> inh -> h
findHandler Proxy name
p NamedList hs
rest

class ToServices chn info ss m hs nl | chn ss m nl -> hs where
  toServices :: NamedList nl
             -> ServicesT chn info ss m hs

instance ToServices chn info '[] m '[] nl where
  toServices :: NamedList nl -> ServicesT chn info '[] m '[]
toServices NamedList nl
_ = ServicesT chn info '[] m '[]
forall snm mnm anm (chn :: ServiceChain snm) info (m :: * -> *).
ServicesT chn info '[] m '[]
S0
instance ( FindService name (HandlersT chn info (MappingRight chn name) methods m h) nl
         , ToServices chn info ss m hs nl)
         => ToServices chn info ('Service name methods ': ss) m (h ': hs) nl where
  toServices :: NamedList nl
-> ServicesT chn info ('Service name methods : ss) m (h : hs)
toServices NamedList nl
nl = HandlersT chn info (MappingRight chn name) methods m h
-> ServiceT chn info ('Service name methods) m h
forall serviceName methodName argName
       (chn :: ServiceChain serviceName) info (sname :: serviceName)
       (methods :: [Method
                      serviceName methodName argName (TypeRef serviceName)])
       (m :: * -> *) (hs :: [*]).
HandlersT chn info (MappingRight chn sname) methods m hs
-> ServiceT chn info ('Service sname methods) m hs
ProperSvc (Proxy name
-> NamedList nl
-> HandlersT chn info (MappingRight chn name) methods m h
forall k (name :: k) h (nl :: [(Symbol, *)]).
FindService name h nl =>
Proxy name -> NamedList nl -> h
findService (Proxy name
forall k (t :: k). Proxy t
Proxy @name) NamedList nl
nl) ServiceT chn info ('Service name methods) m h
-> ServicesT chn info ss m hs
-> ServicesT chn info ('Service name methods : ss) m (h : hs)
forall snm mnm anm (chn :: ServiceChain snm) info
       (svc :: Service snm mnm anm (TypeRef snm)) (m :: * -> *)
       (hs :: [*]) (rest :: [Service snm mnm anm (TypeRef snm)])
       (hss :: [[*]]).
ServiceT chn info svc m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info (svc : rest) m (hs : hss)
:<&>: NamedList nl -> ServicesT chn info ss m hs
forall snm mnm anm (chn :: ServiceChain snm) info
       (ss :: [Service snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [[*]]) (nl :: [(Symbol, *)]).
ToServices chn info ss m hs nl =>
NamedList nl -> ServicesT chn info ss m hs
toServices NamedList nl
nl
instance ( FindService name (MappingRight chn name -> m (UnionChoice chn elts)) nl
         , ToServices chn info ss m hs nl)
         => ToServices chn info ('OneOf name elts ': ss) m ('[] ': hs) nl where
  toServices :: NamedList nl
-> ServicesT chn info ('OneOf name elts : ss) m ('[] : hs)
toServices NamedList nl
nl = (MappingRight chn name -> m (UnionChoice chn elts))
-> ServiceT chn info ('OneOf name elts) m '[]
forall serviceName methodName argName
       (chn :: Mappings serviceName *) (sname :: serviceName)
       (m :: * -> *) (elts :: [serviceName]) info.
(MappingRight chn sname -> m (UnionChoice chn elts))
-> ServiceT chn info ('OneOf sname elts) m '[]
OneOfSvc (Proxy name
-> NamedList nl
-> MappingRight chn name
-> m (UnionChoice chn elts)
forall k (name :: k) h (nl :: [(Symbol, *)]).
FindService name h nl =>
Proxy name -> NamedList nl -> h
findService (Proxy name
forall k (t :: k). Proxy t
Proxy @name) NamedList nl
nl) ServiceT chn info ('OneOf name elts) m '[]
-> ServicesT chn info ss m hs
-> ServicesT chn info ('OneOf name elts : ss) m ('[] : hs)
forall snm mnm anm (chn :: ServiceChain snm) info
       (svc :: Service snm mnm anm (TypeRef snm)) (m :: * -> *)
       (hs :: [*]) (rest :: [Service snm mnm anm (TypeRef snm)])
       (hss :: [[*]]).
ServiceT chn info svc m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info (svc : rest) m (hs : hss)
:<&>: NamedList nl -> ServicesT chn info ss m hs
forall snm mnm anm (chn :: ServiceChain snm) info
       (ss :: [Service snm mnm anm (TypeRef snm)]) (m :: * -> *)
       (hs :: [[*]]) (nl :: [(Symbol, *)]).
ToServices chn info ss m hs nl =>
NamedList nl -> ServicesT chn info ss m hs
toServices NamedList nl
nl


class FindService name h nl | name nl -> h where
  findService :: Proxy name -> NamedList nl -> h
instance (h ~ TypeError ('Text "cannot find handler for " ':<>: 'ShowType name))
         => FindService name h '[] where
  findService :: Proxy name -> NamedList '[] -> h
findService = String -> Proxy name -> NamedList '[] -> h
forall a. HasCallStack => String -> a
error String
"this should never be called"
instance {-# OVERLAPS #-} (h ~ h')
         => FindService name h ( '(name, h') ': rest ) where
  findService :: Proxy name -> NamedList ('(name, h') : rest) -> h
findService Proxy name
_ (Named h
f :|: NamedList hs
_) = h
h
f
instance {-# OVERLAPPABLE #-} FindService name h rest
         => FindService name h (thing ': rest) where
  findService :: Proxy name -> NamedList (thing : rest) -> h
findService Proxy name
p (Named n h
_ :|: NamedList hs
rest) = Proxy name -> NamedList hs -> h
forall k (name :: k) h (nl :: [(Symbol, *)]).
FindService name h nl =>
Proxy name -> NamedList nl -> h
findService Proxy name
p NamedList hs
rest

-- WRAPPING MECHANISM

wrapServer
  :: forall chn info p m topHs.
     (forall a. RpcInfo info -> m a -> m a)
  -> ServerT chn info p m topHs -> ServerT chn info p m topHs
wrapServer :: (forall a. RpcInfo info -> m a -> m a)
-> ServerT chn info p m topHs -> ServerT chn info p m topHs
wrapServer forall a. RpcInfo info -> m a -> m a
f (Services ServicesT chn info s m topHs
ss) = ServicesT chn info s m topHs
-> ServerT chn info ('Package pname s) m topHs
forall serviceName mnm anm (chn :: ServiceChain serviceName) info
       (s :: [Service serviceName mnm anm (TypeRef serviceName)])
       (m :: * -> *) (hs :: [[*]]) (pname :: Maybe serviceName).
ServicesT chn info s m hs
-> ServerT chn info ('Package pname s) m hs
Services (ServicesT chn info s m topHs -> ServicesT chn info s m topHs
forall mnm anm (ss :: [Service snm mnm anm (TypeRef snm)])
       (hs :: [[*]]).
ServicesT chn info ss m hs -> ServicesT chn info ss m hs
wrapServices ServicesT chn info s m topHs
ss)
  where
    wrapServices :: forall ss hs.
                    ServicesT chn info ss m hs
                 -> ServicesT chn info ss m hs
    wrapServices :: ServicesT chn info ss m hs -> ServicesT chn info ss m hs
wrapServices ServicesT chn info ss m hs
S0 = ServicesT chn info ss m hs
forall snm mnm anm (chn :: ServiceChain snm) info (m :: * -> *).
ServicesT chn info '[] m '[]
S0
#if __GLASGOW_HASKELL__ >= 808
    wrapServices (ProperSvc HandlersT chn info (MappingRight chn sname) methods m hs
h :<&>: ServicesT chn info rest m hss
rest)
      = HandlersT chn info (MappingRight chn sname) methods m hs
-> ServiceT chn info ('Service sname methods) m hs
forall serviceName methodName argName
       (chn :: ServiceChain serviceName) info (sname :: serviceName)
       (methods :: [Method
                      serviceName methodName argName (TypeRef serviceName)])
       (m :: * -> *) (hs :: [*]).
HandlersT chn info (MappingRight chn sname) methods m hs
-> ServiceT chn info ('Service sname methods) m hs
ProperSvc (HandlersT chn info (MappingRight chn sname) methods m hs
-> HandlersT chn info (MappingRight chn sname) methods m hs
forall mnm anm inh (ms :: [Method snm mnm anm (TypeRef snm)])
       (innerHs :: [*]).
HandlersT chn info inh ms m innerHs
-> HandlersT chn info inh ms m innerHs
wrapHandlers HandlersT chn info (MappingRight chn sname) methods m hs
h) ServiceT chn info ('Service sname methods) m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info ('Service sname methods : rest) m (hs : hss)
forall snm mnm anm (chn :: ServiceChain snm) info
       (svc :: Service snm mnm anm (TypeRef snm)) (m :: * -> *)
       (hs :: [*]) (rest :: [Service snm mnm anm (TypeRef snm)])
       (hss :: [[*]]).
ServiceT chn info svc m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info (svc : rest) m (hs : hss)
:<&>: ServicesT chn info rest m hss -> ServicesT chn info rest m hss
forall mnm anm (ss :: [Service snm mnm anm (TypeRef snm)])
       (hs :: [[*]]).
ServicesT chn info ss m hs -> ServicesT chn info ss m hs
wrapServices ServicesT chn info rest m hss
rest
    wrapServices (OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts)
h :<&>: ServicesT chn info rest m hss
rest)
      = (MappingRight chn sname -> m (UnionChoice chn elts))
-> ServiceT chn info ('OneOf sname elts) m '[]
forall serviceName methodName argName
       (chn :: Mappings serviceName *) (sname :: serviceName)
       (m :: * -> *) (elts :: [serviceName]) info.
(MappingRight chn sname -> m (UnionChoice chn elts))
-> ServiceT chn info ('OneOf sname elts) m '[]
OneOfSvc MappingRight chn sname -> m (UnionChoice chn elts)
h ServiceT chn info ('OneOf sname elts) m '[]
-> ServicesT chn info rest m hss
-> ServicesT chn info ('OneOf sname elts : rest) m ('[] : hss)
forall snm mnm anm (chn :: ServiceChain snm) info
       (svc :: Service snm mnm anm (TypeRef snm)) (m :: * -> *)
       (hs :: [*]) (rest :: [Service snm mnm anm (TypeRef snm)])
       (hss :: [[*]]).
ServiceT chn info svc m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info (svc : rest) m (hs : hss)
:<&>: ServicesT chn info rest m hss -> ServicesT chn info rest m hss
forall mnm anm (ss :: [Service snm mnm anm (TypeRef snm)])
       (hs :: [[*]]).
ServicesT chn info ss m hs -> ServicesT chn info ss m hs
wrapServices ServicesT chn info rest m hss
rest
#else
    wrapServices (ProperSvc h :<&>: rest)
      = ProperSvc (unsafeCoerce (wrapHandlers (unsafeCoerce h)))
        :<&>: unsafeCoerce (wrapServices rest)
    wrapServices (OneOfSvc h :<&>: rest)
      = OneOfSvc (unsafeCoerce h)
        :<&>: unsafeCoerce (wrapServices rest)
#endif

    wrapHandlers :: forall inh ms innerHs.
                    HandlersT chn info inh ms m innerHs
                 -> HandlersT chn info inh ms m innerHs
    wrapHandlers :: HandlersT chn info inh ms m innerHs
-> HandlersT chn info inh ms m innerHs
wrapHandlers HandlersT chn info inh ms m innerHs
H0 = HandlersT chn info inh ms m innerHs
forall snm mnm anm (chn :: ServiceChain snm) info inh
       (m :: * -> *).
HandlersT chn info inh '[] m '[]
H0
    wrapHandlers (Hmore Proxy args
pargs Proxy ret
pret RpcInfo info -> inh -> h
h HandlersT chn info inh ms m hs
rest)
      = Proxy args
-> Proxy ret
-> (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
forall serviceName anm mnm (chn :: ServiceChain serviceName)
       (args :: [Argument serviceName anm (TypeRef serviceName)])
       (ret :: Return serviceName (TypeRef serviceName)) (m :: * -> *) h
       info inh (ms :: [Method serviceName mnm anm (TypeRef serviceName)])
       (hs :: [*]) (name :: mnm).
Handles chn args ret m h =>
Proxy args
-> Proxy ret
-> (RpcInfo info -> inh -> h)
-> HandlersT chn info inh ms m hs
-> HandlersT chn info inh ('Method name args ret : ms) m (h : hs)
Hmore Proxy args
pargs Proxy ret
pret
              (\RpcInfo info
rpc inh
inh -> Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
forall snm anm (chn :: ServiceChain snm)
       (args :: [Argument snm anm (TypeRef snm)])
       (ret :: Return snm (TypeRef snm)) (m :: * -> *) h.
Handles chn args ret m h =>
Proxy '(chn, m)
-> Proxy args -> Proxy ret -> (forall a. m a -> m a) -> h -> h
wrapHandler (Proxy '(chn, m)
forall k (t :: k). Proxy t
Proxy @'(chn, m)) Proxy args
pargs Proxy ret
pret (RpcInfo info -> m a -> m a
forall a. RpcInfo info -> m a -> m a
f RpcInfo info
rpc) (RpcInfo info -> inh -> h
h RpcInfo info
rpc inh
inh))
              (HandlersT chn info inh ms m hs -> HandlersT chn info inh ms m hs
forall mnm anm inh (ms :: [Method snm mnm anm (TypeRef snm)])
       (innerHs :: [*]).
HandlersT chn info inh ms m innerHs
-> HandlersT chn info inh ms m innerHs
wrapHandlers HandlersT chn info inh ms m hs
rest)