{-# 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__ < 880
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 x :: b
x _ _ = 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
  x :: RpcInfo info -> inh -> h
x :<||>: xs :: 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
  x :: h
x :<|>: xs :: 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 pchn :: Proxy '(chn, m)
pchn _ pr :: Proxy ret
pr f :: forall a. m a -> m a
f h :: 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 pchn :: Proxy '(chn, m)
pchn _ pr :: Proxy ret
pr f :: forall a. m a -> m a
f h :: 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 _ _ _ f :: forall a. m a -> m a
f h :: 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 _ _ _ f :: forall a. m a -> m a
f h :: 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 _ _ _ f :: forall a. m a -> m a
f h :: 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 _ _ _ f :: forall a. m a -> m a
f h :: 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 f :: p
f = (a -> () -> p) -> Named n (a -> () -> p)
forall k (n :: k) h. h -> Named n h
Named (\_ _ -> 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 f :: RpcInfo info -> p
f = (RpcInfo info -> () -> p) -> Named n (RpcInfo info -> () -> p)
forall k (n :: k) h. h -> Named n h
Named (\x :: 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 f :: 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 nl :: 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 nl :: 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 nl :: 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 n :: 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 (n1 :: Named n1 h1
n1, n2 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: Named n4 h4
n4, n5 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: Named n4 h4
n4, n5 :: Named n5 h5
n5, n6 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: Named n4 h4
n4, n5 :: Named n5 h5
n5, n6 :: Named n6 h6
n6, n7 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: Named n4 h4
n4, n5 :: Named n5 h5
n5, n6 :: Named n6 h6
n6, n7 :: Named n7 h7
n7, n8 :: 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 (n1 :: Named n1 h1
n1, n2 :: Named n2 h2
n2, n3 :: Named n3 h3
n3, n4 :: Named n4 h4
n4, n5 :: Named n5 h5
n5, n6 :: Named n6 h6
n6, n7 :: Named n7 h7
n7, n8 :: Named n8 h8
n8, n9 :: 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 _ = 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 nl :: 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 "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 _ (Named f :: h
f :|: _) = 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 p :: Proxy name
p (_ :|: rest :: 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 _ = 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 nl :: 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 nl :: 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 "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 _ (Named f :: h
f :|: _) = h
h
f
instance {-# OVERLAPPABLE #-} FindService name h rest
         => FindService name h (thing ': rest) where
  findService :: Proxy name -> NamedList (thing : rest) -> h
findService p :: Proxy name
p (_ :|: rest :: 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 f :: forall a. RpcInfo info -> m a -> m a
f (Services ss :: 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 S0 = ServicesT chn info ss m hs
forall snm mnm anm (chn :: ServiceChain snm) info (m :: * -> *).
ServicesT chn info '[] m '[]
S0
    wrapServices (h :: ServiceT chn info svc m hs
h :<&>: rest :: ServicesT chn info rest m hss
rest)
#if __GLASGOW_HASKELL__ >= 880
      = wrapHandlers h :<&>: wrapServices rest
#else
      = HandlersT chn info Any Any m Any -> ServiceT chn info svc m hs
forall a b. a -> b
unsafeCoerce (HandlersT chn info Any Any m Any
-> HandlersT chn info Any Any m Any
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 (ServiceT chn info svc m hs -> HandlersT chn info Any Any m Any
forall a b. a -> b
unsafeCoerce ServiceT chn info svc m hs
h)) ServiceT chn info svc m hs
-> ServicesT chn info rest m hss
-> ServicesT chn info (svc : 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 a b. a -> b
unsafeCoerce (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)
#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 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 pargs :: Proxy args
pargs pret :: Proxy ret
pret h :: RpcInfo info -> inh -> h
h rest :: 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
              (\rpc :: RpcInfo info
rpc inh :: 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)