{-# 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 :: NamedResolvers m e query mut sub -> RootResolverValue e m deriveNamedModel NamedResolvers m e query mut sub NamedResolvers = ResolverMap (Resolver QUERY e m) -> RootResolverValue e m forall e (m :: * -> *). ResolverMap (Resolver QUERY e m) -> RootResolverValue e m NamedResolversValue (ResolverMap (Resolver QUERY e m) -> RootResolverValue e m) -> ResolverMap (Resolver QUERY e m) -> RootResolverValue e m forall a b. (a -> b) -> a -> b $ [Item (ResolverMap (Resolver QUERY e m))] -> ResolverMap (Resolver QUERY e m) forall l. IsList l => [Item l] -> l HM.fromList ([Item (ResolverMap (Resolver QUERY e m))] -> ResolverMap (Resolver QUERY e m)) -> [Item (ResolverMap (Resolver QUERY e m))] -> ResolverMap (Resolver QUERY e m) forall a b. (a -> b) -> a -> b $ (NamedResolver (Resolver QUERY e m) -> (TypeName, NamedResolver (Resolver QUERY e m))) -> [NamedResolver (Resolver QUERY e m)] -> [(TypeName, NamedResolver (Resolver QUERY e m))] forall a b. (a -> b) -> [a] -> [b] map (\NamedResolver (Resolver QUERY e m) x -> (NamedResolver (Resolver QUERY e m) -> TypeName forall (m :: * -> *). NamedResolver m -> TypeName resolverName NamedResolver (Resolver QUERY e m) x, NamedResolver (Resolver QUERY e m) x)) ([NamedResolver (Resolver QUERY e m)] -> [(TypeName, NamedResolver (Resolver QUERY e m))]) -> [NamedResolver (Resolver QUERY e m)] -> [(TypeName, NamedResolver (Resolver QUERY e m))] forall a b. (a -> b) -> a -> b $ [[NamedResolver (Resolver QUERY e m)]] -> [NamedResolver (Resolver QUERY e m)] forall (m :: * -> *) a. Monad m => m (m a) -> m a join ([[NamedResolver (Resolver QUERY e m)]] -> [NamedResolver (Resolver QUERY e m)]) -> [[NamedResolver (Resolver QUERY e m)]] -> [NamedResolver (Resolver QUERY e m)] forall a b. (a -> b) -> a -> b $ Map TypeFingerprint [NamedResolver (Resolver QUERY e m)] -> [[NamedResolver (Resolver QUERY e m)]] forall (t :: * -> *) a. Foldable t => t a -> [a] toList (Map TypeFingerprint [NamedResolver (Resolver QUERY e m)] -> [[NamedResolver (Resolver QUERY e m)]]) -> Map TypeFingerprint [NamedResolver (Resolver QUERY e m)] -> [[NamedResolver (Resolver QUERY e m)]] forall a b. (a -> b) -> a -> b $ Mappable (DeriveNamedResolver (Resolver QUERY e m)) [NamedResolver (Resolver QUERY e m)] KindedProxy -> Proxy (query (NamedResolverT (Resolver QUERY e m))) -> Map TypeFingerprint [NamedResolver (Resolver QUERY e m)] 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 Mappable (DeriveNamedResolver (Resolver QUERY e m)) [NamedResolver (Resolver QUERY e m)] KindedProxy forall (m :: * -> *). Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy deriveResolver (Proxy (query (NamedResolverT (Resolver QUERY e m))) forall k (t :: k). Proxy t Proxy @(query (NamedResolverT (Resolver QUERY e m))))