{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Server.Deriving.Internal.Schema.Directive
( deriveFieldDirectives,
deriveTypeDirectives,
deriveEnumDirectives,
visitEnumValueDescription,
visitFieldDescription,
visitTypeDescription,
visitFieldDefaultValue,
visitFieldContent,
visitEnumName,
visitFieldName,
toFieldRes,
UseDeriving (..),
)
where
import Control.Monad.Except
import qualified Data.HashMap.Lazy as HM
import Data.Morpheus.Internal.Ext (resultOr, unsafeFromList)
import Data.Morpheus.Internal.Utils (Empty (..), fromElems)
import Data.Morpheus.Server.Deriving.Internal.Schema.Internal
( CatType,
deriveTypeAsArguments,
)
import Data.Morpheus.Server.Deriving.Utils.GRep (FieldRep (..))
import Data.Morpheus.Server.Deriving.Utils.Kinded
( CatType (..),
inputType,
)
import Data.Morpheus.Server.Deriving.Utils.Use
( UseDeriving (..),
UseGQLType (..),
UseValue (..),
)
import Data.Morpheus.Server.Types.Directives
( GDirectiveUsage (..),
GDirectiveUsages (..),
GQLDirective (..),
applyEnumDescription,
applyEnumName,
applyFieldDefaultValue,
applyFieldDescription,
applyFieldName,
applyTypeDescription,
applyTypeEnumNames,
applyTypeFieldNames,
getLocations,
)
import Data.Morpheus.Server.Types.SchemaT
( SchemaT,
insertDirectiveDefinition,
outToAny,
withInput,
)
import Data.Morpheus.Types.Internal.AST
( Argument (..),
Arguments,
CONST,
Description,
Directive (..),
DirectiveDefinition (..),
Directives,
FieldContent (..),
FieldName,
IN,
OUT,
ObjectEntry (..),
Position (Position),
TRUE,
TypeName,
Value (..),
internal,
)
import GHC.Generics ()
import GHC.TypeLits ()
import Relude hiding (empty)
deriveDirectiveDefinition ::
(gql a, GQLDirective a, args a) =>
UseDeriving gql args ->
a ->
b ->
SchemaT kind (DirectiveDefinition CONST)
deriveDirectiveDefinition :: forall (gql :: * -> Constraint) a (args :: * -> Constraint) b
(kind :: TypeCategory).
(gql a, GQLDirective a, args a) =>
UseDeriving gql args
-> a -> b -> SchemaT kind (DirectiveDefinition CONST)
deriveDirectiveDefinition UseDeriving gql args
options a
arg b
_ = do
ArgumentsDefinition CONST
directiveDefinitionArgs <- forall a (k' :: TypeCategory). SchemaT OUT a -> SchemaT k' a
outToAny (forall a. SchemaT IN a -> SchemaT OUT a
withInput forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> SchemaT IN (ArgumentsDefinition CONST)
deriveTypeAsArguments (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
options) Identity a
proxy)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( DirectiveDefinition
{ directiveDefinitionName :: FieldName
directiveDefinitionName = forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> FieldName
deriveDirectiveName (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
options) Identity a
proxy,
directiveDefinitionDescription :: Maybe Description
directiveDefinitionDescription = forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> Maybe Description -> Maybe Description
visitTypeDescription UseDeriving gql args
options Identity a
proxy forall a. Maybe a
Nothing,
ArgumentsDefinition CONST
directiveDefinitionArgs :: ArgumentsDefinition CONST
directiveDefinitionArgs :: ArgumentsDefinition CONST
directiveDefinitionArgs,
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionLocations = forall (f :: * -> *) a.
ToLocations (DIRECTIVE_LOCATIONS a) =>
f a -> [DirectiveLocation]
getLocations Identity a
proxy
}
)
where
proxy :: Identity a
proxy = forall a. a -> Identity a
Identity a
arg
deriveDirectiveUsages :: UseDeriving gql args -> [GDirectiveUsage gql args] -> SchemaT kind (Directives CONST)
deriveDirectiveUsages :: forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> [GDirectiveUsage gql args] -> SchemaT kind (Directives CONST)
deriveDirectiveUsages UseDeriving gql args
options = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> GDirectiveUsage gql args
-> SchemaT kind (FieldName, Directive CONST)
toDirectiveTuple UseDeriving gql args
options)
encodeDirectiveArguments :: val a => UseValue val -> a -> SchemaT OUT (Arguments CONST)
encodeDirectiveArguments :: forall (val :: * -> Constraint) a.
val a =>
UseValue val -> a -> SchemaT OUT (Arguments CONST)
encodeDirectiveArguments UseValue val
val a
x = forall err a' a.
(NonEmpty err -> a') -> (a -> a') -> Result err a -> a'
resultOr (forall a b. a -> b -> a
const forall a b. (a -> b) -> a -> b
$ forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall (val :: * -> Constraint).
UseValue val -> forall a. val a => a -> GQLResult (Value CONST)
useEncodeValue UseValue val
val a
x) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *} {valid :: Stage}.
MonadError GQLError f =>
Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue
where
err :: GQLError
err = GQLError -> GQLError
internal GQLError
"could not encode arguments. Arguments should be an object like type!"
unpackValue :: Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue (Object Object valid
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {valid :: Stage}. ObjectEntry valid -> Argument valid
toArgument Object valid
v
unpackValue Value valid
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError GQLError
err
toArgument :: ObjectEntry valid -> Argument valid
toArgument ObjectEntry {Value valid
FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryValue :: forall (s :: Stage). ObjectEntry s -> Value s
entryValue :: Value valid
entryName :: FieldName
..} = forall (valid :: Stage).
Position -> FieldName -> Value valid -> Argument valid
Argument (Int -> Int -> Position
Position Int
0 Int
0) FieldName
entryName Value valid
entryValue
toDirectiveTuple ::
UseDeriving gql args ->
GDirectiveUsage gql args ->
SchemaT kind (FieldName, Directive CONST)
toDirectiveTuple :: forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> GDirectiveUsage gql args
-> SchemaT kind (FieldName, Directive CONST)
toDirectiveTuple UseDeriving gql args
options (GDirectiveUsage a
x) = do
forall (gql :: * -> Constraint) (args :: * -> Constraint) a
(k :: TypeCategory).
gql a =>
UseDeriving gql args
-> (CatType IN a -> SchemaT k (DirectiveDefinition CONST))
-> a
-> SchemaT k ()
insertDirective UseDeriving gql args
options (forall (gql :: * -> Constraint) a (args :: * -> Constraint) b
(kind :: TypeCategory).
(gql a, GQLDirective a, args a) =>
UseDeriving gql args
-> a -> b -> SchemaT kind (DirectiveDefinition CONST)
deriveDirectiveDefinition UseDeriving gql args
options a
x) a
x
let directiveName :: FieldName
directiveName = forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> FieldName
deriveDirectiveName (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
dirGQL UseDeriving gql args
options) (forall a. a -> Identity a
Identity a
x)
[Argument CONST]
args <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (k' :: TypeCategory). SchemaT OUT a -> SchemaT k' a
outToAny (forall (val :: * -> Constraint) a.
val a =>
UseValue val -> a -> SchemaT OUT (Arguments CONST)
encodeDirectiveArguments (forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
dirArgs UseDeriving gql args
options) a
x)
Arguments CONST
directiveArgs <- forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems (forall a b. (a -> b) -> [a] -> [b]
map Argument CONST -> Argument CONST
editArg [Argument CONST]
args)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
( FieldName
directiveName,
Directive
{ directivePosition :: Position
directivePosition = Int -> Int -> Position
Position Int
0 Int
0,
FieldName
directiveName :: FieldName
directiveName :: FieldName
directiveName,
Arguments CONST
directiveArgs :: Arguments CONST
directiveArgs :: Arguments CONST
directiveArgs
}
)
where
editArg :: Argument CONST -> Argument CONST
editArg Argument {Value CONST
FieldName
Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue :: Value CONST
argumentName :: FieldName
argumentPosition :: Position
..} = Argument {argumentName :: FieldName
argumentName = forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
applyGQLFieldOptions UseDeriving gql args
options (forall a. a -> Identity a
Identity a
x) FieldName
argumentName, Value CONST
Position
argumentPosition :: Position
argumentValue :: Value CONST
argumentValue :: Value CONST
argumentPosition :: Position
..}
insertDirective ::
forall gql args a k.
gql a =>
UseDeriving gql args ->
(CatType IN a -> SchemaT k (DirectiveDefinition CONST)) ->
a ->
SchemaT k ()
insertDirective :: forall (gql :: * -> Constraint) (args :: * -> Constraint) a
(k :: TypeCategory).
gql a =>
UseDeriving gql args
-> (CatType IN a -> SchemaT k (DirectiveDefinition CONST))
-> a
-> SchemaT k ()
insertDirective UseDeriving gql args
ops CatType IN a -> SchemaT k (DirectiveDefinition CONST)
f a
_ = forall a (cat' :: TypeCategory).
TypeFingerprint
-> (a -> SchemaT cat' (DirectiveDefinition CONST))
-> a
-> SchemaT cat' ()
insertDirectiveDefinition (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 UseDeriving gql args
ops) CatType IN a
proxy) CatType IN a -> SchemaT k (DirectiveDefinition CONST)
f CatType IN a
proxy
where
proxy :: CatType IN a
proxy = forall {k} (a :: k). CatType IN a
InputType :: CatType IN a
getDirHM :: (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
getDirHM :: forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
getDirHM k
name HashMap k a
xs = forall a. a -> Maybe a -> a
fromMaybe forall coll. Empty coll => coll
empty forall a b. (a -> b) -> a -> b
$ k
name forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`HM.lookup` HashMap k a
xs
isIncluded :: GDirectiveUsage gql args -> Bool
isIncluded :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool
isIncluded (GDirectiveUsage a
x) = Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). GQLDirective a => f a -> Bool
excludeFromSchema (forall a. a -> Identity a
Identity a
x)
getEnumDirectiveUsages :: gql a => UseDeriving gql args -> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectiveUsages :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectiveUsages UseDeriving {UseValue args
UseGQLType gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__directives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
dirGQL :: UseGQLType gql
dirArgs :: UseValue args
__directives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
dirArgs :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
dirGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
..} f a
proxy TypeName
name = forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
getDirHM TypeName
name forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args
-> HashMap TypeName [GDirectiveUsage gql args]
enumValueDirectives forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__directives f a
proxy
getFieldDirectiveUsages :: gql a => UseDeriving gql args -> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages UseDeriving {UseValue args
UseGQLType gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
dirGQL :: UseGQLType gql
dirArgs :: UseValue args
__directives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__directives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
dirArgs :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseValue val
dirGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> UseGQLType gql
..} FieldName
name f a
proxy = forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
getDirHM FieldName
name forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args
-> HashMap FieldName [GDirectiveUsage gql args]
fieldDirectives forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__directives f a
proxy
deriveEnumDirectives :: gql a => UseDeriving gql args -> f a -> TypeName -> SchemaT k (Directives CONST)
deriveEnumDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) (k :: TypeCategory).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> SchemaT k (Directives CONST)
deriveEnumDirectives UseDeriving gql args
options f a
proxy TypeName
name = forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> [GDirectiveUsage gql args] -> SchemaT kind (Directives CONST)
deriveDirectiveUsages UseDeriving gql args
options forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool
isIncluded forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectiveUsages UseDeriving gql args
options f a
proxy TypeName
name
deriveFieldDirectives :: gql a => UseDeriving gql args -> f a -> FieldName -> SchemaT kind (Directives CONST)
deriveFieldDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) (kind :: TypeCategory).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> SchemaT kind (Directives CONST)
deriveFieldDirectives UseDeriving gql args
options f a
proxy FieldName
name = forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> [GDirectiveUsage gql args] -> SchemaT kind (Directives CONST)
deriveDirectiveUsages UseDeriving gql args
options forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool
isIncluded forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages UseDeriving gql args
options FieldName
name f a
proxy
deriveTypeDirectives :: gql a => UseDeriving gql args -> f a -> SchemaT kind (Directives CONST)
deriveTypeDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) (kind :: TypeCategory).
gql a =>
UseDeriving gql args -> f a -> SchemaT kind (Directives CONST)
deriveTypeDirectives UseDeriving gql args
options f a
proxy = forall (gql :: * -> Constraint) (args :: * -> Constraint)
(kind :: TypeCategory).
UseDeriving gql args
-> [GDirectiveUsage gql args] -> SchemaT kind (Directives CONST)
deriveDirectiveUsages UseDeriving gql args
options forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool
isIncluded forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__directives UseDeriving gql args
options f a
proxy
visitEnumValueDescription :: gql a => UseDeriving gql args -> f a -> TypeName -> Maybe Description -> Maybe Description
visitEnumValueDescription :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> Maybe Description -> Maybe Description
visitEnumValueDescription UseDeriving gql args
options f a
proxy TypeName
name Maybe Description
desc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyEnumDescription Maybe Description
desc (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectiveUsages UseDeriving gql args
options f a
proxy TypeName
name)
visitEnumName :: gql a => UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> TypeName -> TypeName
visitEnumName UseDeriving gql args
options f a
proxy TypeName
name = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> TypeName -> TypeName
applyEnumName (TypeName -> TypeName
withTypeDirectives TypeName
name) (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectiveUsages UseDeriving gql args
options f a
proxy TypeName
name)
where
withTypeDirectives :: TypeName -> TypeName
withTypeDirectives TypeName
dirName = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> TypeName -> TypeName
applyTypeEnumNames TypeName
dirName (forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__directives UseDeriving gql args
options f a
proxy)
visitFieldDescription :: gql a => UseDeriving gql args -> f a -> FieldName -> Maybe Description -> Maybe Description
visitFieldDescription :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> Maybe Description -> Maybe Description
visitFieldDescription UseDeriving gql args
options f a
proxy FieldName
name Maybe Description
desc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyFieldDescription Maybe Description
desc (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages UseDeriving gql args
options FieldName
name f a
proxy)
visitFieldDefaultValue :: gql a => UseDeriving gql args -> f a -> FieldName -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue UseDeriving gql args
options f a
proxy FieldName
name Maybe (Value CONST)
desc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args
-> Maybe (Value CONST) -> Maybe (Value CONST)
applyFieldDefaultValue Maybe (Value CONST)
desc (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages UseDeriving gql args
options FieldName
name f a
proxy)
visitFieldContent ::
gql a =>
UseDeriving gql args ->
CatType kind a ->
FieldName ->
Maybe (FieldContent TRUE kind CONST) ->
Maybe (FieldContent TRUE kind CONST)
visitFieldContent :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(kind :: TypeCategory).
gql a =>
UseDeriving gql args
-> CatType kind a
-> FieldName
-> Maybe (FieldContent TRUE kind CONST)
-> Maybe (FieldContent TRUE kind CONST)
visitFieldContent UseDeriving gql args
options proxy :: CatType kind a
proxy@CatType kind a
InputType FieldName
name Maybe (FieldContent TRUE kind CONST)
x =
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> Maybe (Value CONST) -> Maybe (Value CONST)
visitFieldDefaultValue UseDeriving gql args
options CatType kind a
proxy FieldName
name (forall (s :: Stage) (cat :: TypeCategory).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldContent TRUE kind CONST)
x)
visitFieldContent UseDeriving gql args
_ CatType kind a
OutputType FieldName
_ Maybe (FieldContent TRUE kind CONST)
x = Maybe (FieldContent TRUE kind CONST)
x
applyGQLFieldOptions :: gql a => UseDeriving gql args -> f a -> FieldName -> FieldName
applyGQLFieldOptions :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
applyGQLFieldOptions UseDeriving gql args
options f a
proxy = FieldName -> FieldName
withTypeDirectives
where
withTypeDirectives :: FieldName -> FieldName
withTypeDirectives FieldName
name = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> FieldName -> FieldName
applyTypeFieldNames FieldName
name (forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__directives UseDeriving gql args
options f a
proxy)
visitFieldName :: gql a => UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName UseDeriving gql args
options f a
proxy FieldName
name = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> FieldName -> FieldName
applyFieldName (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
applyGQLFieldOptions UseDeriving gql args
options f a
proxy FieldName
name) (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> FieldName -> f a -> [GDirectiveUsage gql args]
getFieldDirectiveUsages UseDeriving gql args
options FieldName
name f a
proxy)
visitTypeDescription :: gql a => UseDeriving gql args -> f a -> Maybe Description -> Maybe Description
visitTypeDescription :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> Maybe Description -> Maybe Description
visitTypeDescription UseDeriving gql args
options f a
proxy Maybe Description
desc = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyTypeDescription Maybe Description
desc (forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives forall a b. (a -> b) -> a -> b
$ forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__directives UseDeriving gql args
options f a
proxy)
toFieldRes :: gql a => UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> FieldRep v -> (FieldName, v)
toFieldRes UseDeriving gql args
options f a
proxy FieldRep {v
TypeRef
FieldName
fieldValue :: forall a. FieldRep a -> a
fieldTypeRef :: forall a. FieldRep a -> TypeRef
fieldSelector :: forall a. FieldRep a -> FieldName
fieldValue :: v
fieldTypeRef :: TypeRef
fieldSelector :: FieldName
..} = (forall (gql :: * -> Constraint) a (args :: * -> Constraint)
(f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName UseDeriving gql args
options f a
proxy FieldName
fieldSelector, v
fieldValue)
deriveDirectiveName :: gql a => UseGQLType gql -> f a -> FieldName
deriveDirectiveName :: forall (gql :: * -> Constraint) a (f :: * -> *).
gql a =>
UseGQLType gql -> f a -> FieldName
deriveDirectiveName UseGQLType gql
options = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (gql :: * -> Constraint).
UseGQLType gql
-> forall (c :: TypeCategory) a. gql a => CatType c a -> TypeName
useTypename UseGQLType gql
options forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType