{-# 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.Kinded.NamedResolver ( KindedNamedResolver (..), ) where import Data.Morpheus.App.Internal.Resolving ( MonadResolver (..), NamedResolver (..), NamedResolverResult (..), ResolverValue, ) import Data.Morpheus.Server.Deriving.Kinded.NamedResolverFun ( deriveNamedResolverFun, ) import Data.Morpheus.Server.Deriving.Utils.GRep (GRep) import Data.Morpheus.Server.Deriving.Utils.GScan (ScanRef (..)) import Data.Morpheus.Server.Deriving.Utils.Gmap (Gmap) import Data.Morpheus.Server.Deriving.Utils.Kinded (outputType) import Data.Morpheus.Server.Deriving.Utils.Use (UseDeriving (..), UseGQLType (useFingerprint, useTypename), UseNamedResolver (..), UseValue (useDecodeValue)) import Data.Morpheus.Server.Types.Kind ( CUSTOM, DerivingKind, SCALAR, TYPE, WRAPPER, ) import Data.Morpheus.Server.Types.NamedResolvers (Dependency, NamedResolverT (..), ResolveNamed (..)) import Data.Morpheus.Types.GQLScalar (EncodeScalar (..)) import Data.Morpheus.Types.Internal.AST ( ValidValue, ) import GHC.Generics (Rep) import Relude type DECODE_VALUES val m a = (ResolveNamed m a, val (Dependency a), MonadResolver m) decodeValues :: DECODE_VALUES val m a => UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a] decodeValues :: forall (val :: * -> Constraint) (m :: * -> *) a (gql :: * -> Constraint). DECODE_VALUES val m a => UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a] decodeValues UseDeriving gql val ctx Proxy a _ [ValidValue] xs = forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (m :: * -> *) a. MonadResolver m => ResolverState a -> m a liftState forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (val :: * -> Constraint). UseValue val -> forall a. val a => ValidValue -> ResolverState a useDecodeValue (forall (gql :: * -> Constraint) (val :: * -> Constraint). UseDeriving gql val -> UseValue val dirArgs UseDeriving gql val ctx)) [ValidValue] xs forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *) a. (ResolveNamed m a, MonadError GQLError m) => [Dependency a] -> m [Maybe a] resolveBatched class KindedNamedResolver namedRes resFun gql val (m :: Type -> Type) (k :: DerivingKind) a where kindedNamedResolver :: UseNamedResolver namedRes resFun gql val -> f k a -> [NamedResolver m] kindedNamedRefs :: UseNamedResolver namedRes resFun gql val -> f k a -> [ScanRef (namedRes m)] instance ( DECODE_VALUES val m a, gql a, namedRes m a, EncodeScalar a ) => KindedNamedResolver namedRes resFun gql val m SCALAR a where kindedNamedResolver :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f SCALAR a -> [NamedResolver m] kindedNamedResolver UseNamedResolver namedRes resFun gql val ctx f SCALAR a _ = [ NamedResolver { resolverName :: TypeName resolverName = forall (gql :: * -> Constraint). UseGQLType gql -> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName useTypename (forall (gql :: * -> Constraint) (val :: * -> Constraint). UseDeriving gql val -> UseGQLType gql dirGQL forall a b. (a -> b) -> a -> b $ forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a outputType Proxy a proxy), resolverFun :: NamedResolverFun m resolverFun = forall (val :: * -> Constraint) (m :: * -> *) a (gql :: * -> Constraint). DECODE_VALUES val m a => UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a] decodeValues (forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) Proxy a proxy forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map (forall b a. b -> (a -> b) -> Maybe a -> b maybe forall (m :: * -> *). NamedResolverResult m NamedNullResolver (forall (m :: * -> *). ScalarValue -> NamedResolverResult m NamedScalarResolver forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. EncodeScalar a => a -> ScalarValue encodeScalar)) } ] where proxy :: Proxy a proxy = forall {k} (t :: k). Proxy t Proxy @a kindedNamedRefs :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f SCALAR a -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver namedRes resFun gql val ctx f SCALAR a _ = [forall (f :: * -> *) a (c :: * -> Constraint). c a => TypeFingerprint -> f a -> ScanRef c ScanType TypeFingerprint fp Proxy a proxy] where fp :: TypeFingerprint fp = forall (gql :: * -> Constraint). UseGQLType gql -> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeFingerprint useFingerprint (forall (gql :: * -> Constraint) (val :: * -> Constraint). UseDeriving gql val -> UseGQLType gql dirGQL forall a b. (a -> b) -> a -> b $ forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a outputType Proxy a proxy) proxy :: Proxy a proxy = forall {k} (t :: k). Proxy t Proxy @a instance ( DECODE_VALUES val m a, gql a, namedRes m a, Generic a, gql [Maybe a], GRep gql (resFun m) (m (ResolverValue m)) (Rep a), Gmap (namedRes m) (Rep a) ) => KindedNamedResolver namedRes resFun gql val m TYPE (a :: Type) where kindedNamedResolver :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f TYPE a -> [NamedResolver m] kindedNamedResolver UseNamedResolver namedRes resFun gql val ctx f TYPE a _ = [ NamedResolver { resolverName :: TypeName resolverName = forall (gql :: * -> Constraint). UseGQLType gql -> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName useTypename (forall (gql :: * -> Constraint) (val :: * -> Constraint). UseDeriving gql val -> UseGQLType gql dirGQL forall a b. (a -> b) -> a -> b $ forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a outputType Proxy a proxy), resolverFun :: NamedResolverFun m resolverFun = forall (val :: * -> Constraint) (m :: * -> *) a (gql :: * -> Constraint). DECODE_VALUES val m a => UseDeriving gql val -> Proxy a -> [ValidValue] -> m [Maybe a] decodeValues (forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) Proxy a proxy forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> forall a (gql :: * -> Constraint) (m :: * -> *) (res :: (* -> *) -> * -> Constraint) (namedRes :: (* -> *) -> * -> Constraint) (val :: * -> Constraint). (Generic a, gql [Maybe a], gql a, MonadError GQLError m, GRep gql (res m) (m (ResolverValue m)) (Rep a)) => UseNamedResolver namedRes res gql val -> [Maybe a] -> m [NamedResolverResult m] deriveNamedResolverFun UseNamedResolver namedRes resFun gql val ctx } ] where proxy :: Proxy a proxy = forall {k} (t :: k). Proxy t Proxy @a kindedNamedRefs :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f TYPE a -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver namedRes resFun gql val ctx f TYPE a _ = [forall (f :: * -> *) a (c :: * -> Constraint). (Gmap c (Rep a), c a) => TypeFingerprint -> f a -> ScanRef c ScanObject (forall (gql :: * -> Constraint). UseGQLType gql -> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeFingerprint useFingerprint (forall (gql :: * -> Constraint) (val :: * -> Constraint). UseDeriving gql val -> UseGQLType gql dirGQL forall a b. (a -> b) -> a -> b $ forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> UseDeriving gql val namedDrv UseNamedResolver namedRes resFun gql val ctx) (forall {k} (f :: k -> *) (a :: k). f a -> CatType OUT a outputType Proxy a proxy)) Proxy a proxy] where proxy :: Proxy a proxy = forall {k} (t :: k). Proxy t Proxy @a instance namedRes m a => KindedNamedResolver namedRes resFun gql val m CUSTOM (NamedResolverT m a) where kindedNamedResolver :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f CUSTOM (NamedResolverT m a) -> [NamedResolver m] kindedNamedResolver UseNamedResolver namedRes resFun gql val ctx f CUSTOM (NamedResolverT m a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [NamedResolver m] useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a) kindedNamedRefs :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f CUSTOM (NamedResolverT m a) -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver namedRes resFun gql val ctx f CUSTOM (NamedResolverT m a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [ScanRef (named m)] useDeriveNamedRefs UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a) instance namedRes m a => KindedNamedResolver namedRes resFun gql val m CUSTOM (input -> a) where kindedNamedResolver :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f CUSTOM (input -> a) -> [NamedResolver m] kindedNamedResolver UseNamedResolver namedRes resFun gql val ctx f CUSTOM (input -> a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [NamedResolver m] useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a) kindedNamedRefs :: forall (f :: DerivingKind -> * -> *). UseNamedResolver namedRes resFun gql val -> f CUSTOM (input -> a) -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver namedRes resFun gql val ctx f CUSTOM (input -> a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [ScanRef (named m)] useDeriveNamedRefs UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a) instance namedRes m a => KindedNamedResolver namedRes resFun gql val m WRAPPER (f a) where kindedNamedResolver :: forall (f :: DerivingKind -> k -> *). UseNamedResolver namedRes resFun gql val -> f WRAPPER (f a) -> [NamedResolver m] kindedNamedResolver UseNamedResolver namedRes resFun gql val ctx f WRAPPER (f a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [NamedResolver m] useDeriveNamedResolvers UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a) kindedNamedRefs :: forall (f :: DerivingKind -> k -> *). UseNamedResolver namedRes resFun gql val -> f WRAPPER (f a) -> [ScanRef (namedRes m)] kindedNamedRefs UseNamedResolver namedRes resFun gql val ctx f WRAPPER (f a) _ = forall (named :: (* -> *) -> * -> Constraint) (fun :: (* -> *) -> * -> Constraint) (gql :: * -> Constraint) (val :: * -> Constraint). UseNamedResolver named fun gql val -> forall (f :: * -> *) a (m :: * -> *). named m a => f a -> [ScanRef (named m)] useDeriveNamedRefs UseNamedResolver namedRes resFun gql val ctx (forall {k} (t :: k). Proxy t Proxy @a)