{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.App.Internal.Resolving.ResolveValue ( resolveRef, resolveObject, ResolverMapContext (..), ) where import Control.Monad.Except (MonadError (throwError)) import qualified Data.HashMap.Lazy as HM import Data.Morpheus.App.Internal.Resolving.Batching ( CacheKey (..), ResolverMapContext (..), ResolverMapT, buildCacheWith, runResMapT, useCached, ) import Data.Morpheus.App.Internal.Resolving.ResolverState ( ResolverContext (..), askFieldTypeName, updateCurrentType, ) import Data.Morpheus.App.Internal.Resolving.Types ( NamedResolver (..), NamedResolverRef (..), NamedResolverResult (..), ObjectTypeResolver (..), ResolverMap, ResolverValue (..), mkEnum, mkUnion, ) import Data.Morpheus.Error (subfieldsNotSelected) import Data.Morpheus.Internal.Utils ( KeyOf (keyOf), empty, selectOr, traverseCollection, (<:>), ) import Data.Morpheus.Types.Internal.AST ( GQLError, Msg (msg), ObjectEntry (ObjectEntry), ScalarValue (..), Selection (..), SelectionContent (..), SelectionSet, TypeDefinition (..), TypeName, UnionTag (unionTagSelection), VALID, ValidValue, Value (..), internal, unitFieldName, unitTypeName, unpackName, ) import Relude hiding (empty) scanRefs :: (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs SelectionContent VALID sel (ResList [ResolverValue m] xs) = forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat 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 (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs SelectionContent VALID sel) [ResolverValue m] xs scanRefs SelectionContent VALID sel (ResLazy m (ResolverValue m) x) = m (ResolverValue m) x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs SelectionContent VALID sel scanRefs SelectionContent VALID sel (ResObject Maybe TypeName tyName ObjectTypeResolver m obj) = forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => Maybe TypeName -> (Maybe (SelectionSet VALID) -> m value) -> SelectionContent VALID -> m value withObject Maybe TypeName tyName (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m [(SelectionContent VALID, NamedResolverRef)] objectRefs ObjectTypeResolver m obj) SelectionContent VALID sel scanRefs SelectionContent VALID sel (ResRef m NamedResolverRef ref) = forall (f :: * -> *) a. Applicative f => a -> f a pure forall b c a. (b -> c) -> (a -> b) -> a -> c . (SelectionContent VALID sel,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> m NamedResolverRef ref scanRefs SelectionContent VALID _ ResEnum {} = forall (f :: * -> *) a. Applicative f => a -> f a pure [] scanRefs SelectionContent VALID _ ResolverValue m ResNull = forall (f :: * -> *) a. Applicative f => a -> f a pure [] scanRefs SelectionContent VALID _ ResScalar {} = forall (f :: * -> *) a. Applicative f => a -> f a pure [] objectRefs :: ( MonadError GQLError m, MonadReader ResolverContext m ) => ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m [(SelectionContent VALID, NamedResolverRef)] objectRefs :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m [(SelectionContent VALID, NamedResolverRef)] objectRefs ObjectTypeResolver m _ Maybe (SelectionSet VALID) Nothing = forall (f :: * -> *) a. Applicative f => a -> f a pure [] objectRefs ObjectTypeResolver m dr (Just SelectionSet VALID sel) = forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat 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 (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Selection VALID -> m [(SelectionContent VALID, NamedResolverRef)] fieldRefs ObjectTypeResolver m dr) (forall (t :: * -> *) a. Foldable t => t a -> [a] toList SelectionSet VALID sel) fieldRefs :: (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Selection VALID -> m [(SelectionContent VALID, NamedResolverRef)] fieldRefs :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Selection VALID -> m [(SelectionContent VALID, NamedResolverRef)] fieldRefs ObjectTypeResolver {HashMap FieldName (m (ResolverValue m)) objectFields :: forall (m :: * -> *). ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m)) objectFields :: HashMap FieldName (m (ResolverValue m)) ..} currentSelection :: Selection VALID currentSelection@Selection {Maybe FragmentName Maybe FieldName SelectionContent VALID FieldName Position Arguments VALID Directives VALID selectionPosition :: forall (s :: Stage). Selection s -> Position selectionAlias :: forall (s :: Stage). Selection s -> Maybe FieldName selectionName :: forall (s :: Stage). Selection s -> FieldName selectionArguments :: forall (s :: Stage). Selection s -> Arguments s selectionDirectives :: forall (s :: Stage). Selection s -> Directives s selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s selectionOrigin :: forall (s :: Stage). Selection s -> Maybe FragmentName selectionOrigin :: Maybe FragmentName selectionContent :: SelectionContent VALID selectionDirectives :: Directives VALID selectionArguments :: Arguments VALID selectionName :: FieldName selectionAlias :: Maybe FieldName selectionPosition :: Position ..} | FieldName selectionName forall a. Eq a => a -> a -> Bool == FieldName "__typename" = forall (f :: * -> *) a. Applicative f => a -> f a pure [] | Bool otherwise = do Maybe TypeName t <- forall (m :: * -> *). MonadReader ResolverContext m => FieldName -> m (Maybe TypeName) askFieldTypeName FieldName selectionName forall (m :: * -> *) a. (MonadReader ResolverContext m, MonadError GQLError m) => Maybe TypeName -> m a -> m a updateCurrentType Maybe TypeName t forall a b. (a -> b) -> a -> b $ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (\ResolverContext ctx -> ResolverContext ctx {Selection VALID currentSelection :: Selection VALID currentSelection :: Selection VALID currentSelection}) forall a b. (a -> b) -> a -> b $ do [ResolverValue m] x <- forall b a. b -> (a -> b) -> Maybe a -> b maybe (forall (f :: * -> *) a. Applicative f => a -> f a pure []) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall (f :: * -> *) a. Applicative f => a -> f a pure) (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup FieldName selectionName HashMap FieldName (m (ResolverValue m)) objectFields) forall (t :: * -> *) a. Foldable t => t [a] -> [a] concat 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 (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs SelectionContent VALID selectionContent) [ResolverValue m] x resolveSelection :: ( Monad m, MonadReader ResolverContext m, MonadError GQLError m ) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection :: forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection ResolverValue m res SelectionContent VALID selection = do ResolverMapContext m ctx <- forall r (m :: * -> *). MonadReader r m => m r ask ResolverMapContext m newRmap <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => SelectionContent VALID -> ResolverValue m -> m [(SelectionContent VALID, NamedResolverRef)] scanRefs SelectionContent VALID selection ResolverValue m res forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> [(SelectionContent VALID, NamedResolverRef)] -> m (ResolverMapContext m) buildCache ResolverMapContext m ctx) forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (forall a b. a -> b -> a const ResolverMapContext m newRmap) (forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue __resolveSelection ResolverValue m res SelectionContent VALID selection) buildCache :: (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> [(SelectionContent VALID, NamedResolverRef)] -> m (ResolverMapContext m) buildCache :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> [(SelectionContent VALID, NamedResolverRef)] -> m (ResolverMapContext m) buildCache ctx :: ResolverMapContext m ctx@(ResolverMapContext LocalCache cache ResolverMap m rmap) [(SelectionContent VALID, NamedResolverRef)] entries = (forall (m :: * -> *). LocalCache -> ResolverMap m -> ResolverMapContext m `ResolverMapContext` ResolverMap m rmap) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *). Monad m => ResolverFun m -> LocalCache -> [(SelectionContent VALID, NamedResolverRef)] -> m LocalCache buildCacheWith (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m [ValidValue] resolveRefsCached ResolverMapContext m ctx) LocalCache cache [(SelectionContent VALID, NamedResolverRef)] entries __resolveSelection :: ( Monad m, MonadReader ResolverContext m, MonadError GQLError m ) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue __resolveSelection :: forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue __resolveSelection (ResLazy m (ResolverValue m) x) SelectionContent VALID selection = 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 (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue `resolveSelection` SelectionContent VALID selection) __resolveSelection (ResList [ResolverValue m] xs) SelectionContent VALID selection = 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 (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue `resolveSelection` SelectionContent VALID selection) [ResolverValue m] xs __resolveSelection (ResObject Maybe TypeName tyName ObjectTypeResolver m obj) SelectionContent VALID sel = do ResolverMapContext m ctx <- forall r (m :: * -> *). MonadReader r m => m r ask forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => Maybe TypeName -> (Maybe (SelectionSet VALID) -> m value) -> SelectionContent VALID -> m value withObject Maybe TypeName tyName (forall (m :: * -> *). (MonadReader ResolverContext m, MonadError GQLError m) => ResolverMapContext m -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m ValidValue resolveObject ResolverMapContext m ctx ObjectTypeResolver m obj) SelectionContent VALID sel __resolveSelection (ResEnum TypeName name) SelectionContent VALID SelectionField = 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 (ResEnum TypeName name) unionSel :: SelectionContent VALID unionSel@UnionSelection {} = forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection (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)]) SelectionContent VALID unionSel __resolveSelection ResEnum {} SelectionContent VALID _ = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> GQLError internal GQLError "wrong selection on enum value") __resolveSelection ResolverValue m ResNull SelectionContent VALID _ = forall (f :: * -> *) a. Applicative f => a -> f a pure forall (stage :: Stage). Value stage Null __resolveSelection (ResScalar ScalarValue x) SelectionContent VALID SelectionField = 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 ResScalar {} SelectionContent VALID _ = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> GQLError internal GQLError "scalar Resolver should only receive SelectionField") __resolveSelection (ResRef m NamedResolverRef ref) SelectionContent VALID sel = do ResolverMapContext m ctx <- forall r (m :: * -> *). MonadReader r m => m r ask forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m NamedResolverRef ref forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a b c. (a -> b -> c) -> b -> a -> c flip (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m ValidValue resolveRef ResolverMapContext m ctx) SelectionContent VALID sel) withObject :: ( MonadError GQLError m, MonadReader ResolverContext m ) => Maybe TypeName -> (Maybe (SelectionSet VALID) -> m value) -> SelectionContent VALID -> m value withObject :: forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => Maybe TypeName -> (Maybe (SelectionSet VALID) -> m value) -> SelectionContent VALID -> m value withObject Maybe TypeName __typename Maybe (SelectionSet VALID) -> m value f = forall (m :: * -> *) a. (MonadReader ResolverContext m, MonadError GQLError m) => Maybe TypeName -> m a -> m a updateCurrentType Maybe TypeName __typename forall b c a. (b -> c) -> (a -> b) -> a -> c . SelectionContent VALID -> m value checkContent where checkContent :: SelectionContent VALID -> m value checkContent (SelectionSet SelectionSet VALID selection) = Maybe (SelectionSet VALID) -> m value f (forall a. a -> Maybe a Just SelectionSet VALID selection) checkContent (UnionSelection Maybe (SelectionSet VALID) interface UnionSelection VALID unionSel) = do TypeName typename <- 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) Maybe (MergeMap 'False FieldName (Selection VALID)) selection <- forall k (c :: * -> *) d a. IsMap k c => d -> (a -> d) -> k -> c a -> d selectOr (forall (f :: * -> *) a. Applicative f => a -> f a pure Maybe (SelectionSet VALID) interface) (forall {f :: * -> *}. MonadError GQLError f => Maybe (MergeMap 'False FieldName (Selection VALID)) -> UnionTag -> f (Maybe (MergeMap 'False FieldName (Selection VALID))) fx Maybe (SelectionSet VALID) interface) TypeName typename UnionSelection VALID unionSel Maybe (SelectionSet VALID) -> m value f Maybe (MergeMap 'False FieldName (Selection VALID)) selection where fx :: Maybe (MergeMap 'False FieldName (Selection VALID)) -> UnionTag -> f (Maybe (MergeMap 'False FieldName (Selection VALID))) fx (Just MergeMap 'False FieldName (Selection VALID) x) UnionTag y = forall a. a -> Maybe a Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (MergeMap 'False FieldName (Selection VALID) x forall (m :: * -> *) a. (Merge (HistoryT m) a, Monad m) => a -> a -> m a <:> UnionTag -> SelectionSet VALID unionTagSelection UnionTag y) fx Maybe (MergeMap 'False FieldName (Selection VALID)) Nothing UnionTag y = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ UnionTag -> SelectionSet VALID unionTagSelection UnionTag y checkContent SelectionContent VALID SelectionField = forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => m value noEmptySelection noEmptySelection :: (MonadError GQLError m, MonadReader ResolverContext m) => m value noEmptySelection :: forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => m value noEmptySelection = do Selection VALID sel <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ResolverContext -> Selection VALID currentSelection forall e (m :: * -> *) a. MonadError e m => e -> m a throwError forall a b. (a -> b) -> a -> b $ FieldName -> TypeName -> Position -> GQLError subfieldsNotSelected (forall (s :: Stage). Selection s -> FieldName selectionName Selection VALID sel) TypeName "" (forall (s :: Stage). Selection s -> Position selectionPosition Selection VALID sel) resolveRef :: ( MonadError GQLError m, MonadReader ResolverContext m ) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m ValidValue resolveRef :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m ValidValue resolveRef ResolverMapContext m rmap NamedResolverRef ref SelectionContent VALID selection = forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m [ValidValue] resolveRefsCached ResolverMapContext m rmap NamedResolverRef ref SelectionContent VALID selection forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (f :: * -> *) a. (MonadError GQLError f, Show a) => [a] -> f a toOne toOne :: (MonadError GQLError f, Show a) => [a] -> f a toOne :: forall (f :: * -> *) a. (MonadError GQLError f, Show a) => [a] -> f a toOne [a x] = forall (f :: * -> *) a. Applicative f => a -> f a pure a x toOne [a] x = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError -> GQLError internal (GQLError "expected only one resolved value for " forall a. Semigroup a => a -> a -> a <> forall a. Msg a => a -> GQLError msg (forall b a. (Show a, IsString b) => a -> b show [a] x :: String))) resolveRefsCached :: ( MonadError GQLError m, MonadReader ResolverContext m ) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m [ValidValue] resolveRefsCached :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> NamedResolverRef -> SelectionContent VALID -> m [ValidValue] resolveRefsCached ResolverMapContext m ctx (NamedResolverRef TypeName name [ValidValue] args) SelectionContent VALID selection = do let keys :: [CacheKey] keys = forall a b. (a -> b) -> [a] -> [b] map (SelectionContent VALID -> TypeName -> ValidValue -> CacheKey CacheKey SelectionContent VALID selection TypeName name) [ValidValue] args let cached :: [(ValidValue, Maybe ValidValue)] cached = forall a b. (a -> b) -> [a] -> [b] map CacheKey -> (ValidValue, Maybe ValidValue) resolveCached [CacheKey] keys let cachedMap :: HashMap ValidValue ValidValue cachedMap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList (forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe forall {a} {b}. (a, Maybe b) -> Maybe (a, b) unp [(ValidValue, Maybe ValidValue)] cached) HashMap ValidValue ValidValue notCachedMap <- forall (m :: * -> *) a. ResolverMapT m a -> ResolverMapContext m -> m a runResMapT (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => TypeName -> SelectionContent VALID -> [ValidValue] -> ResolverMapT m (HashMap ValidValue ValidValue) resolveUncached TypeName name SelectionContent VALID selection forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b $ forall a. (a -> Bool) -> [a] -> [a] filter (forall a. Maybe a -> Bool isNothing forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> b snd) [(ValidValue, Maybe ValidValue)] cached) ResolverMapContext m ctx forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall k (f :: * -> *) a. (Eq k, Show k, Hashable k, MonadError GQLError f) => HashMap k a -> k -> f a useCached (HashMap ValidValue ValidValue cachedMap forall a. Semigroup a => a -> a -> a <> HashMap ValidValue ValidValue notCachedMap)) [ValidValue] args where unp :: (a, Maybe b) -> Maybe (a, b) unp (a _, Maybe b Nothing) = forall a. Maybe a Nothing unp (a x, Just b y) = forall a. a -> Maybe a Just (a x, b y) resolveCached :: CacheKey -> (ValidValue, Maybe ValidValue) resolveCached CacheKey key = (CacheKey -> ValidValue cachedArg CacheKey key, forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup CacheKey key forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). ResolverMapContext m -> LocalCache localCache ResolverMapContext m ctx) processResult :: (MonadError GQLError m, MonadReader ResolverContext m) => TypeName -> SelectionContent VALID -> NamedResolverResult m -> ResolverMapT m ValidValue processResult :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => TypeName -> SelectionContent VALID -> NamedResolverResult m -> ResolverMapT m ValidValue processResult TypeName typename SelectionContent VALID selection (NamedObjectResolver ObjectTypeResolver m res) = do ResolverMapContext m ctx <- forall r (m :: * -> *). MonadReader r m => m r ask forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall a b. (a -> b) -> a -> b $ forall (m :: * -> *) value. (MonadError GQLError m, MonadReader ResolverContext m) => Maybe TypeName -> (Maybe (SelectionSet VALID) -> m value) -> SelectionContent VALID -> m value withObject (forall a. a -> Maybe a Just TypeName typename) (forall (m :: * -> *). (MonadReader ResolverContext m, MonadError GQLError m) => ResolverMapContext m -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m ValidValue resolveObject ResolverMapContext m ctx ObjectTypeResolver m res) SelectionContent VALID selection processResult TypeName _ SelectionContent VALID selection (NamedUnionResolver NamedResolverRef unionRef) = forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection (forall (m :: * -> *). m NamedResolverRef -> ResolverValue m ResRef forall a b. (a -> b) -> a -> b $ forall (f :: * -> *) a. Applicative f => a -> f a pure NamedResolverRef unionRef) SelectionContent VALID selection processResult TypeName _ SelectionContent VALID selection (NamedEnumResolver TypeName value) = forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection (forall (m :: * -> *). TypeName -> ResolverValue m ResEnum TypeName value) SelectionContent VALID selection processResult TypeName _ SelectionContent VALID selection NamedResolverResult m NamedNullResolver = forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue resolveSelection forall (m :: * -> *). ResolverValue m ResNull SelectionContent VALID selection resolveUncached :: ( MonadError GQLError m, MonadReader ResolverContext m ) => TypeName -> SelectionContent VALID -> [ValidValue] -> ResolverMapT m (HashMap ValidValue ValidValue) resolveUncached :: forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => TypeName -> SelectionContent VALID -> [ValidValue] -> ResolverMapT m (HashMap ValidValue ValidValue) resolveUncached TypeName _ SelectionContent VALID _ [] = forall (f :: * -> *) a. Applicative f => a -> f a pure forall coll. Empty coll => coll empty resolveUncached TypeName typename SelectionContent VALID selection [ValidValue] xs = do ResolverMap m rmap <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks forall (m :: * -> *). ResolverMapContext m -> ResolverMap m resolverMap [ValidValue] vs <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (forall (m :: * -> *). MonadError GQLError m => NamedResolverRef -> ResolverMap m -> m [NamedResolverResult m] getNamedResolverBy (TypeName -> [ValidValue] -> NamedResolverRef NamedResolverRef TypeName typename [ValidValue] xs) ResolverMap m rmap) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse (forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => TypeName -> SelectionContent VALID -> NamedResolverResult m -> ResolverMapT m ValidValue processResult TypeName typename SelectionContent VALID selection) forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v HM.fromList (forall a b. [a] -> [b] -> [(a, b)] zip [ValidValue] xs [ValidValue] vs) getNamedResolverBy :: (MonadError GQLError m) => NamedResolverRef -> ResolverMap m -> m [NamedResolverResult m] getNamedResolverBy :: forall (m :: * -> *). MonadError GQLError m => NamedResolverRef -> ResolverMap m -> m [NamedResolverResult m] getNamedResolverBy NamedResolverRef {[ValidValue] TypeName resolverArgument :: NamedResolverRef -> [ValidValue] resolverTypeName :: NamedResolverRef -> TypeName resolverArgument :: [ValidValue] resolverTypeName :: TypeName ..} = forall k (c :: * -> *) d a. IsMap k c => d -> (a -> d) -> k -> c a -> d selectOr m [NamedResolverResult m] cantFoundError (([ValidValue] resolverArgument forall a b. a -> (a -> b) -> b &) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). NamedResolver m -> NamedResolverFun m resolverFun) TypeName resolverTypeName where cantFoundError :: m [NamedResolverResult m] cantFoundError = forall e (m :: * -> *) a. MonadError e m => e -> m a throwError (GQLError "Resolver Type " forall a. Semigroup a => a -> a -> a <> forall a. Msg a => a -> GQLError msg TypeName resolverTypeName forall a. Semigroup a => a -> a -> a <> GQLError "can't found") resolveObject :: ( MonadReader ResolverContext m, MonadError GQLError m ) => ResolverMapContext m -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m ValidValue resolveObject :: forall (m :: * -> *). (MonadReader ResolverContext m, MonadError GQLError m) => ResolverMapContext m -> ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m ValidValue resolveObject ResolverMapContext m rmap ObjectTypeResolver m drv Maybe (SelectionSet VALID) sel = do ResolverMapContext m newCache <- forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ObjectTypeResolver m -> Maybe (SelectionSet VALID) -> m [(SelectionContent VALID, NamedResolverRef)] objectRefs ObjectTypeResolver m drv Maybe (SelectionSet VALID) sel forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). (MonadError GQLError m, MonadReader ResolverContext m) => ResolverMapContext m -> [(SelectionContent VALID, NamedResolverRef)] -> m (ResolverMapContext m) buildCache ResolverMapContext m rmap forall (stage :: Stage). Object stage -> Value stage Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> 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 (ResolverMapContext m -> Selection VALID -> m (ObjectEntry VALID) resolver ResolverMapContext m newCache)) Maybe (SelectionSet VALID) sel where resolver :: ResolverMapContext m -> Selection VALID -> m (ObjectEntry VALID) resolver ResolverMapContext m cacheCTX Selection VALID currentSelection = do Maybe TypeName t <- forall (m :: * -> *). MonadReader ResolverContext m => FieldName -> m (Maybe TypeName) askFieldTypeName (forall (s :: Stage). Selection s -> FieldName selectionName Selection VALID currentSelection) forall (m :: * -> *) a. (MonadReader ResolverContext m, MonadError GQLError m) => Maybe TypeName -> m a -> m a updateCurrentType Maybe TypeName t forall a b. (a -> b) -> a -> b $ forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a local (\ResolverContext ctx -> ResolverContext ctx {Selection VALID currentSelection :: Selection VALID currentSelection :: Selection VALID currentSelection}) forall a b. (a -> b) -> a -> b $ forall (s :: Stage). FieldName -> Value s -> ObjectEntry s ObjectEntry (forall k a. KeyOf k a => a -> k keyOf Selection VALID currentSelection) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (m :: * -> *) a. ResolverMapT m a -> ResolverMapContext m -> m a runResMapT (forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => Selection VALID -> ObjectTypeResolver m -> ResolverMapT m ValidValue runFieldResolver Selection VALID currentSelection ObjectTypeResolver m drv) ResolverMapContext m cacheCTX runFieldResolver :: ( Monad m, MonadReader ResolverContext m, MonadError GQLError m ) => Selection VALID -> ObjectTypeResolver m -> ResolverMapT m ValidValue runFieldResolver :: forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => Selection VALID -> ObjectTypeResolver m -> ResolverMapT m ValidValue runFieldResolver Selection {FieldName selectionName :: FieldName selectionName :: forall (s :: Stage). Selection s -> FieldName selectionName, SelectionContent VALID selectionContent :: SelectionContent VALID selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s selectionContent} | FieldName selectionName forall a. Eq a => a -> a -> Bool == FieldName "__typename" = forall a b. a -> b -> a const (forall (stage :: Stage). ScalarValue -> Value stage Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> ScalarValue String 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 (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (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 b a. b -> (a -> b) -> Maybe a -> b maybe (forall (f :: * -> *) a. Applicative f => a -> f a pure forall (stage :: Stage). Value stage Null) (forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> (forall (m :: * -> *). (Monad m, MonadReader ResolverContext m, MonadError GQLError m) => ResolverValue m -> SelectionContent VALID -> ResolverMapT m ValidValue `resolveSelection` SelectionContent VALID selectionContent)) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v HM.lookup FieldName selectionName forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (m :: * -> *). ObjectTypeResolver m -> HashMap FieldName (m (ResolverValue m)) objectFields