{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.Server.Deriving.Named.Encode ( deriveNamedModel, EncodeNamedConstraints, ) where import Data.Morpheus.App.Internal.Resolving ( NamedResolver (..), Resolver, RootResolverValue (..), ) import Data.Morpheus.NamedResolvers (NamedResolverT (..)) import Data.Morpheus.Server.Deriving.Named.EncodeType ( EncodeTypeConstraint, deriveResolver, ) import Data.Morpheus.Server.Deriving.Utils.GTraversable ( traverseTypes, ) import Data.Morpheus.Types ( NamedResolvers (..), ) import Data.Morpheus.Types.Internal.AST ( QUERY, ) import qualified GHC.Exts as HM import Relude type EncodeNamedConstraints e m query mut sub = (EncodeTypeConstraint (Resolver QUERY e m) query) deriveNamedModel :: forall e m query mut sub. (Monad m, EncodeNamedConstraints e m query mut sub) => NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedModel :: forall e (m :: * -> *) (query :: (* -> *) -> *) (mut :: (* -> *) -> *) (sub :: (* -> *) -> *). (Monad m, EncodeNamedConstraints e m query mut sub) => NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedModel NamedResolvers m e query mut sub NamedResolvers = forall e (m :: * -> *). ResolverMap (Resolver QUERY e m) -> RootResolverValue e m NamedResolversValue forall a b. (a -> b) -> a -> b $ forall l. IsList l => [Item l] -> l HM.fromList forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map (\NamedResolver (Resolver QUERY e m) x -> (forall (m :: * -> *). NamedResolver m -> Name 'TYPE resolverName NamedResolver (Resolver QUERY e m) x, NamedResolver (Resolver QUERY e m) x)) forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) a. Monad m => m (m a) -> m a join forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> [a] toList forall a b. (a -> b) -> a -> b $ forall (c :: DerivingKind -> * -> Constraint) a v. (GFmap (ScanConstraint c) (KIND a) a, c (KIND a) a, GQLType a) => Mappable c v KindedProxy -> Proxy a -> Map TypeFingerprint v traverseTypes forall (m :: * -> *). Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy deriveResolver (forall {k} (t :: k). Proxy t Proxy @(query (NamedResolverT (Resolver QUERY e m))))