{-# 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,
    lookupField,
    lookupType,
    registerFragment,
    removeDuplicates,
    typeFrom,
    warning,
  )
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.CodeGen.Utils
  ( Flags,
    langExtension,
    requireExternal,
    runCodeGenT,
  )
import Data.Morpheus.Core (validateRequest)
import Data.Morpheus.Error (deprecatedField)
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 (..),
    Schema (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    UnionTag (..),
    VALID,
    at,
    getOperationDataType,
    getOperationName,
    isNullable,
    kindOf,
    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], Flags)
toLocalDefinitions :: (Text, ExecutableDocument)
-> Schema VALID -> GQLResult ([ClientDeclaration], Flags)
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]
t, Flags
flags) <- forall (m :: * -> *) ctx a.
Monad m =>
CodeGenT ctx m a -> ctx -> m (a, Flags)
runCodeGenT (Text -> Operation VALID -> LocalM [ClientPreDeclaration]
genLocalDeclarations Text
query Operation VALID
validOperation) LocalContext
context
  [ClientDeclaration]
types <- [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]
t
  forall (f :: * -> *) a. Applicative f => a -> f a
pure ([ClientDeclaration]
types, Flags
flags)

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} = do
  Maybe TypeKind
kind <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeKind
kindOf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> LocalM (Maybe (TypeDefinition ANY VALID))
lookupType TypeName
name
  if forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe TypeKind
kind Bool -> Bool -> Bool
|| Maybe TypeKind
kind forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just TypeKind
KIND_SCALAR
    then forall (m :: * -> *). MonadState Flags m => Text -> m ()
requireExternal (forall a (t :: NAME). NamePacking a => Name t -> a
unpackName TypeName
name) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> (TypeName -> CodeGenTypeName
fromTypeName TypeName
name, [])
    else 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 (m :: * -> *). MonadState Flags m => Text -> m ()
langExtension Text
"LambdaCase"
    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 ()
warning 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
..}, Maybe Text
Maybe (FieldContent TRUE OUT VALID)
FieldName
Directives VALID
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Text
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives :: Directives VALID
fieldContent :: Maybe (FieldContent TRUE OUT VALID)
fieldName :: FieldName
fieldDescription :: Maybe Text
..} = do
        forall (s :: Stage).
(Maybe Text -> GQLError) -> Directives s -> LocalM ()
deprecationWarning Maybe Text -> GQLError
fieldWarnings Directives VALID
fieldDirectives
        TypeDefinition ANY VALID
typeDef <- TypeName -> LocalM (TypeDefinition ANY VALID)
getType TypeName
typeConName
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (TypeDefinition ANY VALID
typeDef, TypeRef {typeConName :: TypeName
typeConName = CodeGenTypeName -> TypeName
getFullName (forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> CodeGenTypeName
typeFrom [FieldName]
path TypeDefinition ANY VALID
typeDef), TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeWrapper
..})
        where
          fieldWarnings :: Maybe Text -> GQLError
fieldWarnings Maybe Text
reason =
            ( TypeName -> FieldName -> Maybe Text -> GQLError
deprecatedField TypeName
typeName FieldName
selectionName Maybe Text
reason
                GQLError -> Position -> GQLError
`at` Position
selectionPosition
            )
              GQLError -> [PropName] -> GQLError
`withPath` 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