{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.App.Internal.Resolving.ResolveValue
( resolvePlainRoot,
resolveNamedRoot,
)
where
import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.App.Internal.Resolving.Batching
( MonadBatching (..),
runBatchedT,
)
import Data.Morpheus.App.Internal.Resolving.Cache (CacheValue (..))
import Data.Morpheus.App.Internal.Resolving.MonadResolver (MonadResolver)
import Data.Morpheus.App.Internal.Resolving.ResolverState
( ResolverContext (..),
inSelectionField,
)
import Data.Morpheus.App.Internal.Resolving.Types
( ResolverMap,
mkEnum,
mkNull,
mkString,
mkUnion,
)
import Data.Morpheus.App.Internal.Resolving.Utils
import Data.Morpheus.Internal.Utils
( KeyOf (keyOf),
empty,
traverseCollection,
)
import Data.Morpheus.Types.Internal.AST
( ObjectEntry (ObjectEntry),
ScalarValue (..),
Selection (..),
SelectionContent (..),
SelectionSet,
TypeDefinition (..),
TypeName,
VALID,
ValidValue,
Value (..),
internal,
unitFieldName,
unitTypeName,
unpackName,
)
import Relude hiding (empty)
resolvePlainRoot :: MonadResolver m => ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue
resolvePlainRoot :: forall (m :: * -> *).
MonadResolver m =>
ObjectTypeResolver m -> SelectionSet VALID -> m ValidValue
resolvePlainRoot ObjectTypeResolver m
resolver SelectionSet VALID
selection = do
TypeName
name <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> TypeDefinition ANY VALID
currentType)
forall {k} (f :: k -> *) (a :: k). IdentityT f a -> f a
runIdentityT (forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection (forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet SelectionSet VALID
selection) (forall (m :: * -> *).
Maybe TypeName -> ObjectTypeResolver m -> ResolverValue m
ResObject (forall a. a -> Maybe a
Just TypeName
name) ObjectTypeResolver m
resolver))
resolveNamedRoot :: MonadResolver m => TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue
resolveNamedRoot :: forall (m :: * -> *).
MonadResolver m =>
TypeName -> ResolverMap m -> SelectionSet VALID -> m ValidValue
resolveNamedRoot TypeName
typeName ResolverMap m
resolvers SelectionSet VALID
selection =
forall (m :: * -> *) a.
Monad m =>
ResolverMapT m a -> ResolverMap m -> m a
runBatchedT
(forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection (forall (s :: Stage). SelectionSet s -> SelectionContent s
SelectionSet SelectionSet VALID
selection) (forall (m :: * -> *). m NamedResolverRef -> ResolverValue m
ResRef forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeName -> NamedResolverArg -> NamedResolverRef
NamedResolverRef TypeName
typeName [ValidValue
"ROOT"])))
ResolverMap m
resolvers
resolveSelection :: (ResolverMonad (t m), MonadBatching t, MonadResolver m) => SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection :: forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection SelectionContent VALID
selection (ResLazy m (ResolverValue m)
x) = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m (ResolverValue m)
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection SelectionContent VALID
selection
resolveSelection SelectionContent VALID
selection (ResList [ResolverValue m]
xs) = forall (stage :: Stage). [Value stage] -> Value stage
List forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection SelectionContent VALID
selection) [ResolverValue m]
xs
resolveSelection SelectionContent VALID
SelectionField (ResEnum TypeName
name) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
String forall a b. (a -> b) -> a -> b
$ forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name
resolveSelection selection :: SelectionContent VALID
selection@UnionSelection {} (ResEnum TypeName
name) = forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection SelectionContent VALID
selection (forall (m :: * -> *).
Monad m =>
TypeName -> [ResolverEntry m] -> ResolverValue m
mkUnion TypeName
name [(FieldName
unitFieldName, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). TypeName -> ResolverValue m
mkEnum TypeName
unitTypeName)])
resolveSelection SelectionContent VALID
_ ResEnum {} = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"wrong selection on enum value")
resolveSelection SelectionContent VALID
_ ResolverValue m
ResNull = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (stage :: Stage). Value stage
Null
resolveSelection SelectionContent VALID
SelectionField (ResScalar ScalarValue
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). ScalarValue -> Value stage
Scalar ScalarValue
x
resolveSelection SelectionContent VALID
_ ResScalar {} = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"scalar resolver should only receive SelectionField")
resolveSelection SelectionContent VALID
selection (ResObject Maybe TypeName
typeName ObjectTypeResolver m
obj) = forall (m :: * -> *) value.
ResolverMonad m =>
Maybe TypeName
-> (Maybe (SelectionSet VALID) -> m value)
-> SelectionContent VALID
-> m value
withObject Maybe TypeName
typeName (forall (m :: * -> *).
ResolverMonad m =>
(Selection VALID -> m ValidValue)
-> Maybe (SelectionSet VALID) -> m ValidValue
mapSelectionSet Selection VALID -> t m ValidValue
resolveField) SelectionContent VALID
selection
where
resolveField :: Selection VALID -> t m ValidValue
resolveField Selection VALID
s = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadResolver m =>
ObjectTypeResolver m -> Selection VALID -> m (ResolverValue m)
toResolverValue ObjectTypeResolver m
obj Selection VALID
s) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection (forall (s :: Stage). Selection s -> SelectionContent s
selectionContent Selection VALID
s)
resolveSelection SelectionContent VALID
selection (ResRef m NamedResolverRef
mRef) = do
(CacheKey
key, CacheValue m
value) <- forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadBatching t, ResolverMonad m) =>
SelectionContent VALID
-> NamedResolverRef -> t m (CacheKey, CacheValue m)
resolveRef SelectionContent VALID
selection forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m NamedResolverRef
mRef
case CacheValue m
value of
(CachedValue ValidValue
v) -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ValidValue
v
(CachedResolver ResolverValue m
v) -> forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(ResolverMonad (t m), MonadBatching t, MonadResolver m) =>
SelectionContent VALID -> ResolverValue m -> t m ValidValue
resolveSelection SelectionContent VALID
selection ResolverValue m
v forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (t :: (* -> *) -> * -> *) (m :: * -> *).
(MonadBatching t, ResolverMonad m) =>
CacheKey -> ValidValue -> t m ValidValue
storeValue CacheKey
key
toResolverValue ::
(MonadResolver m) =>
ObjectTypeResolver m ->
Selection VALID ->
m (ResolverValue m)
toResolverValue :: forall (m :: * -> *).
MonadResolver m =>
ObjectTypeResolver m -> Selection VALID -> m (ResolverValue m)
toResolverValue ObjectTypeResolver m
obj Selection {FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName
selectionName}
| FieldName
selectionName forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" = forall (m :: * -> *). Text -> ResolverValue m
mkString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResolverContext -> TypeDefinition ANY VALID
currentType)
| Bool
otherwise = forall (m' :: * -> *) a (m :: * -> *).
Monad m' =>
a
-> (m (ResolverValue m) -> m' a)
-> FieldName
-> ObjectTypeResolver m
-> m' a
withField forall (m :: * -> *). ResolverValue m
mkNull forall a. a -> a
id FieldName
selectionName ObjectTypeResolver m
obj
mapSelectionSet :: (ResolverMonad m) => (Selection VALID -> m ValidValue) -> Maybe (SelectionSet VALID) -> m ValidValue
mapSelectionSet :: forall (m :: * -> *).
ResolverMonad m =>
(Selection VALID -> m ValidValue)
-> Maybe (SelectionSet VALID) -> m ValidValue
mapSelectionSet Selection VALID -> m ValidValue
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (stage :: Stage). Object stage -> Value stage
Object forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall coll. Empty coll => coll
empty) (forall (m :: * -> *) k b (map :: * -> * -> *) (t :: * -> *) a.
(Monad m, MonadError GQLError m, KeyOf k b, FromList m map k b,
Foldable t) =>
(a -> m b) -> t a -> m (map k b)
traverseCollection (\Selection VALID
sel -> forall (s :: Stage). FieldName -> Value s -> ObjectEntry s
ObjectEntry (forall k a. KeyOf k a => a -> k
keyOf Selection VALID
sel) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) b.
(MonadReader ResolverContext m, MonadError GQLError m) =>
Selection VALID -> m b -> m b
inSelectionField Selection VALID
sel (Selection VALID -> m ValidValue
f Selection VALID
sel)))