{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Client.CodeGen.Interpreting.Local
  ( toLocalDefinitions,
  )
where

import Data.Morpheus.Client.CodeGen.AST
  ( ClientDeclaration (..),
    ClientPreDeclaration (..),
    RequestTypeDefinition (..),
    UnionPat (..),
  )
import Data.Morpheus.Client.CodeGen.Interpreting.Arguments (genArguments)
import Data.Morpheus.Client.CodeGen.Interpreting.Core
  ( LocalContext (..),
    LocalM (..),
    clientConfig,
    defaultDerivations,
    deprecationWarning,
    existFragment,
    getNameByPath,
    getType,
    gqlWarning,
    lookupField,
    registerFragment,
    removeDuplicates,
    runLocalM,
    typeFrom,
  )
import Data.Morpheus.Client.CodeGen.Interpreting.PreDeclarations
  ( mapPreDeclarations,
  )
import Data.Morpheus.CodeGen.Internal.AST (CodeGenConstructor (..), CodeGenField (..), CodeGenType (..), CodeGenTypeName (..), FIELD_TYPE_WRAPPER (..), fromTypeName, getFullName)
import Data.Morpheus.Core (validateRequest)
import Data.Morpheus.Internal.Ext
  ( GQLResult,
  )
import Data.Morpheus.Internal.Utils
  ( keyOf,
    member,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    ExecutableDocument (..),
    FieldDefinition (..),
    FieldName,
    FragmentName,
    Operation (..),
    Position (..),
    PropName (..),
    Ref (..),
    Schema (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeDefinition (..),
    TypeName,
    TypeRef (..),
    UnionTag (..),
    VALID,
    at,
    getOperationDataType,
    getOperationName,
    isNullable,
    msg,
    toAny,
    unpackName,
    withPath,
  )
import qualified Data.Set as S
import qualified Data.Text as T
import Relude hiding (empty, show)

toLocalDefinitions :: (Text, ExecutableDocument) -> Schema VALID -> GQLResult [ClientDeclaration]
toLocalDefinitions :: (Text, ExecutableDocument)
-> Schema VALID -> GQLResult [ClientDeclaration]
toLocalDefinitions (Text
query, ExecutableDocument
request) Schema VALID
ctxSchema = do
  Operation VALID
validOperation <- Config
-> Schema VALID
-> ExecutableDocument
-> GQLResult (Operation VALID)
validateRequest Config
clientConfig Schema VALID
ctxSchema ExecutableDocument
request
  let context :: LocalContext
context =
        LocalContext
          { Schema VALID
ctxSchema :: Schema VALID
ctxSchema :: Schema VALID
ctxSchema,
            ctxVariables :: VariableDefinitions RAW
ctxVariables = forall (s :: Stage). Operation s -> VariableDefinitions s
operationArguments forall a b. (a -> b) -> a -> b
$ ExecutableDocument -> Operation RAW
operation ExecutableDocument
request,
            ctxPosition :: Maybe Position
ctxPosition = forall a. Maybe a
Nothing,
            ctxFragments :: Set FragmentName
ctxFragments = forall a. Monoid a => a
mempty
          }
  [ClientPreDeclaration]
x <- forall a. LocalContext -> LocalM a -> GQLResult a
runLocalM LocalContext
context forall a b. (a -> b) -> a -> b
$ Text -> Operation VALID -> LocalM [ClientPreDeclaration]
genLocalDeclarations Text
query Operation VALID
validOperation
  [ClientDeclaration] -> [ClientDeclaration]
removeDuplicates 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 :: * -> *).
MonadFail m =>
ClientPreDeclaration -> m ClientDeclaration
mapPreDeclarations [ClientPreDeclaration]
x

genLocalDeclarations :: Text -> Operation VALID -> LocalM [ClientPreDeclaration]
genLocalDeclarations :: Text -> Operation VALID -> LocalM [ClientPreDeclaration]
genLocalDeclarations Text
query op :: Operation VALID
op@Operation {Maybe FieldName
operationName :: forall (s :: Stage). Operation s -> Maybe FieldName
operationName :: Maybe FieldName
operationName, SelectionSet VALID
operationSelection :: forall (s :: Stage). Operation s -> SelectionSet s
operationSelection :: SelectionSet VALID
operationSelection, OperationType
operationType :: forall (s :: Stage). Operation s -> OperationType
operationType :: OperationType
operationType} = do
  LocalContext {Schema VALID
ctxSchema :: Schema VALID
ctxSchema :: LocalContext -> Schema VALID
ctxSchema, VariableDefinitions RAW
ctxVariables :: VariableDefinitions RAW
ctxVariables :: LocalContext -> VariableDefinitions RAW
ctxVariables} <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a. a -> a
id
  TypeDefinition OBJECT VALID
datatype <- forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID)
getOperationDataType Operation VALID
op Schema VALID
ctxSchema
  let operationTypeName :: TypeName
operationTypeName = Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName
  let (TypeName
requestArgs, [ClientPreDeclaration]
argTypes) = TypeName
-> VariableDefinitions RAW -> (TypeName, [ClientPreDeclaration])
genArguments TypeName
operationTypeName VariableDefinitions RAW
ctxVariables
  (CodeGenTypeName
rootTypeName, [ClientPreDeclaration]
localTypes) <- [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genLocalTypes [coerce :: forall a b. Coercible a b => a -> b
coerce TypeName
operationTypeName] TypeName
operationTypeName (forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny TypeDefinition OBJECT VALID
datatype) SelectionSet VALID
operationSelection
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( RequestTypeDefinition -> ClientPreDeclaration
RequestTypeClass
        RequestTypeDefinition
          { requestArgs :: TypeName
requestArgs = TypeName
requestArgs,
            requestName :: TypeName
requestName = CodeGenTypeName -> TypeName
typename CodeGenTypeName
rootTypeName,
            requestType :: OperationType
requestType = OperationType
operationType,
            requestQuery :: String
requestQuery = Text -> String
T.unpack Text
query
          }
        forall a. a -> [a] -> [a]
: [ClientPreDeclaration]
localTypes forall a. Semigroup a => a -> a -> a
<> [ClientPreDeclaration]
argTypes
    )

genLocalTypes ::
  [FieldName] ->
  TypeName ->
  TypeDefinition ANY VALID ->
  SelectionSet VALID ->
  LocalM (CodeGenTypeName, [ClientPreDeclaration])
genLocalTypes :: [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genLocalTypes [FieldName]
namespace TypeName
tName = [FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectTypeWithFragment [FieldName]
namespace ([FieldName] -> TypeName -> CodeGenTypeName
getNameByPath [FieldName]
namespace TypeName
tName)

subTypesBySelection ::
  TypeName ->
  [FieldName] ->
  TypeDefinition ANY VALID ->
  Selection VALID ->
  LocalM (CodeGenTypeName, [ClientPreDeclaration])
subTypesBySelection :: TypeName
-> [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
subTypesBySelection TypeName
name [FieldName]
_ TypeDefinition ANY VALID
_ Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = SelectionContent VALID
SelectionField} = forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeName -> CodeGenTypeName
fromTypeName TypeName
name, [])
subTypesBySelection TypeName
_ [FieldName]
path TypeDefinition ANY VALID
dType Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = SelectionSet SelectionSet VALID
selectionSet} =
  [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genLocalTypes [FieldName]
path (CodeGenTypeName -> TypeName
getFullName forall a b. (a -> b) -> a -> b
$ forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> CodeGenTypeName
typeFrom [] TypeDefinition ANY VALID
dType) TypeDefinition ANY VALID
dType SelectionSet VALID
selectionSet
subTypesBySelection TypeName
_ [FieldName]
namespace TypeDefinition ANY VALID
dType Selection {Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition, selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = UnionSelection Maybe (SelectionSet VALID)
interface UnionSelection VALID
unionSelections} =
  do
    let variants :: [UnionTag]
variants = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList UnionSelection VALID
unionSelections
    forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Position
-> [FieldName]
-> Maybe (SelectionSet VALID)
-> UnionTag
-> LocalM ()
checkTypename Position
selectionPosition [FieldName]
namespace Maybe (SelectionSet VALID)
interface) [UnionTag]
variants
    let cgTypeName :: CodeGenTypeName
cgTypeName = forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> CodeGenTypeName
typeFrom [FieldName]
namespace TypeDefinition ANY VALID
dType
    ([Variant]
cons, [[ClientPreDeclaration]]
subTypes) <- forall a b. [(a, b)] -> ([a], [b])
unzip 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 ([FieldName] -> UnionTag -> LocalM (Variant, [ClientPreDeclaration])
getVariant [FieldName]
namespace) [UnionTag]
variants
    (Variant
fallbackCons, [ClientPreDeclaration]
fallBackTypes) <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CodeGenTypeName -> LocalM (Variant, [ClientPreDeclaration])
getEmptyFallback CodeGenTypeName
cgTypeName) ([FieldName] -> UnionTag -> LocalM (Variant, [ClientPreDeclaration])
getVariant [FieldName]
namespace forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeName -> SelectionSet VALID -> UnionTag
UnionTag (forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
dType)) Maybe (SelectionSet VALID)
interface
    let typeDef :: CodeGenType
typeDef = CodeGenType {CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName, cgConstructors :: [CodeGenConstructor]
cgConstructors = forall a b. (a -> b) -> [a] -> [b]
map Variant -> CodeGenConstructor
buildVariantConstructor ([Variant]
cons forall a. Semigroup a => a -> a -> a
<> [Variant
fallbackCons]), cgDerivations :: [DerivingClass]
cgDerivations = [DerivingClass]
defaultDerivations}
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeGenTypeName
cgTypeName, [CodeGenType -> ClientPreDeclaration
ClientType CodeGenType
typeDef, CodeGenTypeName
-> [(UnionPat, (CodeGenTypeName, Maybe String))]
-> ClientPreDeclaration
FromJSONUnionClass CodeGenTypeName
cgTypeName (forall a b. (a -> b) -> [a] -> [b]
map forall {f :: * -> *} {b} {a}.
(Functor f, IsString b) =>
(CodeGenTypeName, f a) -> (UnionPat, (CodeGenTypeName, f b))
tagConstructor [Variant]
cons forall a. Semigroup a => a -> a -> a
<> [(String -> UnionPat
UVar String
"_fallback", forall {f :: * -> *} {b} {a} {a}.
(Functor f, IsString b) =>
(a, f a) -> (a, f b)
mapFallback Variant
fallbackCons)])] forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientPreDeclaration]]
subTypes forall a. Semigroup a => a -> a -> a
<> [ClientPreDeclaration]
fallBackTypes)
  where
    tagConstructor :: (CodeGenTypeName, f a) -> (UnionPat, (CodeGenTypeName, f b))
tagConstructor (CodeGenTypeName
name, f a
x) = (TypeName -> UnionPat
UString forall a b. (a -> b) -> a -> b
$ CodeGenTypeName -> TypeName
typename CodeGenTypeName
name, (CodeGenTypeName
name, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const b
"v") f a
x))
    mapFallback :: (a, f a) -> (a, f b)
mapFallback (a
x, f a
y) = (a
x, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. a -> b -> a
const b
"v") f a
y)

checkTypename :: Position -> [FieldName] -> Maybe (SelectionSet VALID) -> UnionTag -> LocalM ()
checkTypename :: Position
-> [FieldName]
-> Maybe (SelectionSet VALID)
-> UnionTag
-> LocalM ()
checkTypename Position
pos [FieldName]
path Maybe (SelectionSet VALID)
iFace UnionTag {SelectionSet VALID
TypeName
unionTagName :: UnionTag -> TypeName
unionTagSelection :: UnionTag -> SelectionSet VALID
unionTagSelection :: SelectionSet VALID
unionTagName :: TypeName
..}
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall k (m :: * -> *) a. IsMap k m => k -> m a -> Bool
member FieldName
"__typename") (SelectionSet VALID
unionTagSelection forall a. a -> [a] -> [a]
: forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe (SelectionSet VALID)
iFace) = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise =
      GQLError -> LocalM ()
gqlWarning forall a b. (a -> b) -> a -> b
$
        GQLError -> [PropName] -> GQLError
withPath
          (GQLError
"missing \"__typename\" for selection " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg TypeName
unionTagName forall a. Semigroup a => a -> a -> a
<> GQLError
". this can lead to undesired behavior at runtime!")
          (forall a b. (a -> b) -> [a] -> [b]
map (Text -> PropName
PropName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName) [FieldName]
path)
          GQLError -> Position -> GQLError
`at` Position
pos

type Variant = (CodeGenTypeName, Maybe TypeName)

getEmptyFallback :: CodeGenTypeName -> LocalM (Variant, [ClientPreDeclaration])
getEmptyFallback :: CodeGenTypeName -> LocalM (Variant, [ClientPreDeclaration])
getEmptyFallback CodeGenTypeName
name = forall (f :: * -> *) a. Applicative f => a -> f a
pure ((CodeGenTypeName
name, forall a. Maybe a
Nothing), [])

buildVariantConstructor :: Variant -> CodeGenConstructor
buildVariantConstructor :: Variant -> CodeGenConstructor
buildVariantConstructor (CodeGenTypeName
conName, Maybe TypeName
ref) =
  CodeGenConstructor
    { constructorName :: CodeGenTypeName
constructorName = CodeGenTypeName
conName,
      constructorFields :: [CodeGenField]
constructorFields =
        ( \TypeName
fieldType ->
            CodeGenField
              { fieldName :: FieldName
fieldName = FieldName
"_",
                TypeName
fieldType :: TypeName
fieldType :: TypeName
fieldType,
                wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [],
                fieldIsNullable :: Bool
fieldIsNullable = Bool
False
              }
        )
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Maybe TypeName
ref
    }

getVariant :: [FieldName] -> UnionTag -> LocalM (Variant, [ClientPreDeclaration])
getVariant :: [FieldName] -> UnionTag -> LocalM (Variant, [ClientPreDeclaration])
getVariant [FieldName]
path (UnionTag TypeName
selectedTyName SelectionSet VALID
selectionVariant) = do
  -- traceShow (map getSelectionOrigins variants)
  TypeDefinition ANY VALID
conDatatype <- TypeName -> LocalM (TypeDefinition ANY VALID)
getType TypeName
selectedTyName
  let name :: CodeGenTypeName
name = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [FieldName]
path [] TypeName
selectedTyName
  (CodeGenTypeName
n, [ClientPreDeclaration]
types) <- [FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectTypeWithFragment [FieldName]
path CodeGenTypeName
name TypeDefinition ANY VALID
conDatatype SelectionSet VALID
selectionVariant
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ( [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName ([FieldName]
path forall a. Semigroup a => a -> a -> a
<> [FieldName
"variant"]) [] TypeName
selectedTyName,
        forall a. a -> Maybe a
Just (CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
n)
      ),
      [ClientPreDeclaration]
types
    )

getFragmentOrigin :: SelectionSet VALID -> Maybe FragmentName
getFragmentOrigin :: SelectionSet VALID -> Maybe FragmentName
getFragmentOrigin SelectionSet VALID
x = case forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a. Ord a => [a] -> Set a
S.fromList (forall a b. (a -> b) -> [a] -> [b]
map forall (s :: Stage). Selection s -> Maybe FragmentName
selectionOrigin forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
x)) of
  [Just FragmentName
name] -> forall a. a -> Maybe a
Just FragmentName
name
  [Maybe FragmentName]
_ -> forall a. Maybe a
Nothing

genObjectTypeWithFragment ::
  [FieldName] ->
  CodeGenTypeName ->
  TypeDefinition ANY VALID ->
  SelectionSet VALID ->
  LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectTypeWithFragment :: [FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectTypeWithFragment [FieldName]
namespace CodeGenTypeName
cgTypeName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet = do
  case SelectionSet VALID -> Maybe FragmentName
getFragmentOrigin SelectionSet VALID
recordSelSet of
    Just FragmentName
name -> do
      Bool
exists <- FragmentName -> LocalM Bool
existFragment FragmentName
name
      let tName :: CodeGenTypeName
tName = [FieldName] -> [Text] -> TypeName -> CodeGenTypeName
CodeGenTypeName [] [] (TypeName
"Fragment" forall a. Semigroup a => a -> a -> a
<> coerce :: forall a b. Coercible a b => a -> b
coerce FragmentName
name)
      if Bool
exists
        then forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeGenTypeName
tName, [])
        else forall a. FragmentName -> LocalM a -> LocalM a
registerFragment FragmentName
name ([FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectType [FieldName]
namespace CodeGenTypeName
tName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet)
    Maybe FragmentName
Nothing -> [FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectType [FieldName]
namespace CodeGenTypeName
cgTypeName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet

genObjectType ::
  [FieldName] ->
  CodeGenTypeName ->
  TypeDefinition ANY VALID ->
  SelectionSet VALID ->
  LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectType :: [FieldName]
-> CodeGenTypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
genObjectType [FieldName]
namespace CodeGenTypeName
cgTypeName TypeDefinition ANY VALID
datatype SelectionSet VALID
selSet = do
  ([CodeGenField]
fields, [[ClientPreDeclaration]]
subTypes) <- forall a b. [(a, b)] -> ([a], [b])
unzip 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 ([FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (CodeGenField, [ClientPreDeclaration])
genField [FieldName]
namespace TypeDefinition ANY VALID
datatype) (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList SelectionSet VALID
selSet)
  let constructor :: CodeGenConstructor
constructor = CodeGenConstructor {constructorName :: CodeGenTypeName
constructorName = CodeGenTypeName
cgTypeName, constructorFields :: [CodeGenField]
constructorFields = [CodeGenField]
fields}
  let definition :: CodeGenType
definition = CodeGenType {CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName :: CodeGenTypeName
cgTypeName, cgConstructors :: [CodeGenConstructor]
cgConstructors = [CodeGenConstructor
constructor], cgDerivations :: [DerivingClass]
cgDerivations = [DerivingClass]
defaultDerivations}
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (CodeGenTypeName
cgTypeName, [CodeGenType -> ClientPreDeclaration
ClientType CodeGenType
definition, CodeGenTypeName -> CodeGenConstructor -> ClientPreDeclaration
FromJSONObjectClass CodeGenTypeName
cgTypeName CodeGenConstructor
constructor] forall a. Semigroup a => a -> a -> a
<> forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientPreDeclaration]]
subTypes)

genField :: [FieldName] -> TypeDefinition ANY VALID -> Selection VALID -> LocalM (CodeGenField, [ClientPreDeclaration])
genField :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (CodeGenField, [ClientPreDeclaration])
genField [FieldName]
path TypeDefinition ANY VALID
datatype Selection VALID
sel = do
  let fieldName :: FieldName
fieldName = forall k a. KeyOf k a => a -> k
keyOf Selection VALID
sel
  let fieldPath :: [FieldName]
fieldPath = [FieldName]
path forall a. Semigroup a => a -> a -> a
<> [FieldName
fieldName]
  (TypeDefinition ANY VALID
fieldDataType, TypeRef {TypeWrapper
TypeName
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeRef -> TypeWrapper
typeWrappers :: TypeWrapper
typeConName :: TypeName
..}) <- [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (TypeDefinition ANY VALID, TypeRef)
getFieldType [FieldName]
fieldPath TypeDefinition ANY VALID
datatype Selection VALID
sel
  (CodeGenTypeName
fieldTypeName, [ClientPreDeclaration]
subTypes) <- TypeName
-> [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (CodeGenTypeName, [ClientPreDeclaration])
subTypesBySelection TypeName
typeConName [FieldName]
fieldPath TypeDefinition ANY VALID
fieldDataType Selection VALID
sel
  forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( CodeGenField
        { FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
          fieldType :: TypeName
fieldType = CodeGenTypeName -> TypeName
getFullName CodeGenTypeName
fieldTypeName,
          wrappers :: [FIELD_TYPE_WRAPPER]
wrappers = [TypeWrapper -> FIELD_TYPE_WRAPPER
GQL_WRAPPER TypeWrapper
typeWrappers],
          fieldIsNullable :: Bool
fieldIsNullable = forall a. Nullable a => a -> Bool
isNullable TypeWrapper
typeWrappers
        },
      [ClientPreDeclaration]
subTypes
    )

getFieldType ::
  [FieldName] ->
  TypeDefinition ANY VALID ->
  Selection VALID ->
  LocalM (TypeDefinition ANY VALID, TypeRef)
getFieldType :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> LocalM (TypeDefinition ANY VALID, TypeRef)
getFieldType
  [FieldName]
path
  TypeDefinition {TypeContent TRUE ANY VALID
typeContent :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeContent TRUE a s
typeContent :: TypeContent TRUE ANY VALID
typeContent, TypeName
typeName :: TypeName
typeName :: forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName}
  Selection
    { FieldName
selectionName :: forall (s :: Stage). Selection s -> FieldName
selectionName :: FieldName
selectionName,
      Position
selectionPosition :: Position
selectionPosition :: forall (s :: Stage). Selection s -> Position
selectionPosition
    } = FieldName
-> TypeContent TRUE ANY VALID -> LocalM (FieldDefinition OUT VALID)
lookupField FieldName
selectionName TypeContent TRUE ANY VALID
typeContent forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDefinition OUT VALID
-> LocalM (TypeDefinition ANY VALID, TypeRef)
processFieldDefinition
    where
      --
      processFieldDefinition :: FieldDefinition OUT VALID
-> LocalM (TypeDefinition ANY VALID, TypeRef)
processFieldDefinition
        FieldDefinition
          { fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = TypeRef {TypeWrapper
TypeName
typeWrappers :: TypeWrapper
typeConName :: TypeName
typeConName :: TypeRef -> TypeName
typeWrappers :: TypeRef -> TypeWrapper
..},
            Directives VALID
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives :: Directives VALID
fieldDirectives
          } =
          LocalM ()
checkDeprecated forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef)
trans forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> LocalM (TypeDefinition ANY VALID)
getType TypeName
typeConName)
          where
            trans :: TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef)
trans TypeDefinition ANY VALID
x = (TypeDefinition ANY VALID
x, TypeRef {typeConName :: TypeName
typeConName = CodeGenTypeName -> TypeName
getFullName (forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> CodeGenTypeName
typeFrom [FieldName]
path TypeDefinition ANY VALID
x), TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeWrapper
..})
            ------------------------------------------------------------------
            checkDeprecated :: LocalM ()
            checkDeprecated :: LocalM ()
checkDeprecated = Directives VALID -> (FieldName, Ref FieldName) -> LocalM ()
deprecationWarning Directives VALID
fieldDirectives (coerce :: forall a b. Coercible a b => a -> b
coerce TypeName
typeName, forall name. name -> Position -> Ref name
Ref FieldName
selectionName Position
selectionPosition)