{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Deriving.Internal.Directive
  ( getFieldDirectives,
    getTypeDirectives,
    getEnumDirectives,
    visitEnumValueDescription,
    visitFieldDescription,
    visitTypeDescription,
    visitFieldDefaultValue,
    visitFieldContent,
    visitEnumName,
    visitFieldName,
    toFieldRes,
    UseDeriving (..),
    deriveDirectiveDefinition,
    serializeDirectives,
  )
where

import Control.Monad.Except
import Data.Morpheus.Generic
  ( GRepField (..),
  )
import Data.Morpheus.Internal.Ext (GQLResult, unsafeFromList)
import Data.Morpheus.Internal.Utils (Empty (..), fromElems, lookup)
import Data.Morpheus.Server.Deriving.Utils.Kinded
  ( CatType (..),
    inputType,
  )
import Data.Morpheus.Server.Deriving.Utils.Types
  ( coerceArguments,
    typeToArguments,
  )
import Data.Morpheus.Server.Deriving.Utils.Use
  ( UseDeriving (..),
    UseGQLType (..),
    UseGQLValue (..),
  )
import Data.Morpheus.Server.Types.Directives
  ( GDirectiveUsage (..),
    GDirectiveUsages (..),
    GQLDirective (..),
    applyEnumDescription,
    applyEnumName,
    applyFieldDefaultValue,
    applyFieldDescription,
    applyFieldName,
    applyTypeDescription,
    applyTypeEnumNames,
    applyTypeFieldNames,
    getLocations,
  )
import Data.Morpheus.Types.Internal.AST
  ( Argument (..),
    CONST,
    Description,
    Directive (..),
    DirectiveDefinition (..),
    Directives,
    FieldContent (..),
    FieldName,
    GQLError,
    IN,
    Position (..),
    TRUE,
    TypeDefinition,
    TypeName,
    Value (..),
  )
import GHC.Generics ()
import GHC.TypeLits ()
import Relude hiding (empty)

-- DERIVE
deriveDirectiveDefinition :: (MonadError GQLError m, gql a, GQLDirective a, val a) => UseDeriving gql val -> f a -> TypeDefinition IN CONST -> m (DirectiveDefinition CONST)
deriveDirectiveDefinition :: forall (m :: * -> *) (gql :: * -> Constraint) a
       (val :: * -> Constraint) (f :: * -> *).
(MonadError GQLError m, gql a, GQLDirective a, val a) =>
UseDeriving gql val
-> f a -> TypeDefinition IN CONST -> m (DirectiveDefinition CONST)
deriveDirectiveDefinition UseDeriving gql val
ctx f a
proxy TypeDefinition IN CONST
t = do
  ArgumentsDefinition CONST
directiveDefinitionArgs <- TypeDefinition IN CONST -> m (ArgumentsDefinition CONST)
forall (m :: * -> *).
DerivingMonad m =>
TypeDefinition IN CONST -> m (ArgumentsDefinition CONST)
typeToArguments TypeDefinition IN CONST
t
  DirectiveDefinition CONST -> m (DirectiveDefinition CONST)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( DirectiveDefinition
        { directiveDefinitionName :: FieldName
directiveDefinitionName = UseDeriving gql val -> f a -> FieldName
forall ctx (gql :: * -> Constraint) a (f :: * -> *).
(UseGQLType ctx gql, gql a) =>
ctx -> f a -> FieldName
deriveDirectiveName UseDeriving gql val
ctx f a
proxy,
          directiveDefinitionDescription :: Maybe Description
directiveDefinitionDescription = UseDeriving gql val
-> f a -> Maybe Description -> Maybe Description
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> Maybe Description -> Maybe Description
visitTypeDescription UseDeriving gql val
ctx f a
proxy Maybe Description
forall a. Maybe a
Nothing,
          ArgumentsDefinition CONST
directiveDefinitionArgs :: ArgumentsDefinition CONST
directiveDefinitionArgs :: ArgumentsDefinition CONST
directiveDefinitionArgs,
          directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionLocations = f a -> [DirectiveLocation]
forall (f :: * -> *) a.
ToLocations (DIRECTIVE_LOCATIONS a) =>
f a -> [DirectiveLocation]
getLocations f a
proxy
        }
    )

serializeDirectives :: UseDeriving gql args -> [GDirectiveUsage gql args] -> GQLResult (Directives CONST)
serializeDirectives :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDeriving gql args
-> [GDirectiveUsage gql args] -> GQLResult (Directives CONST)
serializeDirectives UseDeriving gql args
options = ([(FieldName, Directive CONST)] -> Directives CONST)
-> Result GQLError [(FieldName, Directive CONST)]
-> GQLResult (Directives CONST)
forall a b. (a -> b) -> Result GQLError a -> Result GQLError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(FieldName, Directive CONST)] -> Directives CONST
forall a. [(FieldName, a)] -> OrdMap FieldName a
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList (Result GQLError [(FieldName, Directive CONST)]
 -> GQLResult (Directives CONST))
-> ([GDirectiveUsage gql args]
    -> Result GQLError [(FieldName, Directive CONST)])
-> [GDirectiveUsage gql args]
-> GQLResult (Directives CONST)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GDirectiveUsage gql args
 -> Result GQLError (FieldName, Directive CONST))
-> [GDirectiveUsage gql args]
-> Result GQLError [(FieldName, Directive CONST)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (UseDeriving gql args
-> GDirectiveUsage gql args
-> Result GQLError (FieldName, Directive CONST)
forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDeriving gql args
-> GDirectiveUsage gql args
-> Result GQLError (FieldName, Directive CONST)
serializeDirective UseDeriving gql args
options) ([GDirectiveUsage gql args]
 -> Result GQLError [(FieldName, Directive CONST)])
-> ([GDirectiveUsage gql args] -> [GDirectiveUsage gql args])
-> [GDirectiveUsage gql args]
-> Result GQLError [(FieldName, Directive CONST)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GDirectiveUsage gql args -> Bool)
-> [GDirectiveUsage gql args] -> [GDirectiveUsage gql args]
forall a. (a -> Bool) -> [a] -> [a]
filter GDirectiveUsage gql args -> Bool
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Bool
isIncluded

-- others
serializeDirective ::
  UseDeriving gql args ->
  GDirectiveUsage gql args ->
  GQLResult (FieldName, Directive CONST)
serializeDirective :: forall (gql :: * -> Constraint) (args :: * -> Constraint).
UseDeriving gql args
-> GDirectiveUsage gql args
-> Result GQLError (FieldName, Directive CONST)
serializeDirective UseDeriving gql args
ctx (GDirectiveUsage a
x) = do
  Arguments CONST
args <- UseDeriving gql args -> a -> GQLResult (Value CONST)
forall a.
args a =>
UseDeriving gql args -> a -> GQLResult (Value CONST)
forall ctx (con :: * -> Constraint) a.
(UseGQLValue ctx con, con a) =>
ctx -> a -> GQLResult (Value CONST)
useEncodeValue UseDeriving gql args
ctx a
x GQLResult (Value CONST)
-> (Value CONST -> Result GQLError (Arguments CONST))
-> Result GQLError (Arguments CONST)
forall a b.
Result GQLError a -> (a -> Result GQLError b) -> Result GQLError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value CONST -> Result GQLError (Arguments CONST)
forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
Value s -> m (Arguments s)
coerceArguments
  Arguments CONST
directiveArgs <- [Argument CONST] -> Result GQLError (Arguments CONST)
forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems ((Argument CONST -> Argument CONST)
-> [Argument CONST] -> [Argument CONST]
forall a b. (a -> b) -> [a] -> [b]
map (UseDeriving gql args -> a -> Argument CONST -> Argument CONST
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (valid :: Stage).
gql a =>
UseDeriving gql args -> a -> Argument valid -> Argument valid
visitArgument UseDeriving gql args
ctx a
x) (Arguments CONST -> [Argument CONST]
forall a. OrdMap FieldName a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Arguments CONST
args))
  (FieldName, Directive CONST)
-> Result GQLError (FieldName, Directive CONST)
forall a. a -> Result GQLError a
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
    directiveName :: FieldName
directiveName = UseDeriving gql args -> Identity a -> FieldName
forall ctx (gql :: * -> Constraint) a (f :: * -> *).
(UseGQLType ctx gql, gql a) =>
ctx -> f a -> FieldName
deriveDirectiveName UseDeriving gql args
ctx (a -> Identity a
forall a. a -> Identity a
Identity a
x)

-- GET
getEnumDirectives :: (gql a) => UseDeriving gql args -> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectives UseDeriving {GQLValueCTX args
GQLTypeCTX gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
useDirectives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__useValue :: GQLValueCTX args
__useGQL :: GQLTypeCTX gql
useDirectives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__useValue :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> GQLValueCTX val
__useGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> GQLTypeCTX gql
..} f a
proxy TypeName
name = TypeName
-> HashMap TypeName [GDirectiveUsage gql args]
-> [GDirectiveUsage gql args]
forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
lookupDirective TypeName
name (HashMap TypeName [GDirectiveUsage gql args]
 -> [GDirectiveUsage gql args])
-> HashMap TypeName [GDirectiveUsage gql args]
-> [GDirectiveUsage gql args]
forall a b. (a -> b) -> a -> b
$ GDirectiveUsages gql args
-> HashMap TypeName [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args
-> HashMap TypeName [GDirectiveUsage gql args]
enumValueDirectives (GDirectiveUsages gql args
 -> HashMap TypeName [GDirectiveUsage gql args])
-> GDirectiveUsages gql args
-> HashMap TypeName [GDirectiveUsage gql args]
forall a b. (a -> b) -> a -> b
$ f a -> GDirectiveUsages gql args
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
useDirectives f a
proxy

getFieldDirectives :: (gql a) => UseDeriving gql args -> f a -> FieldName -> [GDirectiveUsage gql args]
getFieldDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
getFieldDirectives UseDeriving {GQLValueCTX args
GQLTypeCTX gql
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
useDirectives :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
__useValue :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> GQLValueCTX val
__useGQL :: forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val -> GQLTypeCTX gql
useDirectives :: forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
__useValue :: GQLValueCTX args
__useGQL :: GQLTypeCTX gql
..} f a
proxy FieldName
name = FieldName
-> HashMap FieldName [GDirectiveUsage gql args]
-> [GDirectiveUsage gql args]
forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
lookupDirective FieldName
name (HashMap FieldName [GDirectiveUsage gql args]
 -> [GDirectiveUsage gql args])
-> HashMap FieldName [GDirectiveUsage gql args]
-> [GDirectiveUsage gql args]
forall a b. (a -> b) -> a -> b
$ GDirectiveUsages gql args
-> HashMap FieldName [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args
-> HashMap FieldName [GDirectiveUsage gql args]
fieldDirectives (GDirectiveUsages gql args
 -> HashMap FieldName [GDirectiveUsage gql args])
-> GDirectiveUsages gql args
-> HashMap FieldName [GDirectiveUsage gql args]
forall a b. (a -> b) -> a -> b
$ f a -> GDirectiveUsages gql args
forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql args
useDirectives f a
proxy

getTypeDirectives :: (gql a) => UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
getTypeDirectives :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
getTypeDirectives UseDeriving gql args
ctx = GDirectiveUsages gql args -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsages gql args -> [GDirectiveUsage gql args]
typeDirectives (GDirectiveUsages gql args -> [GDirectiveUsage gql args])
-> (f a -> GDirectiveUsages gql args)
-> f a
-> [GDirectiveUsage gql args]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UseDeriving gql args
-> forall (f :: * -> *) a.
   gql a =>
   f a -> GDirectiveUsages gql args
forall (gql :: * -> Constraint) (val :: * -> Constraint).
UseDeriving gql val
-> forall (f :: * -> *) a. gql a => f a -> GDirectiveUsages gql val
useDirectives UseDeriving gql args
ctx

lookupDirective :: (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
lookupDirective :: forall k a. (Ord k, Hashable k, Empty a) => k -> HashMap k a -> a
lookupDirective k
name HashMap k a
xs = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall coll. Empty coll => coll
empty (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ k
name k -> HashMap k a -> Maybe a
forall a. k -> HashMap k a -> Maybe a
forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
`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 (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Identity a -> Bool
forall a (f :: * -> *). GQLDirective a => f a -> Bool
forall (f :: * -> *). f a -> Bool
excludeFromSchema (a -> Identity a
forall a. a -> Identity a
Identity a
x)

-- VISIT

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 = (GDirectiveUsage gql args
 -> Maybe Description -> Maybe Description)
-> Maybe Description
-> [GDirectiveUsage gql args]
-> Maybe Description
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> Maybe Description -> Maybe Description
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyEnumDescription Maybe Description
desc (UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectives 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 = (GDirectiveUsage gql args -> TypeName -> TypeName)
-> TypeName -> [GDirectiveUsage gql args] -> TypeName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> TypeName -> TypeName
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> TypeName -> TypeName
applyEnumName (TypeName -> TypeName
withTypeDirectives TypeName
name) (UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> TypeName -> [GDirectiveUsage gql args]
getEnumDirectives UseDeriving gql args
options f a
proxy TypeName
name)
  where
    withTypeDirectives :: TypeName -> TypeName
withTypeDirectives TypeName
dirName = (GDirectiveUsage gql args -> TypeName -> TypeName)
-> TypeName -> [GDirectiveUsage gql args] -> TypeName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> TypeName -> TypeName
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> TypeName -> TypeName
applyTypeEnumNames TypeName
dirName (UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
getTypeDirectives 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 = (GDirectiveUsage gql args
 -> Maybe Description -> Maybe Description)
-> Maybe Description
-> [GDirectiveUsage gql args]
-> Maybe Description
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> Maybe Description -> Maybe Description
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyFieldDescription Maybe Description
desc (UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
getFieldDirectives UseDeriving gql args
options f a
proxy FieldName
name)

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 = (GDirectiveUsage gql args
 -> Maybe (Value CONST) -> Maybe (Value CONST))
-> Maybe (Value CONST)
-> [GDirectiveUsage gql args]
-> Maybe (Value CONST)
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args
-> Maybe (Value CONST) -> Maybe (Value CONST)
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args
-> Maybe (Value CONST) -> Maybe (Value CONST)
applyFieldDefaultValue Maybe (Value CONST)
desc (UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
getFieldDirectives UseDeriving gql args
options f a
proxy FieldName
name)

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 =
  Value CONST -> FieldContent TRUE kind CONST
Value CONST -> FieldContent (IN <=? kind) kind CONST
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue
    (Value CONST -> FieldContent TRUE kind CONST)
-> Maybe (Value CONST) -> Maybe (FieldContent TRUE kind CONST)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> UseDeriving gql args
-> CatType kind a
-> FieldName
-> Maybe (Value CONST)
-> Maybe (Value CONST)
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 (FieldContent TRUE kind CONST -> Value CONST
FieldContent (IN <=? IN) IN CONST -> Value CONST
forall (s :: Stage) (cat :: TypeCategory).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue (FieldContent TRUE kind CONST -> Value CONST)
-> Maybe (FieldContent TRUE kind CONST) -> Maybe (Value CONST)
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

visitArgument :: (gql a) => UseDeriving gql args -> a -> Argument valid -> Argument valid
visitArgument :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (valid :: Stage).
gql a =>
UseDeriving gql args -> a -> Argument valid -> Argument valid
visitArgument UseDeriving gql args
ctx a
x Argument {Position
FieldName
Value valid
argumentPosition :: Position
argumentName :: FieldName
argumentValue :: Value valid
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentName :: forall (valid :: Stage). Argument valid -> FieldName
argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
..} = Argument {argumentName :: FieldName
argumentName = UseDeriving gql args -> Identity a -> FieldName -> FieldName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitFieldName UseDeriving gql args
ctx (a -> Identity a
forall a. a -> Identity a
Identity a
x) FieldName
argumentName, Position
Value valid
argumentPosition :: Position
argumentValue :: Value valid
argumentPosition :: Position
argumentValue :: Value valid
..}

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 = (GDirectiveUsage gql args -> FieldName -> FieldName)
-> FieldName -> [GDirectiveUsage gql args] -> FieldName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> FieldName -> FieldName
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> FieldName -> FieldName
applyFieldName (UseDeriving gql args -> f a -> FieldName -> FieldName
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitTypeFieldNames UseDeriving gql args
options f a
proxy FieldName
name) (UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args
-> f a -> FieldName -> [GDirectiveUsage gql args]
getFieldDirectives UseDeriving gql args
options f a
proxy FieldName
name)

visitTypeFieldNames :: (gql a) => UseDeriving gql args -> f a -> FieldName -> FieldName
visitTypeFieldNames :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> FieldName -> FieldName
visitTypeFieldNames UseDeriving gql args
ctx f a
proxy FieldName
name = (GDirectiveUsage gql args -> FieldName -> FieldName)
-> FieldName -> [GDirectiveUsage gql args] -> FieldName
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> FieldName -> FieldName
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> FieldName -> FieldName
applyTypeFieldNames FieldName
name (UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
getTypeDirectives UseDeriving gql args
ctx 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 = (GDirectiveUsage gql args
 -> Maybe Description -> Maybe Description)
-> Maybe Description
-> [GDirectiveUsage gql args]
-> Maybe Description
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr GDirectiveUsage gql args -> Maybe Description -> Maybe Description
forall (gql :: * -> Constraint) (args :: * -> Constraint).
GDirectiveUsage gql args -> Maybe Description -> Maybe Description
applyTypeDescription Maybe Description
desc (UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *).
gql a =>
UseDeriving gql args -> f a -> [GDirectiveUsage gql args]
getTypeDirectives UseDeriving gql args
options f a
proxy)

toFieldRes :: (gql a) => UseDeriving gql args -> f a -> GRepField v -> (FieldName, v)
toFieldRes :: forall (gql :: * -> Constraint) a (args :: * -> Constraint)
       (f :: * -> *) v.
gql a =>
UseDeriving gql args -> f a -> GRepField v -> (FieldName, v)
toFieldRes UseDeriving gql args
options f a
proxy GRepField {v
FieldName
TypeRef
fieldSelector :: FieldName
fieldTypeRef :: TypeRef
fieldValue :: v
fieldSelector :: forall a. GRepField a -> FieldName
fieldTypeRef :: forall a. GRepField a -> TypeRef
fieldValue :: forall a. GRepField a -> a
..} = (UseDeriving gql args -> f a -> FieldName -> 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 :: (UseGQLType ctx gql, gql a) => ctx -> f a -> FieldName
deriveDirectiveName :: forall ctx (gql :: * -> Constraint) a (f :: * -> *).
(UseGQLType ctx gql, gql a) =>
ctx -> f a -> FieldName
deriveDirectiveName ctx
options = TypeName -> FieldName
forall a b. Coercible a b => a -> b
coerce (TypeName -> FieldName) -> (f a -> TypeName) -> f a -> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx -> CatType IN a -> TypeName
forall a (c :: TypeCategory).
gql a =>
ctx -> CatType c a -> TypeName
forall ctx (con :: * -> Constraint) a (c :: TypeCategory).
(UseGQLType ctx con, con a) =>
ctx -> CatType c a -> TypeName
useTypename ctx
options (CatType IN a -> TypeName)
-> (f a -> CatType IN a) -> f a -> TypeName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> CatType IN a
forall {k} (f :: k -> *) (a :: k). f a -> CatType IN a
inputType