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

module Data.Morpheus.Client.Transform.Selection
  ( toClientDefinition,
    ClientDefinition (..),
  )
where

import Control.Monad.Except (MonadError (throwError))
import Data.Morpheus.Client.Internal.Types
  ( ClientConstructorDefinition (..),
    ClientDefinition (..),
    ClientTypeDefinition (..),
    TypeNameTH (..),
  )
import Data.Morpheus.Client.Transform.Core (Converter (..), compileError, deprecationWarning, getType, leafType, typeFrom)
import Data.Morpheus.Client.Transform.Inputs (renderNonOutputTypes, renderOperationArguments)
import Data.Morpheus.Internal.Ext
  ( GQLResult,
  )
import Data.Morpheus.Internal.Utils
  ( empty,
    keyOf,
    selectBy,
  )
import Data.Morpheus.Types.Internal.AST
  ( ANY,
    FieldDefinition (..),
    FieldName,
    Operation (..),
    RAW,
    Ref (..),
    Schema (..),
    Selection (..),
    SelectionContent (..),
    SelectionSet,
    TypeContent (..),
    TypeDefinition (..),
    TypeKind (..),
    TypeName,
    TypeRef (..),
    UnionTag (..),
    VALID,
    VariableDefinitions,
    getOperationDataType,
    getOperationName,
    mkTypeRef,
    msg,
    toAny,
  )
import Relude hiding (empty, show)
import Prelude (show)

toClientDefinition ::
  Schema VALID ->
  VariableDefinitions RAW ->
  Operation VALID ->
  GQLResult ClientDefinition
toClientDefinition :: Schema VALID
-> VariableDefinitions RAW
-> Operation VALID
-> GQLResult ClientDefinition
toClientDefinition Schema VALID
schema VariableDefinitions RAW
vars = (ReaderT
   (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
 -> (Schema VALID, VariableDefinitions RAW)
 -> GQLResult ClientDefinition)
-> (Schema VALID, VariableDefinitions RAW)
-> ReaderT
     (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
-> GQLResult ClientDefinition
forall a b c. (a -> b -> c) -> b -> a -> c
flip ReaderT
  (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
-> (Schema VALID, VariableDefinitions RAW)
-> GQLResult ClientDefinition
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Schema VALID
schema, VariableDefinitions RAW
vars) (ReaderT
   (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
 -> GQLResult ClientDefinition)
-> (Operation VALID
    -> ReaderT
         (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition)
-> Operation VALID
-> GQLResult ClientDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Converter ClientDefinition
-> ReaderT
     (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
forall a.
Converter a
-> ReaderT (Schema VALID, VariableDefinitions RAW) GQLResult a
runConverter (Converter ClientDefinition
 -> ReaderT
      (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition)
-> (Operation VALID -> Converter ClientDefinition)
-> Operation VALID
-> ReaderT
     (Schema VALID, VariableDefinitions RAW) GQLResult ClientDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Operation VALID -> Converter ClientDefinition
genOperation

genOperation :: Operation VALID -> Converter ClientDefinition
genOperation :: Operation VALID -> Converter ClientDefinition
genOperation Operation VALID
operation = do
  (Maybe ClientTypeDefinition
clientArguments, [ClientTypeDefinition]
outputTypes, [TypeName]
enums) <- Operation VALID
-> Converter
     (Maybe ClientTypeDefinition, [ClientTypeDefinition], [TypeName])
renderOperationType Operation VALID
operation
  [ClientTypeDefinition]
nonOutputTypes <- [TypeName] -> Converter [ClientTypeDefinition]
renderNonOutputTypes [TypeName]
enums
  ClientDefinition -> Converter ClientDefinition
forall (f :: * -> *) a. Applicative f => a -> f a
pure ClientDefinition :: Maybe ClientTypeDefinition
-> [ClientTypeDefinition] -> ClientDefinition
ClientDefinition {Maybe ClientTypeDefinition
clientArguments :: Maybe ClientTypeDefinition
clientArguments :: Maybe ClientTypeDefinition
clientArguments, clientTypes :: [ClientTypeDefinition]
clientTypes = [ClientTypeDefinition]
outputTypes [ClientTypeDefinition]
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. Semigroup a => a -> a -> a
<> [ClientTypeDefinition]
nonOutputTypes}

renderOperationType ::
  Operation VALID ->
  Converter
    ( Maybe ClientTypeDefinition,
      [ClientTypeDefinition],
      [TypeName]
    )
renderOperationType :: Operation VALID
-> Converter
     (Maybe ClientTypeDefinition, [ClientTypeDefinition], [TypeName])
renderOperationType 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} = do
  TypeDefinition OBJECT VALID
datatype <- ((Schema VALID, VariableDefinitions RAW) -> Schema VALID)
-> Converter (Schema VALID)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Schema VALID, VariableDefinitions RAW) -> Schema VALID
forall a b. (a, b) -> a
fst Converter (Schema VALID)
-> (Schema VALID -> Converter (TypeDefinition OBJECT VALID))
-> Converter (TypeDefinition OBJECT VALID)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Operation VALID
-> Schema VALID -> Converter (TypeDefinition OBJECT VALID)
forall (m :: * -> *) (s :: Stage).
MonadError GQLError m =>
Operation s -> Schema VALID -> m (TypeDefinition OBJECT VALID)
getOperationDataType Operation VALID
op
  Maybe ClientTypeDefinition
arguments <- Operation VALID -> Converter (Maybe ClientTypeDefinition)
renderOperationArguments Operation VALID
op
  ([ClientTypeDefinition]
outputTypes, [TypeName]
enums) <-
    [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter ([ClientTypeDefinition], [TypeName])
genRecordType
      []
      (Maybe FieldName -> TypeName
getOperationName Maybe FieldName
operationName)
      (TypeDefinition OBJECT VALID -> TypeDefinition ANY VALID
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
  (Maybe ClientTypeDefinition, [ClientTypeDefinition], [TypeName])
-> Converter
     (Maybe ClientTypeDefinition, [ClientTypeDefinition], [TypeName])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ClientTypeDefinition
arguments, [ClientTypeDefinition]
outputTypes, [TypeName]
enums)

-------------------------------------------------------------------------
-- generates selection Object Types
genRecordType ::
  [FieldName] ->
  TypeName ->
  TypeDefinition ANY VALID ->
  SelectionSet VALID ->
  Converter ([ClientTypeDefinition], [TypeName])
genRecordType :: [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter ([ClientTypeDefinition], [TypeName])
genRecordType [FieldName]
path TypeName
tName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet = do
  (ClientConstructorDefinition
con, [ClientTypeDefinition]
subTypes, [TypeName]
requests) <- [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
genConsD [FieldName]
path TypeName
tName TypeDefinition ANY VALID
dataType SelectionSet VALID
recordSelSet
  ([ClientTypeDefinition], [TypeName])
-> Converter ([ClientTypeDefinition], [TypeName])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    ( ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
        { clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [FieldName]
path TypeName
tName,
          clientCons :: [ClientConstructorDefinition]
clientCons = [ClientConstructorDefinition
con],
          clientKind :: TypeKind
clientKind = Maybe OperationType -> TypeKind
KindObject Maybe OperationType
forall a. Maybe a
Nothing
        }
        ClientTypeDefinition
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. a -> [a] -> [a]
: [ClientTypeDefinition]
subTypes,
      [TypeName]
requests
    )

genConsD ::
  [FieldName] ->
  TypeName ->
  TypeDefinition ANY VALID ->
  SelectionSet VALID ->
  Converter
    ( ClientConstructorDefinition,
      [ClientTypeDefinition],
      [TypeName]
    )
genConsD :: [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
genConsD [FieldName]
path TypeName
cName TypeDefinition ANY VALID
datatype SelectionSet VALID
selSet = do
  ([FieldDefinition ANY VALID]
cFields, [[ClientTypeDefinition]]
subTypes, [[TypeName]]
requests) <- [(FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])]
-> ([FieldDefinition ANY VALID], [[ClientTypeDefinition]],
    [[TypeName]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])]
 -> ([FieldDefinition ANY VALID], [[ClientTypeDefinition]],
     [[TypeName]]))
-> Converter
     [(FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])]
-> Converter
     ([FieldDefinition ANY VALID], [[ClientTypeDefinition]],
      [[TypeName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Selection VALID
 -> Converter
      (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName]))
-> [Selection VALID]
-> Converter
     [(FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Selection VALID
-> Converter
     (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])
genField (MergeMap 'False FieldName (Selection VALID) -> [Selection VALID]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False FieldName (Selection VALID)
SelectionSet VALID
selSet)
  (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ClientConstructorDefinition :: TypeName
-> [FieldDefinition ANY VALID] -> ClientConstructorDefinition
ClientConstructorDefinition {TypeName
cName :: TypeName
cName :: TypeName
cName, [FieldDefinition ANY VALID]
cFields :: [FieldDefinition ANY VALID]
cFields :: [FieldDefinition ANY VALID]
cFields}, [[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientTypeDefinition]]
subTypes, [[TypeName]] -> [TypeName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TypeName]]
requests)
  where
    genField ::
      Selection VALID ->
      Converter (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])
    genField :: Selection VALID
-> Converter
     (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])
genField Selection VALID
sel =
      do
        (TypeDefinition ANY VALID
fieldDataType, TypeRef
fieldType) <-
          [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
getFieldType
            [FieldName]
fieldPath
            TypeDefinition ANY VALID
datatype
            Selection VALID
sel
        ([ClientTypeDefinition]
subTypes, [TypeName]
requests) <- [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter ([ClientTypeDefinition], [TypeName])
subTypesBySelection [FieldName]
fieldPath TypeDefinition ANY VALID
fieldDataType Selection VALID
sel
        (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])
-> Converter
     (FieldDefinition ANY VALID, [ClientTypeDefinition], [TypeName])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
          ( FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
              { FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
                TypeRef
fieldType :: TypeRef
fieldType :: TypeRef
fieldType,
                fieldContent :: Maybe (FieldContent TRUE ANY VALID)
fieldContent = Maybe (FieldContent TRUE ANY VALID)
forall a. Maybe a
Nothing,
                fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
                fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty
              },
            [ClientTypeDefinition]
subTypes,
            [TypeName]
requests
          )
      where
        fieldPath :: [FieldName]
fieldPath = [FieldName]
path [FieldName] -> [FieldName] -> [FieldName]
forall a. Semigroup a => a -> a -> a
<> [FieldName
fieldName]
        -------------------------------
        fieldName :: FieldName
fieldName = Selection VALID -> FieldName
forall k a. KeyOf k a => a -> k
keyOf Selection VALID
sel

------------------------------------------
subTypesBySelection ::
  [FieldName] ->
  TypeDefinition ANY VALID ->
  Selection VALID ->
  Converter
    ( [ClientTypeDefinition],
      [TypeName]
    )
subTypesBySelection :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter ([ClientTypeDefinition], [TypeName])
subTypesBySelection [FieldName]
_ TypeDefinition ANY VALID
dType Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = SelectionContent VALID
SelectionField} =
  TypeDefinition ANY VALID
-> Converter ([ClientTypeDefinition], [TypeName])
forall (a :: TypeCategory).
TypeDefinition a VALID
-> Converter ([ClientTypeDefinition], [TypeName])
leafType TypeDefinition ANY VALID
dType
subTypesBySelection [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
-> Converter ([ClientTypeDefinition], [TypeName])
genRecordType [FieldName]
path ([FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] TypeDefinition ANY VALID
dType) TypeDefinition ANY VALID
dType SelectionSet VALID
selectionSet
subTypesBySelection [FieldName]
path TypeDefinition ANY VALID
dType Selection {selectionContent :: forall (s :: Stage). Selection s -> SelectionContent s
selectionContent = UnionSelection SelectionSet VALID
interface UnionSelection VALID
unionSelections} =
  do
    ([ClientConstructorDefinition]
clientCons, [[ClientTypeDefinition]]
subTypes, [[TypeName]]
requests) <-
      [(ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])]
-> ([ClientConstructorDefinition], [[ClientTypeDefinition]],
    [[TypeName]])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3
        ([(ClientConstructorDefinition, [ClientTypeDefinition],
   [TypeName])]
 -> ([ClientConstructorDefinition], [[ClientTypeDefinition]],
     [[TypeName]]))
-> Converter
     [(ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])]
-> Converter
     ([ClientConstructorDefinition], [[ClientTypeDefinition]],
      [[TypeName]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (UnionTag
 -> Converter
      (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName]))
-> [UnionTag]
-> Converter
     [(ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse
          UnionTag
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
getUnionType
          ( TypeName -> SelectionSet VALID -> UnionTag
UnionTag (TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory) (s :: Stage).
TypeDefinition a s -> TypeName
typeName TypeDefinition ANY VALID
dType) SelectionSet VALID
interface UnionTag -> [UnionTag] -> [UnionTag]
forall a. a -> [a] -> [a]
: MergeMap 'False TypeName UnionTag -> [UnionTag]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList MergeMap 'False TypeName UnionTag
UnionSelection VALID
unionSelections
          )
    ([ClientTypeDefinition], [TypeName])
-> Converter ([ClientTypeDefinition], [TypeName])
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ( ClientTypeDefinition :: TypeNameTH
-> [ClientConstructorDefinition]
-> TypeKind
-> ClientTypeDefinition
ClientTypeDefinition
          { clientTypeName :: TypeNameTH
clientTypeName = [FieldName] -> TypeName -> TypeNameTH
TypeNameTH [FieldName]
path ([FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [] TypeDefinition ANY VALID
dType),
            [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons :: [ClientConstructorDefinition]
clientCons,
            clientKind :: TypeKind
clientKind = TypeKind
KindUnion
          }
          ClientTypeDefinition
-> [ClientTypeDefinition] -> [ClientTypeDefinition]
forall a. a -> [a] -> [a]
: [[ClientTypeDefinition]] -> [ClientTypeDefinition]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[ClientTypeDefinition]]
subTypes,
        [[TypeName]] -> [TypeName]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[TypeName]]
requests
      )
  where
    getUnionType :: UnionTag
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
getUnionType (UnionTag TypeName
selectedTyName SelectionSet VALID
selectionVariant) = do
      TypeDefinition ANY VALID
conDatatype <- TypeName -> Converter (TypeDefinition ANY VALID)
getType TypeName
selectedTyName
      [FieldName]
-> TypeName
-> TypeDefinition ANY VALID
-> SelectionSet VALID
-> Converter
     (ClientConstructorDefinition, [ClientTypeDefinition], [TypeName])
genConsD [FieldName]
path TypeName
selectedTyName TypeDefinition ANY VALID
conDatatype SelectionSet VALID
selectionVariant

getFieldType ::
  [FieldName] ->
  TypeDefinition ANY VALID ->
  Selection VALID ->
  Converter (TypeDefinition ANY VALID, TypeRef)
getFieldType :: [FieldName]
-> TypeDefinition ANY VALID
-> Selection VALID
-> Converter (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 :: forall (s :: Stage). Selection s -> Position
selectionPosition :: Position
selectionPosition
    }
    | FieldName
selectionName FieldName -> FieldName -> Bool
forall a. Eq a => a -> a -> Bool
== FieldName
"__typename" =
      FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processDeprecation
        FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
          { fieldName :: FieldName
fieldName = FieldName
"__typename",
            fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
            fieldType :: TypeRef
fieldType = TypeName -> TypeRef
mkTypeRef TypeName
"String",
            fieldDirectives :: Directives VALID
fieldDirectives = Directives VALID
forall coll. Empty coll => coll
empty,
            fieldContent :: Maybe (FieldContent TRUE OUT VALID)
fieldContent = Maybe (FieldContent TRUE OUT VALID)
forall a. Maybe a
Nothing
          }
    | Bool
otherwise = TypeContent TRUE ANY VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
withTypeContent TypeContent TRUE ANY VALID
typeContent
    where
      withTypeContent :: TypeContent TRUE ANY VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
withTypeContent DataObject {FieldsDefinition OUT VALID
objectFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent OBJECT a s -> FieldsDefinition OUT s
objectFields :: FieldsDefinition OUT VALID
objectFields} =
        GQLError
-> FieldName
-> FieldsDefinition OUT VALID
-> Converter (FieldDefinition OUT VALID)
forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy GQLError
selError FieldName
selectionName FieldsDefinition OUT VALID
objectFields Converter (FieldDefinition OUT VALID)
-> (FieldDefinition OUT VALID
    -> Converter (TypeDefinition ANY VALID, TypeRef))
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processDeprecation
      withTypeContent DataInterface {FieldsDefinition OUT VALID
interfaceFields :: forall (a :: TypeCategory) (s :: Stage).
CondTypeContent IMPLEMENTABLE a s -> FieldsDefinition OUT s
interfaceFields :: FieldsDefinition OUT VALID
interfaceFields} =
        GQLError
-> FieldName
-> FieldsDefinition OUT VALID
-> Converter (FieldDefinition OUT VALID)
forall e (m :: * -> *) k (c :: * -> *) a.
(MonadError e m, IsMap k c, Monad m) =>
e -> k -> c a -> m a
selectBy GQLError
selError FieldName
selectionName FieldsDefinition OUT VALID
interfaceFields Converter (FieldDefinition OUT VALID)
-> (FieldDefinition OUT VALID
    -> Converter (TypeDefinition ANY VALID, TypeRef))
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processDeprecation
      withTypeContent TypeContent TRUE ANY VALID
dt =
        GQLError -> Converter (TypeDefinition ANY VALID, TypeRef)
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
compileError (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$ GQLError
"Type should be output Object \"" GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> String -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeContent TRUE ANY VALID -> String
forall a. Show a => a -> String
show TypeContent TRUE ANY VALID
dt))
      selError :: GQLError
selError = GQLError -> GQLError
compileError (GQLError -> GQLError) -> GQLError -> GQLError
forall a b. (a -> b) -> a -> b
$ GQLError
"can't find field " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
selectionName GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" on type: " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> String -> GQLError
forall a. Msg a => a -> GQLError
msg (TypeContent TRUE ANY VALID -> String
forall a. Show a => a -> String
show TypeContent TRUE ANY VALID
typeContent)
      processDeprecation :: FieldDefinition OUT VALID
-> Converter (TypeDefinition ANY VALID, TypeRef)
processDeprecation
        FieldDefinition
          { fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType = alias :: TypeRef
alias@TypeRef {TypeName
typeConName :: TypeRef -> TypeName
typeConName :: TypeName
typeConName},
            Directives VALID
fieldDirectives :: Directives VALID
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives
          } =
          Converter ()
checkDeprecated Converter ()
-> Converter (TypeDefinition ANY VALID, TypeRef)
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef)
trans (TypeDefinition ANY VALID -> (TypeDefinition ANY VALID, TypeRef))
-> Converter (TypeDefinition ANY VALID)
-> Converter (TypeDefinition ANY VALID, TypeRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TypeName -> Converter (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
alias {typeConName :: TypeName
typeConName = [FieldName] -> TypeDefinition ANY VALID -> TypeName
forall (a :: TypeCategory).
[FieldName] -> TypeDefinition a VALID -> TypeName
typeFrom [FieldName]
path TypeDefinition ANY VALID
x})
            ------------------------------------------------------------------
            checkDeprecated :: Converter ()
            checkDeprecated :: Converter ()
checkDeprecated =
              Directives VALID -> (FieldName, Ref FieldName) -> Converter ()
deprecationWarning
                Directives VALID
fieldDirectives
                ( TypeName -> FieldName
coerce TypeName
typeName,
                  Ref :: forall name. name -> Position -> Ref name
Ref {refName :: FieldName
refName = FieldName
selectionName, refPosition :: Position
refPosition = Position
selectionPosition}
                )