{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE NoImplicitPrelude #-} module Data.Morpheus.App.Internal.Resolving.SchemaAPI ( schemaAPI, ) where import Data.Morpheus.App.Internal.Resolving.MonadResolver ( MonadResolver (..), ResolverContext (..), getArgument, ) import Data.Morpheus.App.Internal.Resolving.Types ( ObjectTypeResolver (..), ResolverValue, mkNull, mkObject, ) import Data.Morpheus.App.RenderIntrospection ( renderI, ) import Data.Morpheus.Internal.Utils ( IsMap (..), ) import Data.Morpheus.Types.Internal.AST ( DirectiveDefinition (..), QUERY, ScalarValue (..), Schema (..), VALID, Value (..), packName, typeDefinitions, ) import Relude hiding (empty) resolveSchema :: MonadResolver m => Schema VALID -> m (ResolverValue m) resolveSchema :: forall (m :: * -> *). MonadResolver m => Schema VALID -> m (ResolverValue m) resolveSchema schema :: Schema VALID schema@Schema {Maybe (TypeDefinition OBJECT VALID) DirectivesDefinition VALID TypeDefinitions VALID TypeDefinition OBJECT VALID types :: forall (s :: Stage). Schema s -> TypeDefinitions s query :: forall (s :: Stage). Schema s -> TypeDefinition OBJECT s mutation :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s) subscription :: forall (s :: Stage). Schema s -> Maybe (TypeDefinition OBJECT s) directiveDefinitions :: forall (s :: Stage). Schema s -> DirectivesDefinition s directiveDefinitions :: DirectivesDefinition VALID subscription :: Maybe (TypeDefinition OBJECT VALID) mutation :: Maybe (TypeDefinition OBJECT VALID) query :: TypeDefinition OBJECT VALID types :: TypeDefinitions VALID ..} = forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall (m :: * -> *). TypeName -> [ResolverEntry m] -> ResolverValue m mkObject TypeName "__Schema" [ (FieldName "types", forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> [a] toList forall a b. (a -> b) -> a -> b $ forall (s :: Stage). Schema s -> HashMap TypeName (TypeDefinition ANY s) typeDefinitions Schema VALID schema), (FieldName "queryType", forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI (forall a. a -> Maybe a Just TypeDefinition OBJECT VALID query)), (FieldName "mutationType", forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI Maybe (TypeDefinition OBJECT VALID) mutation), (FieldName "subscriptionType", forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI Maybe (TypeDefinition OBJECT VALID) subscription), (FieldName "directives", forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI forall a b. (a -> b) -> a -> b $ forall b a. Ord b => (a -> b) -> [a] -> [a] sortWith forall (s :: Stage). DirectiveDefinition s -> FieldName directiveDefinitionName forall a b. (a -> b) -> a -> b $ forall (t :: * -> *) a. Foldable t => t a -> [a] toList DirectivesDefinition VALID directiveDefinitions) ] resolveType :: (MonadResolver m) => Value VALID -> m (ResolverValue m) resolveType :: forall (m :: * -> *). MonadResolver m => Value VALID -> m (ResolverValue m) resolveType (Scalar (String Text typename)) = forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks (forall (s :: Stage). Schema s -> HashMap TypeName (TypeDefinition ANY s) typeDefinitions forall b c a. (b -> c) -> (a -> b) -> a -> c . ResolverContext -> Schema VALID schema) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall a (m :: * -> *). (RenderI a, MonadResolver m) => a -> IValue m renderI forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a lookup (forall a (t :: NAME). NamePacking a => a -> Name t packName Text typename) resolveType Value VALID _ = forall (f :: * -> *) a. Applicative f => a -> f a pure forall (m :: * -> *). ResolverValue m mkNull schemaAPI :: ( MonadOperation m ~ QUERY, MonadResolver m ) => ObjectTypeResolver m schemaAPI :: forall (m :: * -> *). (MonadOperation m ~ QUERY, MonadResolver m) => ObjectTypeResolver m schemaAPI = forall (m :: * -> *). HashMap FieldName (m (ResolverValue m)) -> ObjectTypeResolver m ObjectTypeResolver ( forall l. IsList l => [Item l] -> l fromList [ (FieldName "__type", forall (m :: * -> *). MonadResolver m => FieldName -> m (Value VALID) getArgument FieldName "name" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). MonadResolver m => Value VALID -> m (ResolverValue m) resolveType), (FieldName "__schema", forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a asks ResolverContext -> Schema VALID schema forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= forall (m :: * -> *). MonadResolver m => Schema VALID -> m (ResolverValue m) resolveSchema) ] )