{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Kinded.Resolver
( KindedResolver (..),
)
where
import Control.Monad.Except (MonadError)
import qualified Data.Map as M
import Data.Morpheus.App.Internal.Resolving
( MonadResolver (..),
ResolverValue (..),
getArguments,
)
import Data.Morpheus.Server.Deriving.Internal.Resolve.Explore
import Data.Morpheus.Server.Deriving.Utils.AST
import Data.Morpheus.Server.Deriving.Utils.Proxy
( ContextValue (..),
)
import Data.Morpheus.Server.Deriving.Utils.Use
( UseDeriving (dirArgs),
UseResolver (..),
UseValue (useDecodeValue),
)
import Data.Morpheus.Server.Types.Kind
( CUSTOM,
DerivingKind,
SCALAR,
TYPE,
WRAPPER,
)
import Data.Morpheus.Server.Types.Types
( TypeGuard (..),
)
import Data.Morpheus.Types.GQLScalar
( EncodeScalar (..),
)
import Data.Morpheus.Types.GQLWrapper (EncodeWrapper (..))
import Data.Morpheus.Types.Internal.AST
( GQLError,
)
import Relude
class KindedResolver gql res val (kind :: DerivingKind) (m :: Type -> Type) (a :: Type) where
kindedResolver :: UseResolver res gql val -> ContextValue kind a -> m (ResolverValue m)
instance (EncodeWrapper f, Monad m, res m a) => KindedResolver gql res val WRAPPER m (f a) where
kindedResolver :: UseResolver res gql val
-> ContextValue WRAPPER (f a) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res = forall (wrapper :: * -> *) (m :: * -> *) a.
(EncodeWrapper wrapper, Monad m) =>
(a -> m (ResolverValue m)) -> wrapper a -> m (ResolverValue m)
encodeWrapper (forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (EncodeScalar a, Monad m) => KindedResolver gql res val SCALAR m a where
kindedResolver :: UseResolver res gql val
-> ContextValue SCALAR a -> m (ResolverValue m)
kindedResolver UseResolver res gql val
_ = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *). ScalarValue -> ResolverValue m
ResScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncodeScalar a => a -> ScalarValue
encodeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (MonadError GQLError m, EXPLORE gql res m a) => KindedResolver gql res val TYPE m a where
kindedResolver :: UseResolver res gql val
-> ContextValue TYPE a -> m (ResolverValue m)
kindedResolver UseResolver res gql val
ctx = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
ctx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (Monad m, res m [(k, v)]) => KindedResolver gql res val CUSTOM m (Map k v) where
kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (Map k v) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res = forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [(k, a)]
M.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue
instance (MonadError GQLError m, EXPLORE gql res m guard, EXPLORE gql res m union) => KindedResolver gql res val CUSTOM m (TypeGuard guard union) where
kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (TypeGuard guard union)
-> m (ResolverValue m)
kindedResolver UseResolver res gql val
ctx (ContextValue (ResolveType union
value)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
ctx union
value)
kindedResolver UseResolver res gql val
ctx (ContextValue (ResolveInterface guard
value)) = forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (m :: * -> *) (gql :: * -> Constraint)
(res :: (* -> *) -> * -> Constraint) a (val :: * -> Constraint).
(MonadError GQLError m, EXPLORE gql res m a) =>
UseResolver res gql val -> a -> ResolverValue m
useExploreResolvers UseResolver res gql val
ctx guard
value)
instance (Generic a, res m b, MonadResolver m, val a) => KindedResolver gql res val CUSTOM m (a -> b) where
kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (a -> b) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res (ContextValue a -> b
f) =
forall (m :: * -> *). MonadResolver m => m (Arguments VALID)
getArguments
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall a b. (a -> b) -> a -> b
$ forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val -> UseDeriving gql val
resDrv UseResolver res gql val
res) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments VALID -> ValidValue
argumentsToObject
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f
instance (MonadResolver m, res m a) => KindedResolver gql res val CUSTOM m (m a) where
kindedResolver :: UseResolver res gql val
-> ContextValue CUSTOM (m a) -> m (ResolverValue m)
kindedResolver UseResolver res gql val
res (ContextValue m a
value) = m a
value forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (res :: (* -> *) -> * -> Constraint)
(gql :: * -> Constraint) (val :: * -> Constraint).
UseResolver res gql val
-> forall a (m :: * -> *). res m a => a -> m (ResolverValue m)
useEncodeResolver UseResolver res gql val
res