{-# 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.EncodeType ( deriveResolver, EncodeTypeConstraint, DeriveNamedResolver (..), ) where import Data.Morpheus.App.Internal.Resolving ( LiftOperation, NamedResolver (..), Resolver, ResolverState, ResolverValue, liftResolverState, ) import Data.Morpheus.Kind ( CUSTOM, DerivingKind, SCALAR, TYPE, WRAPPER, ) import Data.Morpheus.NamedResolvers (NamedResolverT (..), ResolveNamed (Dep, resolveNamed)) import Data.Morpheus.Server.Deriving.Decode ( Decode (decode), ) import Data.Morpheus.Server.Deriving.Named.EncodeValue ( Encode, EncodeFieldKind, encodeResolverValue, getTypeName, ) import Data.Morpheus.Server.Deriving.Utils ( TypeRep (..), ) import Data.Morpheus.Server.Deriving.Utils.GTraversable import Data.Morpheus.Server.Deriving.Utils.Kinded (KindedProxy (KindedProxy)) import Data.Morpheus.Server.Types.GQLType ( GQLType, KIND, ) import Data.Morpheus.Types.Internal.AST ( ValidValue, ) import GHC.Generics ( Generic (..), ) import Relude deriveResolver :: Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy deriveResolver :: forall (m :: * -> *). Mappable (DeriveNamedResolver m) [NamedResolver m] KindedProxy deriveResolver = forall (c :: DerivingKind -> * -> Constraint) v (f :: DerivingKind -> * -> *). (forall a. (GQLType a, c (KIND a) a) => KindedProxy (KIND a) a -> v) -> Mappable c v f Mappable forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). DeriveNamedResolver m k a => f k a -> [NamedResolver m] deriveNamedResolver type EncodeTypeConstraint m a = ( GFmap (ScanConstraint (DeriveNamedResolver m)) (KIND (a (NamedResolverT m))) (a (NamedResolverT m)), DeriveNamedResolver m (KIND (a (NamedResolverT m))) (a (NamedResolverT m)), GQLType (a (NamedResolverT m)) ) class DeriveNamedResolver (m :: Type -> Type) (k :: DerivingKind) a where deriveNamedResolver :: f k a -> [NamedResolver m] instance DeriveNamedResolver m SCALAR a where deriveNamedResolver :: forall (f :: DerivingKind -> k -> *). f SCALAR a -> [NamedResolver m] deriveNamedResolver f SCALAR a _ = [] instance ( Monad m, LiftOperation o, Generic a, GQLType a, EncodeFieldKind (KIND a) (Resolver o e m) a, Decode (Dep a), ResolveNamed (Resolver o e m) a, TypeRep (Encode (Resolver o e m)) (Resolver o e m (ResolverValue (Resolver o e m))) (Rep a) ) => DeriveNamedResolver (Resolver o e m) TYPE (a :: Type) where deriveNamedResolver :: forall (f :: DerivingKind -> * -> *). f TYPE a -> [NamedResolver (Resolver o e m)] deriveNamedResolver f TYPE a _ = [ NamedResolver { resolverName :: TypeName resolverName = forall a (f :: * -> *). GQLType a => f a -> TypeName getTypeName (forall {k} (t :: k). Proxy t Proxy @a), resolver :: ValidValue -> Resolver o e m (NamedResolverResult (Resolver o e m)) resolver = ValidValue -> Resolver o e m a resolve forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall (m :: * -> *) a. (MonadError GQLError m, FieldConstraint m a) => a -> m (NamedResolverResult m) encodeResolverValue } ] where resolve :: ValidValue -> Resolver o e m a resolve :: ValidValue -> Resolver o e m a resolve ValidValue x = forall (o :: OperationType) (m :: * -> *) a e. (LiftOperation o, Monad m) => ResolverState a -> Resolver o e m a liftResolverState (forall a. Decode a => ValidValue -> ResolverState a decode ValidValue x :: ResolverState (Dep a)) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) a. (ResolveNamed m a, Monad m) => Dep a -> m a resolveNamed instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (NamedResolverT m a) where deriveNamedResolver :: forall (f :: DerivingKind -> * -> *). f CUSTOM (NamedResolverT m a) -> [NamedResolver m] deriveNamedResolver f CUSTOM (NamedResolverT m a) _ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). DeriveNamedResolver m k a => f k a -> [NamedResolver m] deriveNamedResolver (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a KindedProxy :: KindedProxy (KIND a) a) instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m CUSTOM (input -> a) where deriveNamedResolver :: forall (f :: DerivingKind -> * -> *). f CUSTOM (input -> a) -> [NamedResolver m] deriveNamedResolver f CUSTOM (input -> a) _ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). DeriveNamedResolver m k a => f k a -> [NamedResolver m] deriveNamedResolver (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a KindedProxy :: KindedProxy (KIND a) a) instance DeriveNamedResolver m (KIND a) a => DeriveNamedResolver m WRAPPER (f a) where deriveNamedResolver :: forall (f :: DerivingKind -> k -> *). f WRAPPER (f a) -> [NamedResolver m] deriveNamedResolver f WRAPPER (f a) _ = forall {k} (m :: * -> *) (k :: DerivingKind) (a :: k) (f :: DerivingKind -> k -> *). DeriveNamedResolver m k a => f k a -> [NamedResolver m] deriveNamedResolver (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a KindedProxy :: KindedProxy (KIND a) a)