{-# LANGUAGE TemplateHaskell #-}

module Hasura.RQL.Types.CustomTypes
  ( -- * Metadata
    GraphQLType (..),
    isListType,
    isNullableType,
    isInBuiltScalar,
    CustomTypes (..),
    emptyCustomTypes,

    -- ** Type definitions
    InputObjectTypeDefinition (..),
    InputObjectTypeName (..),
    InputObjectFieldDefinition (..),
    InputObjectFieldName (..),
    ObjectTypeDefinition (..),
    ObjectTypeName (..),
    ObjectFieldDefinition (..),
    ObjectFieldName (..),
    ScalarTypeDefinition (..),
    defaultGraphQLScalars,
    EnumTypeDefinition (..),
    EnumTypeName (..),
    EnumValueDefinition (..),

    -- ** Relationships
    TypeRelationshipDefinition (..),
    RelationshipName (..),
    trdName,
    trdType,
    trdSource,
    trdRemoteTable,
    trdFieldMapping,

    -- * Schema cache
    AnnotatedCustomTypes (..),
    AnnotatedInputType (..),
    AnnotatedOutputType (..),
    AnnotatedObjectType (..),
    AnnotatedObjectFieldType (..),
    AnnotatedTypeRelationship (..),
    AnnotatedScalarType (..),
    ScalarWrapper (..),
  )
where

import Autodocodec (HasCodec (codec), dimapCodec, optionalField', optionalFieldWith', optionalFieldWithDefault', optionalFieldWithOmittedDefault', requiredField', requiredFieldWith')
import Autodocodec qualified as AC
import Autodocodec.Extended (graphQLEnumValueCodec, graphQLFieldDescriptionCodec, graphQLFieldNameCodec, typeableName)
import Control.Lens.TH (makeLenses)
import Data.Aeson ((.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as J
import Data.Aeson.TH qualified as J
import Data.HashMap.Strict qualified as HashMap
import Data.HashSet qualified as Set
import Data.Text.Extended (ToTxt (..))
import Data.Typeable (Typeable)
import Hasura.Backends.Postgres.Instances.Types ()
import Hasura.Backends.Postgres.SQL.Types qualified as Postgres
import Hasura.GraphQL.Parser.Name qualified as GName
import Hasura.Prelude
import Hasura.RQL.Types.Backend
import Hasura.RQL.Types.BackendType
import Hasura.RQL.Types.Column
import Hasura.RQL.Types.Common
import Hasura.SQL.AnyBackend
import Hasura.Table.Cache (GraphQLType (..), isListType, isNullableType)
import Language.GraphQL.Draft.Syntax qualified as G

--------------------------------------------------------------------------------
-- Metadata

isInBuiltScalar :: Text -> Bool
isInBuiltScalar :: Text -> Bool
isInBuiltScalar Text
s
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
GName._Int = Bool
True
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
GName._Float = Bool
True
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
GName._String = Bool
True
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
GName._Boolean = Bool
True
  | Text
s Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Name -> Text
G.unName Name
GName._ID = Bool
True
  | Bool
otherwise = Bool
False

-- | A set of custom GraphQL types, sorted by "kind".
data CustomTypes = CustomTypes
  { CustomTypes -> [InputObjectTypeDefinition]
_ctInputObjects :: [InputObjectTypeDefinition],
    CustomTypes -> [ObjectTypeDefinition]
_ctObjects :: [ObjectTypeDefinition],
    CustomTypes -> [ScalarTypeDefinition]
_ctScalars :: [ScalarTypeDefinition],
    CustomTypes -> [EnumTypeDefinition]
_ctEnums :: [EnumTypeDefinition]
  }
  deriving (Int -> CustomTypes -> ShowS
[CustomTypes] -> ShowS
CustomTypes -> String
(Int -> CustomTypes -> ShowS)
-> (CustomTypes -> String)
-> ([CustomTypes] -> ShowS)
-> Show CustomTypes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CustomTypes -> ShowS
showsPrec :: Int -> CustomTypes -> ShowS
$cshow :: CustomTypes -> String
show :: CustomTypes -> String
$cshowList :: [CustomTypes] -> ShowS
showList :: [CustomTypes] -> ShowS
Show, CustomTypes -> CustomTypes -> Bool
(CustomTypes -> CustomTypes -> Bool)
-> (CustomTypes -> CustomTypes -> Bool) -> Eq CustomTypes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CustomTypes -> CustomTypes -> Bool
== :: CustomTypes -> CustomTypes -> Bool
$c/= :: CustomTypes -> CustomTypes -> Bool
/= :: CustomTypes -> CustomTypes -> Bool
Eq, (forall x. CustomTypes -> Rep CustomTypes x)
-> (forall x. Rep CustomTypes x -> CustomTypes)
-> Generic CustomTypes
forall x. Rep CustomTypes x -> CustomTypes
forall x. CustomTypes -> Rep CustomTypes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CustomTypes -> Rep CustomTypes x
from :: forall x. CustomTypes -> Rep CustomTypes x
$cto :: forall x. Rep CustomTypes x -> CustomTypes
to :: forall x. Rep CustomTypes x -> CustomTypes
Generic)

instance NFData CustomTypes

instance HasCodec CustomTypes where
  codec :: JSONCodec CustomTypes
codec =
    Text
-> ObjectCodec CustomTypes CustomTypes -> JSONCodec CustomTypes
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"CustomTypes"
      (ObjectCodec CustomTypes CustomTypes -> JSONCodec CustomTypes)
-> ObjectCodec CustomTypes CustomTypes -> JSONCodec CustomTypes
forall a b. (a -> b) -> a -> b
$ [InputObjectTypeDefinition]
-> [ObjectTypeDefinition]
-> [ScalarTypeDefinition]
-> [EnumTypeDefinition]
-> CustomTypes
CustomTypes
      ([InputObjectTypeDefinition]
 -> [ObjectTypeDefinition]
 -> [ScalarTypeDefinition]
 -> [EnumTypeDefinition]
 -> CustomTypes)
-> Codec Object CustomTypes [InputObjectTypeDefinition]
-> Codec
     Object
     CustomTypes
     ([ObjectTypeDefinition]
      -> [ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [InputObjectTypeDefinition]
-> ObjectCodec
     [InputObjectTypeDefinition] [InputObjectTypeDefinition]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"input_objects" []
      ObjectCodec [InputObjectTypeDefinition] [InputObjectTypeDefinition]
-> (CustomTypes -> [InputObjectTypeDefinition])
-> Codec Object CustomTypes [InputObjectTypeDefinition]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomTypes -> [InputObjectTypeDefinition]
_ctInputObjects
        Codec
  Object
  CustomTypes
  ([ObjectTypeDefinition]
   -> [ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
-> Codec Object CustomTypes [ObjectTypeDefinition]
-> Codec
     Object
     CustomTypes
     ([ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
forall a b.
Codec Object CustomTypes (a -> b)
-> Codec Object CustomTypes a -> Codec Object CustomTypes b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [ObjectTypeDefinition]
-> ObjectCodec [ObjectTypeDefinition] [ObjectTypeDefinition]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"objects" []
      ObjectCodec [ObjectTypeDefinition] [ObjectTypeDefinition]
-> (CustomTypes -> [ObjectTypeDefinition])
-> Codec Object CustomTypes [ObjectTypeDefinition]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomTypes -> [ObjectTypeDefinition]
_ctObjects
        Codec
  Object
  CustomTypes
  ([ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
-> Codec Object CustomTypes [ScalarTypeDefinition]
-> Codec Object CustomTypes ([EnumTypeDefinition] -> CustomTypes)
forall a b.
Codec Object CustomTypes (a -> b)
-> Codec Object CustomTypes a -> Codec Object CustomTypes b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [ScalarTypeDefinition]
-> ObjectCodec [ScalarTypeDefinition] [ScalarTypeDefinition]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"scalars" []
      ObjectCodec [ScalarTypeDefinition] [ScalarTypeDefinition]
-> (CustomTypes -> [ScalarTypeDefinition])
-> Codec Object CustomTypes [ScalarTypeDefinition]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomTypes -> [ScalarTypeDefinition]
_ctScalars
        Codec Object CustomTypes ([EnumTypeDefinition] -> CustomTypes)
-> Codec Object CustomTypes [EnumTypeDefinition]
-> ObjectCodec CustomTypes CustomTypes
forall a b.
Codec Object CustomTypes (a -> b)
-> Codec Object CustomTypes a -> Codec Object CustomTypes b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [EnumTypeDefinition]
-> ObjectCodec [EnumTypeDefinition] [EnumTypeDefinition]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"enums" []
      ObjectCodec [EnumTypeDefinition] [EnumTypeDefinition]
-> (CustomTypes -> [EnumTypeDefinition])
-> Codec Object CustomTypes [EnumTypeDefinition]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= CustomTypes -> [EnumTypeDefinition]
_ctEnums

emptyCustomTypes :: CustomTypes
emptyCustomTypes :: CustomTypes
emptyCustomTypes = [InputObjectTypeDefinition]
-> [ObjectTypeDefinition]
-> [ScalarTypeDefinition]
-> [EnumTypeDefinition]
-> CustomTypes
CustomTypes [] [] [] []

--------------------------------------------------------------------------------
-- Custom input objects

data InputObjectTypeDefinition = InputObjectTypeDefinition
  { InputObjectTypeDefinition -> InputObjectTypeName
_iotdName :: InputObjectTypeName,
    InputObjectTypeDefinition -> Maybe Description
_iotdDescription :: Maybe G.Description,
    InputObjectTypeDefinition -> NonEmpty InputObjectFieldDefinition
_iotdFields :: NonEmpty InputObjectFieldDefinition
  }
  deriving (Int -> InputObjectTypeDefinition -> ShowS
[InputObjectTypeDefinition] -> ShowS
InputObjectTypeDefinition -> String
(Int -> InputObjectTypeDefinition -> ShowS)
-> (InputObjectTypeDefinition -> String)
-> ([InputObjectTypeDefinition] -> ShowS)
-> Show InputObjectTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectTypeDefinition -> ShowS
showsPrec :: Int -> InputObjectTypeDefinition -> ShowS
$cshow :: InputObjectTypeDefinition -> String
show :: InputObjectTypeDefinition -> String
$cshowList :: [InputObjectTypeDefinition] -> ShowS
showList :: [InputObjectTypeDefinition] -> ShowS
Show, InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
(InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> Eq InputObjectTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
== :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$c/= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
/= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
Eq, Eq InputObjectTypeDefinition
Eq InputObjectTypeDefinition
-> (InputObjectTypeDefinition
    -> InputObjectTypeDefinition -> Ordering)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool)
-> (InputObjectTypeDefinition
    -> InputObjectTypeDefinition -> InputObjectTypeDefinition)
-> (InputObjectTypeDefinition
    -> InputObjectTypeDefinition -> InputObjectTypeDefinition)
-> Ord InputObjectTypeDefinition
InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
InputObjectTypeDefinition -> InputObjectTypeDefinition -> Ordering
InputObjectTypeDefinition
-> InputObjectTypeDefinition -> InputObjectTypeDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Ordering
compare :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Ordering
$c< :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
< :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$c<= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
<= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$c> :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
> :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$c>= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
>= :: InputObjectTypeDefinition -> InputObjectTypeDefinition -> Bool
$cmax :: InputObjectTypeDefinition
-> InputObjectTypeDefinition -> InputObjectTypeDefinition
max :: InputObjectTypeDefinition
-> InputObjectTypeDefinition -> InputObjectTypeDefinition
$cmin :: InputObjectTypeDefinition
-> InputObjectTypeDefinition -> InputObjectTypeDefinition
min :: InputObjectTypeDefinition
-> InputObjectTypeDefinition -> InputObjectTypeDefinition
Ord, (forall x.
 InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x)
-> (forall x.
    Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition)
-> Generic InputObjectTypeDefinition
forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
from :: forall x.
InputObjectTypeDefinition -> Rep InputObjectTypeDefinition x
$cto :: forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
to :: forall x.
Rep InputObjectTypeDefinition x -> InputObjectTypeDefinition
Generic)

instance NFData InputObjectTypeDefinition

instance HasCodec InputObjectTypeDefinition where
  codec :: JSONCodec InputObjectTypeDefinition
codec =
    Text
-> ObjectCodec InputObjectTypeDefinition InputObjectTypeDefinition
-> JSONCodec InputObjectTypeDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"InputObjectTypeDefinition"
      (ObjectCodec InputObjectTypeDefinition InputObjectTypeDefinition
 -> JSONCodec InputObjectTypeDefinition)
-> ObjectCodec InputObjectTypeDefinition InputObjectTypeDefinition
-> JSONCodec InputObjectTypeDefinition
forall a b. (a -> b) -> a -> b
$ InputObjectTypeName
-> Maybe Description
-> NonEmpty InputObjectFieldDefinition
-> InputObjectTypeDefinition
InputObjectTypeDefinition
      (InputObjectTypeName
 -> Maybe Description
 -> NonEmpty InputObjectFieldDefinition
 -> InputObjectTypeDefinition)
-> Codec Object InputObjectTypeDefinition InputObjectTypeName
-> Codec
     Object
     InputObjectTypeDefinition
     (Maybe Description
      -> NonEmpty InputObjectFieldDefinition
      -> InputObjectTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec InputObjectTypeName InputObjectTypeName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec InputObjectTypeName InputObjectTypeName
-> (InputObjectTypeDefinition -> InputObjectTypeName)
-> Codec Object InputObjectTypeDefinition InputObjectTypeName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectTypeDefinition -> InputObjectTypeName
_iotdName
        Codec
  Object
  InputObjectTypeDefinition
  (Maybe Description
   -> NonEmpty InputObjectFieldDefinition
   -> InputObjectTypeDefinition)
-> Codec Object InputObjectTypeDefinition (Maybe Description)
-> Codec
     Object
     InputObjectTypeDefinition
     (NonEmpty InputObjectFieldDefinition -> InputObjectTypeDefinition)
forall a b.
Codec Object InputObjectTypeDefinition (a -> b)
-> Codec Object InputObjectTypeDefinition a
-> Codec Object InputObjectTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (InputObjectTypeDefinition -> Maybe Description)
-> Codec Object InputObjectTypeDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectTypeDefinition -> Maybe Description
_iotdDescription
        Codec
  Object
  InputObjectTypeDefinition
  (NonEmpty InputObjectFieldDefinition -> InputObjectTypeDefinition)
-> Codec
     Object
     InputObjectTypeDefinition
     (NonEmpty InputObjectFieldDefinition)
-> ObjectCodec InputObjectTypeDefinition InputObjectTypeDefinition
forall a b.
Codec Object InputObjectTypeDefinition (a -> b)
-> Codec Object InputObjectTypeDefinition a
-> Codec Object InputObjectTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (NonEmpty InputObjectFieldDefinition)
     (NonEmpty InputObjectFieldDefinition)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"fields"
      ObjectCodec
  (NonEmpty InputObjectFieldDefinition)
  (NonEmpty InputObjectFieldDefinition)
-> (InputObjectTypeDefinition
    -> NonEmpty InputObjectFieldDefinition)
-> Codec
     Object
     InputObjectTypeDefinition
     (NonEmpty InputObjectFieldDefinition)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectTypeDefinition -> NonEmpty InputObjectFieldDefinition
_iotdFields

newtype InputObjectTypeName = InputObjectTypeName {InputObjectTypeName -> Name
unInputObjectTypeName :: G.Name}
  deriving (Int -> InputObjectTypeName -> ShowS
[InputObjectTypeName] -> ShowS
InputObjectTypeName -> String
(Int -> InputObjectTypeName -> ShowS)
-> (InputObjectTypeName -> String)
-> ([InputObjectTypeName] -> ShowS)
-> Show InputObjectTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectTypeName -> ShowS
showsPrec :: Int -> InputObjectTypeName -> ShowS
$cshow :: InputObjectTypeName -> String
show :: InputObjectTypeName -> String
$cshowList :: [InputObjectTypeName] -> ShowS
showList :: [InputObjectTypeName] -> ShowS
Show, InputObjectTypeName -> InputObjectTypeName -> Bool
(InputObjectTypeName -> InputObjectTypeName -> Bool)
-> (InputObjectTypeName -> InputObjectTypeName -> Bool)
-> Eq InputObjectTypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectTypeName -> InputObjectTypeName -> Bool
== :: InputObjectTypeName -> InputObjectTypeName -> Bool
$c/= :: InputObjectTypeName -> InputObjectTypeName -> Bool
/= :: InputObjectTypeName -> InputObjectTypeName -> Bool
Eq, Eq InputObjectTypeName
Eq InputObjectTypeName
-> (InputObjectTypeName -> InputObjectTypeName -> Ordering)
-> (InputObjectTypeName -> InputObjectTypeName -> Bool)
-> (InputObjectTypeName -> InputObjectTypeName -> Bool)
-> (InputObjectTypeName -> InputObjectTypeName -> Bool)
-> (InputObjectTypeName -> InputObjectTypeName -> Bool)
-> (InputObjectTypeName
    -> InputObjectTypeName -> InputObjectTypeName)
-> (InputObjectTypeName
    -> InputObjectTypeName -> InputObjectTypeName)
-> Ord InputObjectTypeName
InputObjectTypeName -> InputObjectTypeName -> Bool
InputObjectTypeName -> InputObjectTypeName -> Ordering
InputObjectTypeName -> InputObjectTypeName -> InputObjectTypeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputObjectTypeName -> InputObjectTypeName -> Ordering
compare :: InputObjectTypeName -> InputObjectTypeName -> Ordering
$c< :: InputObjectTypeName -> InputObjectTypeName -> Bool
< :: InputObjectTypeName -> InputObjectTypeName -> Bool
$c<= :: InputObjectTypeName -> InputObjectTypeName -> Bool
<= :: InputObjectTypeName -> InputObjectTypeName -> Bool
$c> :: InputObjectTypeName -> InputObjectTypeName -> Bool
> :: InputObjectTypeName -> InputObjectTypeName -> Bool
$c>= :: InputObjectTypeName -> InputObjectTypeName -> Bool
>= :: InputObjectTypeName -> InputObjectTypeName -> Bool
$cmax :: InputObjectTypeName -> InputObjectTypeName -> InputObjectTypeName
max :: InputObjectTypeName -> InputObjectTypeName -> InputObjectTypeName
$cmin :: InputObjectTypeName -> InputObjectTypeName -> InputObjectTypeName
min :: InputObjectTypeName -> InputObjectTypeName -> InputObjectTypeName
Ord, Eq InputObjectTypeName
Eq InputObjectTypeName
-> (Int -> InputObjectTypeName -> Int)
-> (InputObjectTypeName -> Int)
-> Hashable InputObjectTypeName
Int -> InputObjectTypeName -> Int
InputObjectTypeName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> InputObjectTypeName -> Int
hashWithSalt :: Int -> InputObjectTypeName -> Int
$chash :: InputObjectTypeName -> Int
hash :: InputObjectTypeName -> Int
Hashable, Value -> Parser [InputObjectTypeName]
Value -> Parser InputObjectTypeName
(Value -> Parser InputObjectTypeName)
-> (Value -> Parser [InputObjectTypeName])
-> FromJSON InputObjectTypeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser InputObjectTypeName
parseJSON :: Value -> Parser InputObjectTypeName
$cparseJSONList :: Value -> Parser [InputObjectTypeName]
parseJSONList :: Value -> Parser [InputObjectTypeName]
J.FromJSON, [InputObjectTypeName] -> Value
[InputObjectTypeName] -> Encoding
InputObjectTypeName -> Value
InputObjectTypeName -> Encoding
(InputObjectTypeName -> Value)
-> (InputObjectTypeName -> Encoding)
-> ([InputObjectTypeName] -> Value)
-> ([InputObjectTypeName] -> Encoding)
-> ToJSON InputObjectTypeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: InputObjectTypeName -> Value
toJSON :: InputObjectTypeName -> Value
$ctoEncoding :: InputObjectTypeName -> Encoding
toEncoding :: InputObjectTypeName -> Encoding
$ctoJSONList :: [InputObjectTypeName] -> Value
toJSONList :: [InputObjectTypeName] -> Value
$ctoEncodingList :: [InputObjectTypeName] -> Encoding
toEncodingList :: [InputObjectTypeName] -> Encoding
J.ToJSON, InputObjectTypeName -> Text
(InputObjectTypeName -> Text) -> ToTxt InputObjectTypeName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: InputObjectTypeName -> Text
toTxt :: InputObjectTypeName -> Text
ToTxt, (forall x. InputObjectTypeName -> Rep InputObjectTypeName x)
-> (forall x. Rep InputObjectTypeName x -> InputObjectTypeName)
-> Generic InputObjectTypeName
forall x. Rep InputObjectTypeName x -> InputObjectTypeName
forall x. InputObjectTypeName -> Rep InputObjectTypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputObjectTypeName -> Rep InputObjectTypeName x
from :: forall x. InputObjectTypeName -> Rep InputObjectTypeName x
$cto :: forall x. Rep InputObjectTypeName x -> InputObjectTypeName
to :: forall x. Rep InputObjectTypeName x -> InputObjectTypeName
Generic, InputObjectTypeName -> ()
(InputObjectTypeName -> ()) -> NFData InputObjectTypeName
forall a. (a -> ()) -> NFData a
$crnf :: InputObjectTypeName -> ()
rnf :: InputObjectTypeName -> ()
NFData)

instance HasCodec InputObjectTypeName where
  codec :: JSONCodec InputObjectTypeName
codec = (Name -> InputObjectTypeName)
-> (InputObjectTypeName -> Name)
-> Codec Value Name Name
-> JSONCodec InputObjectTypeName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> InputObjectTypeName
InputObjectTypeName InputObjectTypeName -> Name
unInputObjectTypeName Codec Value Name Name
forall value. HasCodec value => JSONCodec value
codec

data InputObjectFieldDefinition = InputObjectFieldDefinition
  { InputObjectFieldDefinition -> InputObjectFieldName
_iofdName :: InputObjectFieldName,
    InputObjectFieldDefinition -> Maybe Description
_iofdDescription :: Maybe G.Description,
    InputObjectFieldDefinition -> GraphQLType
_iofdType :: GraphQLType
    -- TODO: support default values
  }
  deriving (Int -> InputObjectFieldDefinition -> ShowS
[InputObjectFieldDefinition] -> ShowS
InputObjectFieldDefinition -> String
(Int -> InputObjectFieldDefinition -> ShowS)
-> (InputObjectFieldDefinition -> String)
-> ([InputObjectFieldDefinition] -> ShowS)
-> Show InputObjectFieldDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectFieldDefinition -> ShowS
showsPrec :: Int -> InputObjectFieldDefinition -> ShowS
$cshow :: InputObjectFieldDefinition -> String
show :: InputObjectFieldDefinition -> String
$cshowList :: [InputObjectFieldDefinition] -> ShowS
showList :: [InputObjectFieldDefinition] -> ShowS
Show, InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
(InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Bool)
-> Eq InputObjectFieldDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
== :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
$c/= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
/= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
Eq, Eq InputObjectFieldDefinition
Eq InputObjectFieldDefinition
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Ordering)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Bool)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Bool)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Bool)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> Bool)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> InputObjectFieldDefinition)
-> (InputObjectFieldDefinition
    -> InputObjectFieldDefinition -> InputObjectFieldDefinition)
-> Ord InputObjectFieldDefinition
InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
InputObjectFieldDefinition
-> InputObjectFieldDefinition -> Ordering
InputObjectFieldDefinition
-> InputObjectFieldDefinition -> InputObjectFieldDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> Ordering
compare :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> Ordering
$c< :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
< :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
$c<= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
<= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
$c> :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
> :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
$c>= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
>= :: InputObjectFieldDefinition -> InputObjectFieldDefinition -> Bool
$cmax :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> InputObjectFieldDefinition
max :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> InputObjectFieldDefinition
$cmin :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> InputObjectFieldDefinition
min :: InputObjectFieldDefinition
-> InputObjectFieldDefinition -> InputObjectFieldDefinition
Ord, (forall x.
 InputObjectFieldDefinition -> Rep InputObjectFieldDefinition x)
-> (forall x.
    Rep InputObjectFieldDefinition x -> InputObjectFieldDefinition)
-> Generic InputObjectFieldDefinition
forall x.
Rep InputObjectFieldDefinition x -> InputObjectFieldDefinition
forall x.
InputObjectFieldDefinition -> Rep InputObjectFieldDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
InputObjectFieldDefinition -> Rep InputObjectFieldDefinition x
from :: forall x.
InputObjectFieldDefinition -> Rep InputObjectFieldDefinition x
$cto :: forall x.
Rep InputObjectFieldDefinition x -> InputObjectFieldDefinition
to :: forall x.
Rep InputObjectFieldDefinition x -> InputObjectFieldDefinition
Generic)

instance NFData InputObjectFieldDefinition

instance HasCodec InputObjectFieldDefinition where
  codec :: JSONCodec InputObjectFieldDefinition
codec =
    Text
-> ObjectCodec
     InputObjectFieldDefinition InputObjectFieldDefinition
-> JSONCodec InputObjectFieldDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"InputObjectFieldDefinition"
      (ObjectCodec InputObjectFieldDefinition InputObjectFieldDefinition
 -> JSONCodec InputObjectFieldDefinition)
-> ObjectCodec
     InputObjectFieldDefinition InputObjectFieldDefinition
-> JSONCodec InputObjectFieldDefinition
forall a b. (a -> b) -> a -> b
$ InputObjectFieldName
-> Maybe Description -> GraphQLType -> InputObjectFieldDefinition
InputObjectFieldDefinition
      (InputObjectFieldName
 -> Maybe Description -> GraphQLType -> InputObjectFieldDefinition)
-> Codec Object InputObjectFieldDefinition InputObjectFieldName
-> Codec
     Object
     InputObjectFieldDefinition
     (Maybe Description -> GraphQLType -> InputObjectFieldDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec InputObjectFieldName InputObjectFieldName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec InputObjectFieldName InputObjectFieldName
-> (InputObjectFieldDefinition -> InputObjectFieldName)
-> Codec Object InputObjectFieldDefinition InputObjectFieldName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectFieldDefinition -> InputObjectFieldName
_iofdName
        Codec
  Object
  InputObjectFieldDefinition
  (Maybe Description -> GraphQLType -> InputObjectFieldDefinition)
-> Codec Object InputObjectFieldDefinition (Maybe Description)
-> Codec
     Object
     InputObjectFieldDefinition
     (GraphQLType -> InputObjectFieldDefinition)
forall a b.
Codec Object InputObjectFieldDefinition (a -> b)
-> Codec Object InputObjectFieldDefinition a
-> Codec Object InputObjectFieldDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (InputObjectFieldDefinition -> Maybe Description)
-> Codec Object InputObjectFieldDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectFieldDefinition -> Maybe Description
_iofdDescription
        Codec
  Object
  InputObjectFieldDefinition
  (GraphQLType -> InputObjectFieldDefinition)
-> Codec Object InputObjectFieldDefinition GraphQLType
-> ObjectCodec
     InputObjectFieldDefinition InputObjectFieldDefinition
forall a b.
Codec Object InputObjectFieldDefinition (a -> b)
-> Codec Object InputObjectFieldDefinition a
-> Codec Object InputObjectFieldDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec GraphQLType GraphQLType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
      ObjectCodec GraphQLType GraphQLType
-> (InputObjectFieldDefinition -> GraphQLType)
-> Codec Object InputObjectFieldDefinition GraphQLType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= InputObjectFieldDefinition -> GraphQLType
_iofdType

newtype InputObjectFieldName = InputObjectFieldName {InputObjectFieldName -> Name
unInputObjectFieldName :: G.Name}
  deriving (Int -> InputObjectFieldName -> ShowS
[InputObjectFieldName] -> ShowS
InputObjectFieldName -> String
(Int -> InputObjectFieldName -> ShowS)
-> (InputObjectFieldName -> String)
-> ([InputObjectFieldName] -> ShowS)
-> Show InputObjectFieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputObjectFieldName -> ShowS
showsPrec :: Int -> InputObjectFieldName -> ShowS
$cshow :: InputObjectFieldName -> String
show :: InputObjectFieldName -> String
$cshowList :: [InputObjectFieldName] -> ShowS
showList :: [InputObjectFieldName] -> ShowS
Show, InputObjectFieldName -> InputObjectFieldName -> Bool
(InputObjectFieldName -> InputObjectFieldName -> Bool)
-> (InputObjectFieldName -> InputObjectFieldName -> Bool)
-> Eq InputObjectFieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputObjectFieldName -> InputObjectFieldName -> Bool
== :: InputObjectFieldName -> InputObjectFieldName -> Bool
$c/= :: InputObjectFieldName -> InputObjectFieldName -> Bool
/= :: InputObjectFieldName -> InputObjectFieldName -> Bool
Eq, Eq InputObjectFieldName
Eq InputObjectFieldName
-> (InputObjectFieldName -> InputObjectFieldName -> Ordering)
-> (InputObjectFieldName -> InputObjectFieldName -> Bool)
-> (InputObjectFieldName -> InputObjectFieldName -> Bool)
-> (InputObjectFieldName -> InputObjectFieldName -> Bool)
-> (InputObjectFieldName -> InputObjectFieldName -> Bool)
-> (InputObjectFieldName
    -> InputObjectFieldName -> InputObjectFieldName)
-> (InputObjectFieldName
    -> InputObjectFieldName -> InputObjectFieldName)
-> Ord InputObjectFieldName
InputObjectFieldName -> InputObjectFieldName -> Bool
InputObjectFieldName -> InputObjectFieldName -> Ordering
InputObjectFieldName
-> InputObjectFieldName -> InputObjectFieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: InputObjectFieldName -> InputObjectFieldName -> Ordering
compare :: InputObjectFieldName -> InputObjectFieldName -> Ordering
$c< :: InputObjectFieldName -> InputObjectFieldName -> Bool
< :: InputObjectFieldName -> InputObjectFieldName -> Bool
$c<= :: InputObjectFieldName -> InputObjectFieldName -> Bool
<= :: InputObjectFieldName -> InputObjectFieldName -> Bool
$c> :: InputObjectFieldName -> InputObjectFieldName -> Bool
> :: InputObjectFieldName -> InputObjectFieldName -> Bool
$c>= :: InputObjectFieldName -> InputObjectFieldName -> Bool
>= :: InputObjectFieldName -> InputObjectFieldName -> Bool
$cmax :: InputObjectFieldName
-> InputObjectFieldName -> InputObjectFieldName
max :: InputObjectFieldName
-> InputObjectFieldName -> InputObjectFieldName
$cmin :: InputObjectFieldName
-> InputObjectFieldName -> InputObjectFieldName
min :: InputObjectFieldName
-> InputObjectFieldName -> InputObjectFieldName
Ord, Eq InputObjectFieldName
Eq InputObjectFieldName
-> (Int -> InputObjectFieldName -> Int)
-> (InputObjectFieldName -> Int)
-> Hashable InputObjectFieldName
Int -> InputObjectFieldName -> Int
InputObjectFieldName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> InputObjectFieldName -> Int
hashWithSalt :: Int -> InputObjectFieldName -> Int
$chash :: InputObjectFieldName -> Int
hash :: InputObjectFieldName -> Int
Hashable, Value -> Parser [InputObjectFieldName]
Value -> Parser InputObjectFieldName
(Value -> Parser InputObjectFieldName)
-> (Value -> Parser [InputObjectFieldName])
-> FromJSON InputObjectFieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser InputObjectFieldName
parseJSON :: Value -> Parser InputObjectFieldName
$cparseJSONList :: Value -> Parser [InputObjectFieldName]
parseJSONList :: Value -> Parser [InputObjectFieldName]
J.FromJSON, [InputObjectFieldName] -> Value
[InputObjectFieldName] -> Encoding
InputObjectFieldName -> Value
InputObjectFieldName -> Encoding
(InputObjectFieldName -> Value)
-> (InputObjectFieldName -> Encoding)
-> ([InputObjectFieldName] -> Value)
-> ([InputObjectFieldName] -> Encoding)
-> ToJSON InputObjectFieldName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: InputObjectFieldName -> Value
toJSON :: InputObjectFieldName -> Value
$ctoEncoding :: InputObjectFieldName -> Encoding
toEncoding :: InputObjectFieldName -> Encoding
$ctoJSONList :: [InputObjectFieldName] -> Value
toJSONList :: [InputObjectFieldName] -> Value
$ctoEncodingList :: [InputObjectFieldName] -> Encoding
toEncodingList :: [InputObjectFieldName] -> Encoding
J.ToJSON, InputObjectFieldName -> Text
(InputObjectFieldName -> Text) -> ToTxt InputObjectFieldName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: InputObjectFieldName -> Text
toTxt :: InputObjectFieldName -> Text
ToTxt, (forall x. InputObjectFieldName -> Rep InputObjectFieldName x)
-> (forall x. Rep InputObjectFieldName x -> InputObjectFieldName)
-> Generic InputObjectFieldName
forall x. Rep InputObjectFieldName x -> InputObjectFieldName
forall x. InputObjectFieldName -> Rep InputObjectFieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputObjectFieldName -> Rep InputObjectFieldName x
from :: forall x. InputObjectFieldName -> Rep InputObjectFieldName x
$cto :: forall x. Rep InputObjectFieldName x -> InputObjectFieldName
to :: forall x. Rep InputObjectFieldName x -> InputObjectFieldName
Generic, InputObjectFieldName -> ()
(InputObjectFieldName -> ()) -> NFData InputObjectFieldName
forall a. (a -> ()) -> NFData a
$crnf :: InputObjectFieldName -> ()
rnf :: InputObjectFieldName -> ()
NFData)

instance HasCodec InputObjectFieldName where
  codec :: JSONCodec InputObjectFieldName
codec = (Name -> InputObjectFieldName)
-> (InputObjectFieldName -> Name)
-> Codec Value Name Name
-> JSONCodec InputObjectFieldName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> InputObjectFieldName
InputObjectFieldName InputObjectFieldName -> Name
unInputObjectFieldName Codec Value Name Name
forall value. HasCodec value => JSONCodec value
codec

--------------------------------------------------------------------------------
-- Custom objects

data ObjectTypeDefinition = ObjectTypeDefinition
  { ObjectTypeDefinition -> ObjectTypeName
_otdName :: ObjectTypeName,
    ObjectTypeDefinition -> Maybe Description
_otdDescription :: Maybe G.Description,
    ObjectTypeDefinition
-> NonEmpty (ObjectFieldDefinition GraphQLType)
_otdFields :: NonEmpty (ObjectFieldDefinition GraphQLType),
    ObjectTypeDefinition -> [TypeRelationshipDefinition]
_otdRelationships :: [TypeRelationshipDefinition]
  }
  deriving (Int -> ObjectTypeDefinition -> ShowS
[ObjectTypeDefinition] -> ShowS
ObjectTypeDefinition -> String
(Int -> ObjectTypeDefinition -> ShowS)
-> (ObjectTypeDefinition -> String)
-> ([ObjectTypeDefinition] -> ShowS)
-> Show ObjectTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectTypeDefinition -> ShowS
showsPrec :: Int -> ObjectTypeDefinition -> ShowS
$cshow :: ObjectTypeDefinition -> String
show :: ObjectTypeDefinition -> String
$cshowList :: [ObjectTypeDefinition] -> ShowS
showList :: [ObjectTypeDefinition] -> ShowS
Show, ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
(ObjectTypeDefinition -> ObjectTypeDefinition -> Bool)
-> (ObjectTypeDefinition -> ObjectTypeDefinition -> Bool)
-> Eq ObjectTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
== :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
$c/= :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
/= :: ObjectTypeDefinition -> ObjectTypeDefinition -> Bool
Eq, (forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x)
-> (forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition)
-> Generic ObjectTypeDefinition
forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
from :: forall x. ObjectTypeDefinition -> Rep ObjectTypeDefinition x
$cto :: forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
to :: forall x. Rep ObjectTypeDefinition x -> ObjectTypeDefinition
Generic)

instance NFData ObjectTypeDefinition

instance HasCodec ObjectTypeDefinition where
  codec :: JSONCodec ObjectTypeDefinition
codec =
    Text
-> ObjectCodec ObjectTypeDefinition ObjectTypeDefinition
-> JSONCodec ObjectTypeDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ObjectTypeDefinition"
      (ObjectCodec ObjectTypeDefinition ObjectTypeDefinition
 -> JSONCodec ObjectTypeDefinition)
-> ObjectCodec ObjectTypeDefinition ObjectTypeDefinition
-> JSONCodec ObjectTypeDefinition
forall a b. (a -> b) -> a -> b
$ ObjectTypeName
-> Maybe Description
-> NonEmpty (ObjectFieldDefinition GraphQLType)
-> [TypeRelationshipDefinition]
-> ObjectTypeDefinition
ObjectTypeDefinition
      (ObjectTypeName
 -> Maybe Description
 -> NonEmpty (ObjectFieldDefinition GraphQLType)
 -> [TypeRelationshipDefinition]
 -> ObjectTypeDefinition)
-> Codec Object ObjectTypeDefinition ObjectTypeName
-> Codec
     Object
     ObjectTypeDefinition
     (Maybe Description
      -> NonEmpty (ObjectFieldDefinition GraphQLType)
      -> [TypeRelationshipDefinition]
      -> ObjectTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec ObjectTypeName ObjectTypeName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec ObjectTypeName ObjectTypeName
-> (ObjectTypeDefinition -> ObjectTypeName)
-> Codec Object ObjectTypeDefinition ObjectTypeName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectTypeDefinition -> ObjectTypeName
_otdName
        Codec
  Object
  ObjectTypeDefinition
  (Maybe Description
   -> NonEmpty (ObjectFieldDefinition GraphQLType)
   -> [TypeRelationshipDefinition]
   -> ObjectTypeDefinition)
-> Codec Object ObjectTypeDefinition (Maybe Description)
-> Codec
     Object
     ObjectTypeDefinition
     (NonEmpty (ObjectFieldDefinition GraphQLType)
      -> [TypeRelationshipDefinition] -> ObjectTypeDefinition)
forall a b.
Codec Object ObjectTypeDefinition (a -> b)
-> Codec Object ObjectTypeDefinition a
-> Codec Object ObjectTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (ObjectTypeDefinition -> Maybe Description)
-> Codec Object ObjectTypeDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectTypeDefinition -> Maybe Description
_otdDescription
        Codec
  Object
  ObjectTypeDefinition
  (NonEmpty (ObjectFieldDefinition GraphQLType)
   -> [TypeRelationshipDefinition] -> ObjectTypeDefinition)
-> Codec
     Object
     ObjectTypeDefinition
     (NonEmpty (ObjectFieldDefinition GraphQLType))
-> Codec
     Object
     ObjectTypeDefinition
     ([TypeRelationshipDefinition] -> ObjectTypeDefinition)
forall a b.
Codec Object ObjectTypeDefinition (a -> b)
-> Codec Object ObjectTypeDefinition a
-> Codec Object ObjectTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (NonEmpty (ObjectFieldDefinition GraphQLType))
     (NonEmpty (ObjectFieldDefinition GraphQLType))
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"fields"
      ObjectCodec
  (NonEmpty (ObjectFieldDefinition GraphQLType))
  (NonEmpty (ObjectFieldDefinition GraphQLType))
-> (ObjectTypeDefinition
    -> NonEmpty (ObjectFieldDefinition GraphQLType))
-> Codec
     Object
     ObjectTypeDefinition
     (NonEmpty (ObjectFieldDefinition GraphQLType))
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectTypeDefinition
-> NonEmpty (ObjectFieldDefinition GraphQLType)
_otdFields
        Codec
  Object
  ObjectTypeDefinition
  ([TypeRelationshipDefinition] -> ObjectTypeDefinition)
-> Codec Object ObjectTypeDefinition [TypeRelationshipDefinition]
-> ObjectCodec ObjectTypeDefinition ObjectTypeDefinition
forall a b.
Codec Object ObjectTypeDefinition (a -> b)
-> Codec Object ObjectTypeDefinition a
-> Codec Object ObjectTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> [TypeRelationshipDefinition]
-> ObjectCodec
     [TypeRelationshipDefinition] [TypeRelationshipDefinition]
forall output.
(Eq output, HasCodec output) =>
Text -> output -> ObjectCodec output output
optionalFieldWithOmittedDefault' Text
"relationships" []
      ObjectCodec
  [TypeRelationshipDefinition] [TypeRelationshipDefinition]
-> (ObjectTypeDefinition -> [TypeRelationshipDefinition])
-> Codec Object ObjectTypeDefinition [TypeRelationshipDefinition]
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectTypeDefinition -> [TypeRelationshipDefinition]
_otdRelationships

newtype ObjectTypeName = ObjectTypeName {ObjectTypeName -> Name
unObjectTypeName :: G.Name}
  deriving (Int -> ObjectTypeName -> ShowS
[ObjectTypeName] -> ShowS
ObjectTypeName -> String
(Int -> ObjectTypeName -> ShowS)
-> (ObjectTypeName -> String)
-> ([ObjectTypeName] -> ShowS)
-> Show ObjectTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectTypeName -> ShowS
showsPrec :: Int -> ObjectTypeName -> ShowS
$cshow :: ObjectTypeName -> String
show :: ObjectTypeName -> String
$cshowList :: [ObjectTypeName] -> ShowS
showList :: [ObjectTypeName] -> ShowS
Show, ObjectTypeName -> ObjectTypeName -> Bool
(ObjectTypeName -> ObjectTypeName -> Bool)
-> (ObjectTypeName -> ObjectTypeName -> Bool) -> Eq ObjectTypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectTypeName -> ObjectTypeName -> Bool
== :: ObjectTypeName -> ObjectTypeName -> Bool
$c/= :: ObjectTypeName -> ObjectTypeName -> Bool
/= :: ObjectTypeName -> ObjectTypeName -> Bool
Eq, Eq ObjectTypeName
Eq ObjectTypeName
-> (ObjectTypeName -> ObjectTypeName -> Ordering)
-> (ObjectTypeName -> ObjectTypeName -> Bool)
-> (ObjectTypeName -> ObjectTypeName -> Bool)
-> (ObjectTypeName -> ObjectTypeName -> Bool)
-> (ObjectTypeName -> ObjectTypeName -> Bool)
-> (ObjectTypeName -> ObjectTypeName -> ObjectTypeName)
-> (ObjectTypeName -> ObjectTypeName -> ObjectTypeName)
-> Ord ObjectTypeName
ObjectTypeName -> ObjectTypeName -> Bool
ObjectTypeName -> ObjectTypeName -> Ordering
ObjectTypeName -> ObjectTypeName -> ObjectTypeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectTypeName -> ObjectTypeName -> Ordering
compare :: ObjectTypeName -> ObjectTypeName -> Ordering
$c< :: ObjectTypeName -> ObjectTypeName -> Bool
< :: ObjectTypeName -> ObjectTypeName -> Bool
$c<= :: ObjectTypeName -> ObjectTypeName -> Bool
<= :: ObjectTypeName -> ObjectTypeName -> Bool
$c> :: ObjectTypeName -> ObjectTypeName -> Bool
> :: ObjectTypeName -> ObjectTypeName -> Bool
$c>= :: ObjectTypeName -> ObjectTypeName -> Bool
>= :: ObjectTypeName -> ObjectTypeName -> Bool
$cmax :: ObjectTypeName -> ObjectTypeName -> ObjectTypeName
max :: ObjectTypeName -> ObjectTypeName -> ObjectTypeName
$cmin :: ObjectTypeName -> ObjectTypeName -> ObjectTypeName
min :: ObjectTypeName -> ObjectTypeName -> ObjectTypeName
Ord, Eq ObjectTypeName
Eq ObjectTypeName
-> (Int -> ObjectTypeName -> Int)
-> (ObjectTypeName -> Int)
-> Hashable ObjectTypeName
Int -> ObjectTypeName -> Int
ObjectTypeName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ObjectTypeName -> Int
hashWithSalt :: Int -> ObjectTypeName -> Int
$chash :: ObjectTypeName -> Int
hash :: ObjectTypeName -> Int
Hashable, Value -> Parser [ObjectTypeName]
Value -> Parser ObjectTypeName
(Value -> Parser ObjectTypeName)
-> (Value -> Parser [ObjectTypeName]) -> FromJSON ObjectTypeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ObjectTypeName
parseJSON :: Value -> Parser ObjectTypeName
$cparseJSONList :: Value -> Parser [ObjectTypeName]
parseJSONList :: Value -> Parser [ObjectTypeName]
J.FromJSON, [ObjectTypeName] -> Value
[ObjectTypeName] -> Encoding
ObjectTypeName -> Value
ObjectTypeName -> Encoding
(ObjectTypeName -> Value)
-> (ObjectTypeName -> Encoding)
-> ([ObjectTypeName] -> Value)
-> ([ObjectTypeName] -> Encoding)
-> ToJSON ObjectTypeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ObjectTypeName -> Value
toJSON :: ObjectTypeName -> Value
$ctoEncoding :: ObjectTypeName -> Encoding
toEncoding :: ObjectTypeName -> Encoding
$ctoJSONList :: [ObjectTypeName] -> Value
toJSONList :: [ObjectTypeName] -> Value
$ctoEncodingList :: [ObjectTypeName] -> Encoding
toEncodingList :: [ObjectTypeName] -> Encoding
J.ToJSON, ObjectTypeName -> Text
(ObjectTypeName -> Text) -> ToTxt ObjectTypeName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ObjectTypeName -> Text
toTxt :: ObjectTypeName -> Text
ToTxt, (forall x. ObjectTypeName -> Rep ObjectTypeName x)
-> (forall x. Rep ObjectTypeName x -> ObjectTypeName)
-> Generic ObjectTypeName
forall x. Rep ObjectTypeName x -> ObjectTypeName
forall x. ObjectTypeName -> Rep ObjectTypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectTypeName -> Rep ObjectTypeName x
from :: forall x. ObjectTypeName -> Rep ObjectTypeName x
$cto :: forall x. Rep ObjectTypeName x -> ObjectTypeName
to :: forall x. Rep ObjectTypeName x -> ObjectTypeName
Generic, ObjectTypeName -> ()
(ObjectTypeName -> ()) -> NFData ObjectTypeName
forall a. (a -> ()) -> NFData a
$crnf :: ObjectTypeName -> ()
rnf :: ObjectTypeName -> ()
NFData)

instance HasCodec ObjectTypeName where
  codec :: JSONCodec ObjectTypeName
codec = (Name -> ObjectTypeName)
-> (ObjectTypeName -> Name)
-> Codec Value Name Name
-> JSONCodec ObjectTypeName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> ObjectTypeName
ObjectTypeName ObjectTypeName -> Name
unObjectTypeName Codec Value Name Name
forall value. HasCodec value => JSONCodec value
codec

data ObjectFieldDefinition field = ObjectFieldDefinition
  { forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName :: ObjectFieldName,
    -- we don't care about field arguments/directives
    -- as objectDefinitions types are only used as the return
    -- type of a webhook response and as such the extra
    -- context will be hard to pass to the webhook
    forall field. ObjectFieldDefinition field -> Maybe Value
_ofdArguments :: Maybe J.Value,
    forall field. ObjectFieldDefinition field -> Maybe Description
_ofdDescription :: Maybe G.Description,
    forall field. ObjectFieldDefinition field -> field
_ofdType :: field
  }
  deriving (Int -> ObjectFieldDefinition field -> ShowS
[ObjectFieldDefinition field] -> ShowS
ObjectFieldDefinition field -> String
(Int -> ObjectFieldDefinition field -> ShowS)
-> (ObjectFieldDefinition field -> String)
-> ([ObjectFieldDefinition field] -> ShowS)
-> Show (ObjectFieldDefinition field)
forall field.
Show field =>
Int -> ObjectFieldDefinition field -> ShowS
forall field. Show field => [ObjectFieldDefinition field] -> ShowS
forall field. Show field => ObjectFieldDefinition field -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall field.
Show field =>
Int -> ObjectFieldDefinition field -> ShowS
showsPrec :: Int -> ObjectFieldDefinition field -> ShowS
$cshow :: forall field. Show field => ObjectFieldDefinition field -> String
show :: ObjectFieldDefinition field -> String
$cshowList :: forall field. Show field => [ObjectFieldDefinition field] -> ShowS
showList :: [ObjectFieldDefinition field] -> ShowS
Show, ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
(ObjectFieldDefinition field
 -> ObjectFieldDefinition field -> Bool)
-> (ObjectFieldDefinition field
    -> ObjectFieldDefinition field -> Bool)
-> Eq (ObjectFieldDefinition field)
forall field.
Eq field =>
ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall field.
Eq field =>
ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
== :: ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
$c/= :: forall field.
Eq field =>
ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
/= :: ObjectFieldDefinition field -> ObjectFieldDefinition field -> Bool
Eq, (forall a b.
 (a -> b) -> ObjectFieldDefinition a -> ObjectFieldDefinition b)
-> (forall a b.
    a -> ObjectFieldDefinition b -> ObjectFieldDefinition a)
-> Functor ObjectFieldDefinition
forall a b. a -> ObjectFieldDefinition b -> ObjectFieldDefinition a
forall a b.
(a -> b) -> ObjectFieldDefinition a -> ObjectFieldDefinition b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b.
(a -> b) -> ObjectFieldDefinition a -> ObjectFieldDefinition b
fmap :: forall a b.
(a -> b) -> ObjectFieldDefinition a -> ObjectFieldDefinition b
$c<$ :: forall a b. a -> ObjectFieldDefinition b -> ObjectFieldDefinition a
<$ :: forall a b. a -> ObjectFieldDefinition b -> ObjectFieldDefinition a
Functor, (forall m. Monoid m => ObjectFieldDefinition m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ObjectFieldDefinition a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> ObjectFieldDefinition a -> m)
-> (forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b)
-> (forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b)
-> (forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b)
-> (forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b)
-> (forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a)
-> (forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a)
-> (forall a. ObjectFieldDefinition a -> [a])
-> (forall a. ObjectFieldDefinition a -> Bool)
-> (forall a. ObjectFieldDefinition a -> Int)
-> (forall a. Eq a => a -> ObjectFieldDefinition a -> Bool)
-> (forall a. Ord a => ObjectFieldDefinition a -> a)
-> (forall a. Ord a => ObjectFieldDefinition a -> a)
-> (forall a. Num a => ObjectFieldDefinition a -> a)
-> (forall a. Num a => ObjectFieldDefinition a -> a)
-> Foldable ObjectFieldDefinition
forall a. Eq a => a -> ObjectFieldDefinition a -> Bool
forall a. Num a => ObjectFieldDefinition a -> a
forall a. Ord a => ObjectFieldDefinition a -> a
forall m. Monoid m => ObjectFieldDefinition m -> m
forall a. ObjectFieldDefinition a -> Bool
forall a. ObjectFieldDefinition a -> Int
forall a. ObjectFieldDefinition a -> [a]
forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a
forall m a. Monoid m => (a -> m) -> ObjectFieldDefinition a -> m
forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b
forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => ObjectFieldDefinition m -> m
fold :: forall m. Monoid m => ObjectFieldDefinition m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ObjectFieldDefinition a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ObjectFieldDefinition a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ObjectFieldDefinition a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ObjectFieldDefinition a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ObjectFieldDefinition a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ObjectFieldDefinition a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a
foldr1 :: forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a
foldl1 :: forall a. (a -> a -> a) -> ObjectFieldDefinition a -> a
$ctoList :: forall a. ObjectFieldDefinition a -> [a]
toList :: forall a. ObjectFieldDefinition a -> [a]
$cnull :: forall a. ObjectFieldDefinition a -> Bool
null :: forall a. ObjectFieldDefinition a -> Bool
$clength :: forall a. ObjectFieldDefinition a -> Int
length :: forall a. ObjectFieldDefinition a -> Int
$celem :: forall a. Eq a => a -> ObjectFieldDefinition a -> Bool
elem :: forall a. Eq a => a -> ObjectFieldDefinition a -> Bool
$cmaximum :: forall a. Ord a => ObjectFieldDefinition a -> a
maximum :: forall a. Ord a => ObjectFieldDefinition a -> a
$cminimum :: forall a. Ord a => ObjectFieldDefinition a -> a
minimum :: forall a. Ord a => ObjectFieldDefinition a -> a
$csum :: forall a. Num a => ObjectFieldDefinition a -> a
sum :: forall a. Num a => ObjectFieldDefinition a -> a
$cproduct :: forall a. Num a => ObjectFieldDefinition a -> a
product :: forall a. Num a => ObjectFieldDefinition a -> a
Foldable, Functor ObjectFieldDefinition
Foldable ObjectFieldDefinition
Functor ObjectFieldDefinition
-> Foldable ObjectFieldDefinition
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> ObjectFieldDefinition a -> f (ObjectFieldDefinition b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ObjectFieldDefinition (f a) -> f (ObjectFieldDefinition a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> ObjectFieldDefinition a -> m (ObjectFieldDefinition b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ObjectFieldDefinition (m a) -> m (ObjectFieldDefinition a))
-> Traversable ObjectFieldDefinition
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
ObjectFieldDefinition (m a) -> m (ObjectFieldDefinition a)
forall (f :: * -> *) a.
Applicative f =>
ObjectFieldDefinition (f a) -> f (ObjectFieldDefinition a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ObjectFieldDefinition a -> m (ObjectFieldDefinition b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ObjectFieldDefinition a -> f (ObjectFieldDefinition b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ObjectFieldDefinition a -> f (ObjectFieldDefinition b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> ObjectFieldDefinition a -> f (ObjectFieldDefinition b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ObjectFieldDefinition (f a) -> f (ObjectFieldDefinition a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ObjectFieldDefinition (f a) -> f (ObjectFieldDefinition a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ObjectFieldDefinition a -> m (ObjectFieldDefinition b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> ObjectFieldDefinition a -> m (ObjectFieldDefinition b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ObjectFieldDefinition (m a) -> m (ObjectFieldDefinition a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ObjectFieldDefinition (m a) -> m (ObjectFieldDefinition a)
Traversable, (forall x.
 ObjectFieldDefinition field -> Rep (ObjectFieldDefinition field) x)
-> (forall x.
    Rep (ObjectFieldDefinition field) x -> ObjectFieldDefinition field)
-> Generic (ObjectFieldDefinition field)
forall x.
Rep (ObjectFieldDefinition field) x -> ObjectFieldDefinition field
forall x.
ObjectFieldDefinition field -> Rep (ObjectFieldDefinition field) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall field x.
Rep (ObjectFieldDefinition field) x -> ObjectFieldDefinition field
forall field x.
ObjectFieldDefinition field -> Rep (ObjectFieldDefinition field) x
$cfrom :: forall field x.
ObjectFieldDefinition field -> Rep (ObjectFieldDefinition field) x
from :: forall x.
ObjectFieldDefinition field -> Rep (ObjectFieldDefinition field) x
$cto :: forall field x.
Rep (ObjectFieldDefinition field) x -> ObjectFieldDefinition field
to :: forall x.
Rep (ObjectFieldDefinition field) x -> ObjectFieldDefinition field
Generic)

instance (NFData field) => NFData (ObjectFieldDefinition field)

instance (HasCodec field, Typeable field) => HasCodec (ObjectFieldDefinition field) where
  codec :: JSONCodec (ObjectFieldDefinition field)
codec =
    Text
-> ObjectCodec
     (ObjectFieldDefinition field) (ObjectFieldDefinition field)
-> JSONCodec (ObjectFieldDefinition field)
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object (Text
"ObjectFieldDefinition_" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> forall a. Typeable a => Text
forall {k} (a :: k). Typeable a => Text
typeableName @field)
      (ObjectCodec
   (ObjectFieldDefinition field) (ObjectFieldDefinition field)
 -> JSONCodec (ObjectFieldDefinition field))
-> ObjectCodec
     (ObjectFieldDefinition field) (ObjectFieldDefinition field)
-> JSONCodec (ObjectFieldDefinition field)
forall a b. (a -> b) -> a -> b
$ ObjectFieldName
-> Maybe Value
-> Maybe Description
-> field
-> ObjectFieldDefinition field
forall field.
ObjectFieldName
-> Maybe Value
-> Maybe Description
-> field
-> ObjectFieldDefinition field
ObjectFieldDefinition
      (ObjectFieldName
 -> Maybe Value
 -> Maybe Description
 -> field
 -> ObjectFieldDefinition field)
-> Codec Object (ObjectFieldDefinition field) ObjectFieldName
-> Codec
     Object
     (ObjectFieldDefinition field)
     (Maybe Value
      -> Maybe Description -> field -> ObjectFieldDefinition field)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec ObjectFieldName ObjectFieldName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec ObjectFieldName ObjectFieldName
-> (ObjectFieldDefinition field -> ObjectFieldName)
-> Codec Object (ObjectFieldDefinition field) ObjectFieldName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectFieldDefinition field -> ObjectFieldName
forall field. ObjectFieldDefinition field -> ObjectFieldName
_ofdName
        Codec
  Object
  (ObjectFieldDefinition field)
  (Maybe Value
   -> Maybe Description -> field -> ObjectFieldDefinition field)
-> Codec Object (ObjectFieldDefinition field) (Maybe Value)
-> Codec
     Object
     (ObjectFieldDefinition field)
     (Maybe Description -> field -> ObjectFieldDefinition field)
forall a b.
Codec Object (ObjectFieldDefinition field) (a -> b)
-> Codec Object (ObjectFieldDefinition field) a
-> Codec Object (ObjectFieldDefinition field) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Value) (Maybe Value)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"arguments"
      ObjectCodec (Maybe Value) (Maybe Value)
-> (ObjectFieldDefinition field -> Maybe Value)
-> Codec Object (ObjectFieldDefinition field) (Maybe Value)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectFieldDefinition field -> Maybe Value
forall field. ObjectFieldDefinition field -> Maybe Value
_ofdArguments
        Codec
  Object
  (ObjectFieldDefinition field)
  (Maybe Description -> field -> ObjectFieldDefinition field)
-> Codec Object (ObjectFieldDefinition field) (Maybe Description)
-> Codec
     Object
     (ObjectFieldDefinition field)
     (field -> ObjectFieldDefinition field)
forall a b.
Codec Object (ObjectFieldDefinition field) (a -> b)
-> Codec Object (ObjectFieldDefinition field) a
-> Codec Object (ObjectFieldDefinition field) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (ObjectFieldDefinition field -> Maybe Description)
-> Codec Object (ObjectFieldDefinition field) (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectFieldDefinition field -> Maybe Description
forall field. ObjectFieldDefinition field -> Maybe Description
_ofdDescription
        Codec
  Object
  (ObjectFieldDefinition field)
  (field -> ObjectFieldDefinition field)
-> Codec Object (ObjectFieldDefinition field) field
-> ObjectCodec
     (ObjectFieldDefinition field) (ObjectFieldDefinition field)
forall a b.
Codec Object (ObjectFieldDefinition field) (a -> b)
-> Codec Object (ObjectFieldDefinition field) a
-> Codec Object (ObjectFieldDefinition field) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec field field
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
      ObjectCodec field field
-> (ObjectFieldDefinition field -> field)
-> Codec Object (ObjectFieldDefinition field) field
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ObjectFieldDefinition field -> field
forall field. ObjectFieldDefinition field -> field
_ofdType

newtype ObjectFieldName = ObjectFieldName {ObjectFieldName -> Name
unObjectFieldName :: G.Name}
  deriving (Int -> ObjectFieldName -> ShowS
[ObjectFieldName] -> ShowS
ObjectFieldName -> String
(Int -> ObjectFieldName -> ShowS)
-> (ObjectFieldName -> String)
-> ([ObjectFieldName] -> ShowS)
-> Show ObjectFieldName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ObjectFieldName -> ShowS
showsPrec :: Int -> ObjectFieldName -> ShowS
$cshow :: ObjectFieldName -> String
show :: ObjectFieldName -> String
$cshowList :: [ObjectFieldName] -> ShowS
showList :: [ObjectFieldName] -> ShowS
Show, ObjectFieldName -> ObjectFieldName -> Bool
(ObjectFieldName -> ObjectFieldName -> Bool)
-> (ObjectFieldName -> ObjectFieldName -> Bool)
-> Eq ObjectFieldName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ObjectFieldName -> ObjectFieldName -> Bool
== :: ObjectFieldName -> ObjectFieldName -> Bool
$c/= :: ObjectFieldName -> ObjectFieldName -> Bool
/= :: ObjectFieldName -> ObjectFieldName -> Bool
Eq, Eq ObjectFieldName
Eq ObjectFieldName
-> (ObjectFieldName -> ObjectFieldName -> Ordering)
-> (ObjectFieldName -> ObjectFieldName -> Bool)
-> (ObjectFieldName -> ObjectFieldName -> Bool)
-> (ObjectFieldName -> ObjectFieldName -> Bool)
-> (ObjectFieldName -> ObjectFieldName -> Bool)
-> (ObjectFieldName -> ObjectFieldName -> ObjectFieldName)
-> (ObjectFieldName -> ObjectFieldName -> ObjectFieldName)
-> Ord ObjectFieldName
ObjectFieldName -> ObjectFieldName -> Bool
ObjectFieldName -> ObjectFieldName -> Ordering
ObjectFieldName -> ObjectFieldName -> ObjectFieldName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ObjectFieldName -> ObjectFieldName -> Ordering
compare :: ObjectFieldName -> ObjectFieldName -> Ordering
$c< :: ObjectFieldName -> ObjectFieldName -> Bool
< :: ObjectFieldName -> ObjectFieldName -> Bool
$c<= :: ObjectFieldName -> ObjectFieldName -> Bool
<= :: ObjectFieldName -> ObjectFieldName -> Bool
$c> :: ObjectFieldName -> ObjectFieldName -> Bool
> :: ObjectFieldName -> ObjectFieldName -> Bool
$c>= :: ObjectFieldName -> ObjectFieldName -> Bool
>= :: ObjectFieldName -> ObjectFieldName -> Bool
$cmax :: ObjectFieldName -> ObjectFieldName -> ObjectFieldName
max :: ObjectFieldName -> ObjectFieldName -> ObjectFieldName
$cmin :: ObjectFieldName -> ObjectFieldName -> ObjectFieldName
min :: ObjectFieldName -> ObjectFieldName -> ObjectFieldName
Ord, Eq ObjectFieldName
Eq ObjectFieldName
-> (Int -> ObjectFieldName -> Int)
-> (ObjectFieldName -> Int)
-> Hashable ObjectFieldName
Int -> ObjectFieldName -> Int
ObjectFieldName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> ObjectFieldName -> Int
hashWithSalt :: Int -> ObjectFieldName -> Int
$chash :: ObjectFieldName -> Int
hash :: ObjectFieldName -> Int
Hashable, Value -> Parser [ObjectFieldName]
Value -> Parser ObjectFieldName
(Value -> Parser ObjectFieldName)
-> (Value -> Parser [ObjectFieldName]) -> FromJSON ObjectFieldName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser ObjectFieldName
parseJSON :: Value -> Parser ObjectFieldName
$cparseJSONList :: Value -> Parser [ObjectFieldName]
parseJSONList :: Value -> Parser [ObjectFieldName]
J.FromJSON, [ObjectFieldName] -> Value
[ObjectFieldName] -> Encoding
ObjectFieldName -> Value
ObjectFieldName -> Encoding
(ObjectFieldName -> Value)
-> (ObjectFieldName -> Encoding)
-> ([ObjectFieldName] -> Value)
-> ([ObjectFieldName] -> Encoding)
-> ToJSON ObjectFieldName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: ObjectFieldName -> Value
toJSON :: ObjectFieldName -> Value
$ctoEncoding :: ObjectFieldName -> Encoding
toEncoding :: ObjectFieldName -> Encoding
$ctoJSONList :: [ObjectFieldName] -> Value
toJSONList :: [ObjectFieldName] -> Value
$ctoEncodingList :: [ObjectFieldName] -> Encoding
toEncodingList :: [ObjectFieldName] -> Encoding
J.ToJSON, FromJSONKeyFunction [ObjectFieldName]
FromJSONKeyFunction ObjectFieldName
FromJSONKeyFunction ObjectFieldName
-> FromJSONKeyFunction [ObjectFieldName]
-> FromJSONKey ObjectFieldName
forall a.
FromJSONKeyFunction a -> FromJSONKeyFunction [a] -> FromJSONKey a
$cfromJSONKey :: FromJSONKeyFunction ObjectFieldName
fromJSONKey :: FromJSONKeyFunction ObjectFieldName
$cfromJSONKeyList :: FromJSONKeyFunction [ObjectFieldName]
fromJSONKeyList :: FromJSONKeyFunction [ObjectFieldName]
J.FromJSONKey, ToJSONKeyFunction [ObjectFieldName]
ToJSONKeyFunction ObjectFieldName
ToJSONKeyFunction ObjectFieldName
-> ToJSONKeyFunction [ObjectFieldName] -> ToJSONKey ObjectFieldName
forall a.
ToJSONKeyFunction a -> ToJSONKeyFunction [a] -> ToJSONKey a
$ctoJSONKey :: ToJSONKeyFunction ObjectFieldName
toJSONKey :: ToJSONKeyFunction ObjectFieldName
$ctoJSONKeyList :: ToJSONKeyFunction [ObjectFieldName]
toJSONKeyList :: ToJSONKeyFunction [ObjectFieldName]
J.ToJSONKey, ObjectFieldName -> Text
(ObjectFieldName -> Text) -> ToTxt ObjectFieldName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: ObjectFieldName -> Text
toTxt :: ObjectFieldName -> Text
ToTxt, (forall x. ObjectFieldName -> Rep ObjectFieldName x)
-> (forall x. Rep ObjectFieldName x -> ObjectFieldName)
-> Generic ObjectFieldName
forall x. Rep ObjectFieldName x -> ObjectFieldName
forall x. ObjectFieldName -> Rep ObjectFieldName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ObjectFieldName -> Rep ObjectFieldName x
from :: forall x. ObjectFieldName -> Rep ObjectFieldName x
$cto :: forall x. Rep ObjectFieldName x -> ObjectFieldName
to :: forall x. Rep ObjectFieldName x -> ObjectFieldName
Generic, ObjectFieldName -> ()
(ObjectFieldName -> ()) -> NFData ObjectFieldName
forall a. (a -> ()) -> NFData a
$crnf :: ObjectFieldName -> ()
rnf :: ObjectFieldName -> ()
NFData)

instance HasCodec ObjectFieldName where
  codec :: JSONCodec ObjectFieldName
codec = (Name -> ObjectFieldName)
-> (ObjectFieldName -> Name)
-> Codec Value Name Name
-> JSONCodec ObjectFieldName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> ObjectFieldName
ObjectFieldName ObjectFieldName -> Name
unObjectFieldName Codec Value Name Name
graphQLFieldNameCodec

--------------------------------------------------------------------------------
-- Custom scalars

data ScalarTypeDefinition = ScalarTypeDefinition
  { ScalarTypeDefinition -> Name
_stdName :: G.Name,
    ScalarTypeDefinition -> Maybe Description
_stdDescription :: Maybe G.Description
  }
  deriving (Int -> ScalarTypeDefinition -> ShowS
[ScalarTypeDefinition] -> ShowS
ScalarTypeDefinition -> String
(Int -> ScalarTypeDefinition -> ShowS)
-> (ScalarTypeDefinition -> String)
-> ([ScalarTypeDefinition] -> ShowS)
-> Show ScalarTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ScalarTypeDefinition -> ShowS
showsPrec :: Int -> ScalarTypeDefinition -> ShowS
$cshow :: ScalarTypeDefinition -> String
show :: ScalarTypeDefinition -> String
$cshowList :: [ScalarTypeDefinition] -> ShowS
showList :: [ScalarTypeDefinition] -> ShowS
Show, ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
(ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> Eq ScalarTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
== :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
/= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
Eq, Eq ScalarTypeDefinition
Eq ScalarTypeDefinition
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Ordering)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition -> ScalarTypeDefinition -> Bool)
-> (ScalarTypeDefinition
    -> ScalarTypeDefinition -> ScalarTypeDefinition)
-> (ScalarTypeDefinition
    -> ScalarTypeDefinition -> ScalarTypeDefinition)
-> Ord ScalarTypeDefinition
ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
ScalarTypeDefinition -> ScalarTypeDefinition -> Ordering
ScalarTypeDefinition
-> ScalarTypeDefinition -> ScalarTypeDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ScalarTypeDefinition -> ScalarTypeDefinition -> Ordering
compare :: ScalarTypeDefinition -> ScalarTypeDefinition -> Ordering
$c< :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
< :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c<= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
<= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c> :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
> :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$c>= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
>= :: ScalarTypeDefinition -> ScalarTypeDefinition -> Bool
$cmax :: ScalarTypeDefinition
-> ScalarTypeDefinition -> ScalarTypeDefinition
max :: ScalarTypeDefinition
-> ScalarTypeDefinition -> ScalarTypeDefinition
$cmin :: ScalarTypeDefinition
-> ScalarTypeDefinition -> ScalarTypeDefinition
min :: ScalarTypeDefinition
-> ScalarTypeDefinition -> ScalarTypeDefinition
Ord, (forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x)
-> (forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition)
-> Generic ScalarTypeDefinition
forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
from :: forall x. ScalarTypeDefinition -> Rep ScalarTypeDefinition x
$cto :: forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
to :: forall x. Rep ScalarTypeDefinition x -> ScalarTypeDefinition
Generic)

instance NFData ScalarTypeDefinition

instance HasCodec ScalarTypeDefinition where
  codec :: JSONCodec ScalarTypeDefinition
codec =
    Text
-> ObjectCodec ScalarTypeDefinition ScalarTypeDefinition
-> JSONCodec ScalarTypeDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"ScalarTypeDefinition"
      (ObjectCodec ScalarTypeDefinition ScalarTypeDefinition
 -> JSONCodec ScalarTypeDefinition)
-> ObjectCodec ScalarTypeDefinition ScalarTypeDefinition
-> JSONCodec ScalarTypeDefinition
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Description -> ScalarTypeDefinition
ScalarTypeDefinition
      (Name -> Maybe Description -> ScalarTypeDefinition)
-> Codec Object ScalarTypeDefinition Name
-> Codec
     Object
     ScalarTypeDefinition
     (Maybe Description -> ScalarTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec Name Name
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec Name Name
-> (ScalarTypeDefinition -> Name)
-> Codec Object ScalarTypeDefinition Name
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ScalarTypeDefinition -> Name
_stdName
        Codec
  Object
  ScalarTypeDefinition
  (Maybe Description -> ScalarTypeDefinition)
-> Codec Object ScalarTypeDefinition (Maybe Description)
-> ObjectCodec ScalarTypeDefinition ScalarTypeDefinition
forall a b.
Codec Object ScalarTypeDefinition (a -> b)
-> Codec Object ScalarTypeDefinition a
-> Codec Object ScalarTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (ScalarTypeDefinition -> Maybe Description)
-> Codec Object ScalarTypeDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= ScalarTypeDefinition -> Maybe Description
_stdDescription

defaultGraphQLScalars :: HashMap G.Name ScalarTypeDefinition
defaultGraphQLScalars :: HashMap Name ScalarTypeDefinition
defaultGraphQLScalars = [(Name, ScalarTypeDefinition)] -> HashMap Name ScalarTypeDefinition
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HashMap.fromList ([(Name, ScalarTypeDefinition)]
 -> HashMap Name ScalarTypeDefinition)
-> ([Name] -> [(Name, ScalarTypeDefinition)])
-> [Name]
-> HashMap Name ScalarTypeDefinition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> (Name, ScalarTypeDefinition))
-> [Name] -> [(Name, ScalarTypeDefinition)]
forall a b. (a -> b) -> [a] -> [b]
map (\Name
name -> (Name
name, Name -> Maybe Description -> ScalarTypeDefinition
ScalarTypeDefinition Name
name Maybe Description
forall a. Maybe a
Nothing)) ([Name] -> HashMap Name ScalarTypeDefinition)
-> [Name] -> HashMap Name ScalarTypeDefinition
forall a b. (a -> b) -> a -> b
$ HashSet Name -> [Name]
forall a. HashSet a -> [a]
Set.toList HashSet Name
GName.builtInScalars

--------------------------------------------------------------------------------
-- Custom enums

data EnumTypeDefinition = EnumTypeDefinition
  { EnumTypeDefinition -> EnumTypeName
_etdName :: EnumTypeName,
    EnumTypeDefinition -> Maybe Description
_etdDescription :: Maybe G.Description,
    EnumTypeDefinition -> NonEmpty EnumValueDefinition
_etdValues :: NonEmpty EnumValueDefinition
  }
  deriving (Int -> EnumTypeDefinition -> ShowS
[EnumTypeDefinition] -> ShowS
EnumTypeDefinition -> String
(Int -> EnumTypeDefinition -> ShowS)
-> (EnumTypeDefinition -> String)
-> ([EnumTypeDefinition] -> ShowS)
-> Show EnumTypeDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumTypeDefinition -> ShowS
showsPrec :: Int -> EnumTypeDefinition -> ShowS
$cshow :: EnumTypeDefinition -> String
show :: EnumTypeDefinition -> String
$cshowList :: [EnumTypeDefinition] -> ShowS
showList :: [EnumTypeDefinition] -> ShowS
Show, EnumTypeDefinition -> EnumTypeDefinition -> Bool
(EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> Eq EnumTypeDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
== :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$c/= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
/= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
Eq, Eq EnumTypeDefinition
Eq EnumTypeDefinition
-> (EnumTypeDefinition -> EnumTypeDefinition -> Ordering)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> Bool)
-> (EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition)
-> (EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition)
-> Ord EnumTypeDefinition
EnumTypeDefinition -> EnumTypeDefinition -> Bool
EnumTypeDefinition -> EnumTypeDefinition -> Ordering
EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EnumTypeDefinition -> EnumTypeDefinition -> Ordering
compare :: EnumTypeDefinition -> EnumTypeDefinition -> Ordering
$c< :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
< :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$c<= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
<= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$c> :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
> :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$c>= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
>= :: EnumTypeDefinition -> EnumTypeDefinition -> Bool
$cmax :: EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition
max :: EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition
$cmin :: EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition
min :: EnumTypeDefinition -> EnumTypeDefinition -> EnumTypeDefinition
Ord, (forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x)
-> (forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition)
-> Generic EnumTypeDefinition
forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
from :: forall x. EnumTypeDefinition -> Rep EnumTypeDefinition x
$cto :: forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
to :: forall x. Rep EnumTypeDefinition x -> EnumTypeDefinition
Generic)

instance NFData EnumTypeDefinition

instance HasCodec EnumTypeDefinition where
  codec :: JSONCodec EnumTypeDefinition
codec =
    Text
-> ObjectCodec EnumTypeDefinition EnumTypeDefinition
-> JSONCodec EnumTypeDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"EnumTypeDefinition"
      (ObjectCodec EnumTypeDefinition EnumTypeDefinition
 -> JSONCodec EnumTypeDefinition)
-> ObjectCodec EnumTypeDefinition EnumTypeDefinition
-> JSONCodec EnumTypeDefinition
forall a b. (a -> b) -> a -> b
$ EnumTypeName
-> Maybe Description
-> NonEmpty EnumValueDefinition
-> EnumTypeDefinition
EnumTypeDefinition
      (EnumTypeName
 -> Maybe Description
 -> NonEmpty EnumValueDefinition
 -> EnumTypeDefinition)
-> Codec Object EnumTypeDefinition EnumTypeName
-> Codec
     Object
     EnumTypeDefinition
     (Maybe Description
      -> NonEmpty EnumValueDefinition -> EnumTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec EnumTypeName EnumTypeName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec EnumTypeName EnumTypeName
-> (EnumTypeDefinition -> EnumTypeName)
-> Codec Object EnumTypeDefinition EnumTypeName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumTypeDefinition -> EnumTypeName
_etdName
        Codec
  Object
  EnumTypeDefinition
  (Maybe Description
   -> NonEmpty EnumValueDefinition -> EnumTypeDefinition)
-> Codec Object EnumTypeDefinition (Maybe Description)
-> Codec
     Object
     EnumTypeDefinition
     (NonEmpty EnumValueDefinition -> EnumTypeDefinition)
forall a b.
Codec Object EnumTypeDefinition (a -> b)
-> Codec Object EnumTypeDefinition a
-> Codec Object EnumTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (EnumTypeDefinition -> Maybe Description)
-> Codec Object EnumTypeDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumTypeDefinition -> Maybe Description
_etdDescription
        Codec
  Object
  EnumTypeDefinition
  (NonEmpty EnumValueDefinition -> EnumTypeDefinition)
-> Codec Object EnumTypeDefinition (NonEmpty EnumValueDefinition)
-> ObjectCodec EnumTypeDefinition EnumTypeDefinition
forall a b.
Codec Object EnumTypeDefinition (a -> b)
-> Codec Object EnumTypeDefinition a
-> Codec Object EnumTypeDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (NonEmpty EnumValueDefinition) (NonEmpty EnumValueDefinition)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"values"
      ObjectCodec
  (NonEmpty EnumValueDefinition) (NonEmpty EnumValueDefinition)
-> (EnumTypeDefinition -> NonEmpty EnumValueDefinition)
-> Codec Object EnumTypeDefinition (NonEmpty EnumValueDefinition)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumTypeDefinition -> NonEmpty EnumValueDefinition
_etdValues

newtype EnumTypeName = EnumTypeName {EnumTypeName -> Name
unEnumTypeName :: G.Name}
  deriving (Int -> EnumTypeName -> ShowS
[EnumTypeName] -> ShowS
EnumTypeName -> String
(Int -> EnumTypeName -> ShowS)
-> (EnumTypeName -> String)
-> ([EnumTypeName] -> ShowS)
-> Show EnumTypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumTypeName -> ShowS
showsPrec :: Int -> EnumTypeName -> ShowS
$cshow :: EnumTypeName -> String
show :: EnumTypeName -> String
$cshowList :: [EnumTypeName] -> ShowS
showList :: [EnumTypeName] -> ShowS
Show, EnumTypeName -> EnumTypeName -> Bool
(EnumTypeName -> EnumTypeName -> Bool)
-> (EnumTypeName -> EnumTypeName -> Bool) -> Eq EnumTypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumTypeName -> EnumTypeName -> Bool
== :: EnumTypeName -> EnumTypeName -> Bool
$c/= :: EnumTypeName -> EnumTypeName -> Bool
/= :: EnumTypeName -> EnumTypeName -> Bool
Eq, Eq EnumTypeName
Eq EnumTypeName
-> (EnumTypeName -> EnumTypeName -> Ordering)
-> (EnumTypeName -> EnumTypeName -> Bool)
-> (EnumTypeName -> EnumTypeName -> Bool)
-> (EnumTypeName -> EnumTypeName -> Bool)
-> (EnumTypeName -> EnumTypeName -> Bool)
-> (EnumTypeName -> EnumTypeName -> EnumTypeName)
-> (EnumTypeName -> EnumTypeName -> EnumTypeName)
-> Ord EnumTypeName
EnumTypeName -> EnumTypeName -> Bool
EnumTypeName -> EnumTypeName -> Ordering
EnumTypeName -> EnumTypeName -> EnumTypeName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EnumTypeName -> EnumTypeName -> Ordering
compare :: EnumTypeName -> EnumTypeName -> Ordering
$c< :: EnumTypeName -> EnumTypeName -> Bool
< :: EnumTypeName -> EnumTypeName -> Bool
$c<= :: EnumTypeName -> EnumTypeName -> Bool
<= :: EnumTypeName -> EnumTypeName -> Bool
$c> :: EnumTypeName -> EnumTypeName -> Bool
> :: EnumTypeName -> EnumTypeName -> Bool
$c>= :: EnumTypeName -> EnumTypeName -> Bool
>= :: EnumTypeName -> EnumTypeName -> Bool
$cmax :: EnumTypeName -> EnumTypeName -> EnumTypeName
max :: EnumTypeName -> EnumTypeName -> EnumTypeName
$cmin :: EnumTypeName -> EnumTypeName -> EnumTypeName
min :: EnumTypeName -> EnumTypeName -> EnumTypeName
Ord, Eq EnumTypeName
Eq EnumTypeName
-> (Int -> EnumTypeName -> Int)
-> (EnumTypeName -> Int)
-> Hashable EnumTypeName
Int -> EnumTypeName -> Int
EnumTypeName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> EnumTypeName -> Int
hashWithSalt :: Int -> EnumTypeName -> Int
$chash :: EnumTypeName -> Int
hash :: EnumTypeName -> Int
Hashable, Value -> Parser [EnumTypeName]
Value -> Parser EnumTypeName
(Value -> Parser EnumTypeName)
-> (Value -> Parser [EnumTypeName]) -> FromJSON EnumTypeName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser EnumTypeName
parseJSON :: Value -> Parser EnumTypeName
$cparseJSONList :: Value -> Parser [EnumTypeName]
parseJSONList :: Value -> Parser [EnumTypeName]
J.FromJSON, [EnumTypeName] -> Value
[EnumTypeName] -> Encoding
EnumTypeName -> Value
EnumTypeName -> Encoding
(EnumTypeName -> Value)
-> (EnumTypeName -> Encoding)
-> ([EnumTypeName] -> Value)
-> ([EnumTypeName] -> Encoding)
-> ToJSON EnumTypeName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: EnumTypeName -> Value
toJSON :: EnumTypeName -> Value
$ctoEncoding :: EnumTypeName -> Encoding
toEncoding :: EnumTypeName -> Encoding
$ctoJSONList :: [EnumTypeName] -> Value
toJSONList :: [EnumTypeName] -> Value
$ctoEncodingList :: [EnumTypeName] -> Encoding
toEncodingList :: [EnumTypeName] -> Encoding
J.ToJSON, EnumTypeName -> Text
(EnumTypeName -> Text) -> ToTxt EnumTypeName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: EnumTypeName -> Text
toTxt :: EnumTypeName -> Text
ToTxt, (forall x. EnumTypeName -> Rep EnumTypeName x)
-> (forall x. Rep EnumTypeName x -> EnumTypeName)
-> Generic EnumTypeName
forall x. Rep EnumTypeName x -> EnumTypeName
forall x. EnumTypeName -> Rep EnumTypeName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumTypeName -> Rep EnumTypeName x
from :: forall x. EnumTypeName -> Rep EnumTypeName x
$cto :: forall x. Rep EnumTypeName x -> EnumTypeName
to :: forall x. Rep EnumTypeName x -> EnumTypeName
Generic, EnumTypeName -> ()
(EnumTypeName -> ()) -> NFData EnumTypeName
forall a. (a -> ()) -> NFData a
$crnf :: EnumTypeName -> ()
rnf :: EnumTypeName -> ()
NFData)

instance HasCodec EnumTypeName where
  codec :: JSONCodec EnumTypeName
codec = (Name -> EnumTypeName)
-> (EnumTypeName -> Name)
-> Codec Value Name Name
-> JSONCodec EnumTypeName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> EnumTypeName
EnumTypeName EnumTypeName -> Name
unEnumTypeName Codec Value Name Name
graphQLFieldNameCodec

data EnumValueDefinition = EnumValueDefinition
  { EnumValueDefinition -> EnumValue
_evdValue :: G.EnumValue,
    EnumValueDefinition -> Maybe Description
_evdDescription :: Maybe G.Description,
    EnumValueDefinition -> Maybe Bool
_evdIsDeprecated :: Maybe Bool
  }
  deriving (Int -> EnumValueDefinition -> ShowS
[EnumValueDefinition] -> ShowS
EnumValueDefinition -> String
(Int -> EnumValueDefinition -> ShowS)
-> (EnumValueDefinition -> String)
-> ([EnumValueDefinition] -> ShowS)
-> Show EnumValueDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnumValueDefinition -> ShowS
showsPrec :: Int -> EnumValueDefinition -> ShowS
$cshow :: EnumValueDefinition -> String
show :: EnumValueDefinition -> String
$cshowList :: [EnumValueDefinition] -> ShowS
showList :: [EnumValueDefinition] -> ShowS
Show, EnumValueDefinition -> EnumValueDefinition -> Bool
(EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> Eq EnumValueDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EnumValueDefinition -> EnumValueDefinition -> Bool
== :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
/= :: EnumValueDefinition -> EnumValueDefinition -> Bool
Eq, Eq EnumValueDefinition
Eq EnumValueDefinition
-> (EnumValueDefinition -> EnumValueDefinition -> Ordering)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition -> EnumValueDefinition -> Bool)
-> (EnumValueDefinition
    -> EnumValueDefinition -> EnumValueDefinition)
-> (EnumValueDefinition
    -> EnumValueDefinition -> EnumValueDefinition)
-> Ord EnumValueDefinition
EnumValueDefinition -> EnumValueDefinition -> Bool
EnumValueDefinition -> EnumValueDefinition -> Ordering
EnumValueDefinition -> EnumValueDefinition -> EnumValueDefinition
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EnumValueDefinition -> EnumValueDefinition -> Ordering
compare :: EnumValueDefinition -> EnumValueDefinition -> Ordering
$c< :: EnumValueDefinition -> EnumValueDefinition -> Bool
< :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c<= :: EnumValueDefinition -> EnumValueDefinition -> Bool
<= :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c> :: EnumValueDefinition -> EnumValueDefinition -> Bool
> :: EnumValueDefinition -> EnumValueDefinition -> Bool
$c>= :: EnumValueDefinition -> EnumValueDefinition -> Bool
>= :: EnumValueDefinition -> EnumValueDefinition -> Bool
$cmax :: EnumValueDefinition -> EnumValueDefinition -> EnumValueDefinition
max :: EnumValueDefinition -> EnumValueDefinition -> EnumValueDefinition
$cmin :: EnumValueDefinition -> EnumValueDefinition -> EnumValueDefinition
min :: EnumValueDefinition -> EnumValueDefinition -> EnumValueDefinition
Ord, (forall x. EnumValueDefinition -> Rep EnumValueDefinition x)
-> (forall x. Rep EnumValueDefinition x -> EnumValueDefinition)
-> Generic EnumValueDefinition
forall x. Rep EnumValueDefinition x -> EnumValueDefinition
forall x. EnumValueDefinition -> Rep EnumValueDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. EnumValueDefinition -> Rep EnumValueDefinition x
from :: forall x. EnumValueDefinition -> Rep EnumValueDefinition x
$cto :: forall x. Rep EnumValueDefinition x -> EnumValueDefinition
to :: forall x. Rep EnumValueDefinition x -> EnumValueDefinition
Generic)

instance NFData EnumValueDefinition

instance HasCodec EnumValueDefinition where
  codec :: JSONCodec EnumValueDefinition
codec =
    Text
-> ObjectCodec EnumValueDefinition EnumValueDefinition
-> JSONCodec EnumValueDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"EnumValueDefinition"
      (ObjectCodec EnumValueDefinition EnumValueDefinition
 -> JSONCodec EnumValueDefinition)
-> ObjectCodec EnumValueDefinition EnumValueDefinition
-> JSONCodec EnumValueDefinition
forall a b. (a -> b) -> a -> b
$ EnumValue -> Maybe Description -> Maybe Bool -> EnumValueDefinition
EnumValueDefinition
      (EnumValue
 -> Maybe Description -> Maybe Bool -> EnumValueDefinition)
-> Codec Object EnumValueDefinition EnumValue
-> Codec
     Object
     EnumValueDefinition
     (Maybe Description -> Maybe Bool -> EnumValueDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> ValueCodec EnumValue EnumValue
-> ObjectCodec EnumValue EnumValue
forall input output.
Text -> ValueCodec input output -> ObjectCodec input output
requiredFieldWith' Text
"value" ValueCodec EnumValue EnumValue
graphQLEnumValueCodec
      ObjectCodec EnumValue EnumValue
-> (EnumValueDefinition -> EnumValue)
-> Codec Object EnumValueDefinition EnumValue
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumValueDefinition -> EnumValue
_evdValue
        Codec
  Object
  EnumValueDefinition
  (Maybe Description -> Maybe Bool -> EnumValueDefinition)
-> Codec Object EnumValueDefinition (Maybe Description)
-> Codec
     Object EnumValueDefinition (Maybe Bool -> EnumValueDefinition)
forall a b.
Codec Object EnumValueDefinition (a -> b)
-> Codec Object EnumValueDefinition a
-> Codec Object EnumValueDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ValueCodec Description Description
-> ObjectCodec (Maybe Description) (Maybe Description)
forall input output.
Text
-> ValueCodec input output
-> ObjectCodec (Maybe input) (Maybe output)
optionalFieldWith' Text
"description" ValueCodec Description Description
graphQLFieldDescriptionCodec
      ObjectCodec (Maybe Description) (Maybe Description)
-> (EnumValueDefinition -> Maybe Description)
-> Codec Object EnumValueDefinition (Maybe Description)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumValueDefinition -> Maybe Description
_evdDescription
        Codec
  Object EnumValueDefinition (Maybe Bool -> EnumValueDefinition)
-> Codec Object EnumValueDefinition (Maybe Bool)
-> ObjectCodec EnumValueDefinition EnumValueDefinition
forall a b.
Codec Object EnumValueDefinition (a -> b)
-> Codec Object EnumValueDefinition a
-> Codec Object EnumValueDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec (Maybe Bool) (Maybe Bool)
forall output.
HasCodec output =>
Text -> ObjectCodec (Maybe output) (Maybe output)
optionalField' Text
"is_deprecated"
      ObjectCodec (Maybe Bool) (Maybe Bool)
-> (EnumValueDefinition -> Maybe Bool)
-> Codec Object EnumValueDefinition (Maybe Bool)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= EnumValueDefinition -> Maybe Bool
_evdIsDeprecated

--------------------------------------------------------------------------------
-- Relationships

data TypeRelationshipDefinition = TypeRelationshipDefinition
  { TypeRelationshipDefinition -> RelationshipName
_trdName :: RelationshipName,
    TypeRelationshipDefinition -> RelType
_trdType :: RelType,
    -- TODO: replace this with RemoteRelationshipDefinition?
    -- As of now, we can't yet generalize this, due to the way async action
    -- queries' joins are implemented in GraphQL.Execute.Action (with an ad-hoc
    -- temporary table on postgres). If we are willing to change the way joins
    -- are performed, then we can replace this PG-specific code with the new and
    -- fancy generalized remote relationship code.
    TypeRelationshipDefinition -> SourceName
_trdSource :: SourceName,
    TypeRelationshipDefinition -> QualifiedTable
_trdRemoteTable :: Postgres.QualifiedTable,
    TypeRelationshipDefinition -> HashMap ObjectFieldName PGCol
_trdFieldMapping :: HashMap ObjectFieldName Postgres.PGCol
  }
  deriving (Int -> TypeRelationshipDefinition -> ShowS
[TypeRelationshipDefinition] -> ShowS
TypeRelationshipDefinition -> String
(Int -> TypeRelationshipDefinition -> ShowS)
-> (TypeRelationshipDefinition -> String)
-> ([TypeRelationshipDefinition] -> ShowS)
-> Show TypeRelationshipDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeRelationshipDefinition -> ShowS
showsPrec :: Int -> TypeRelationshipDefinition -> ShowS
$cshow :: TypeRelationshipDefinition -> String
show :: TypeRelationshipDefinition -> String
$cshowList :: [TypeRelationshipDefinition] -> ShowS
showList :: [TypeRelationshipDefinition] -> ShowS
Show, TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool
(TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool)
-> (TypeRelationshipDefinition
    -> TypeRelationshipDefinition -> Bool)
-> Eq TypeRelationshipDefinition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool
== :: TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool
$c/= :: TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool
/= :: TypeRelationshipDefinition -> TypeRelationshipDefinition -> Bool
Eq, (forall x.
 TypeRelationshipDefinition -> Rep TypeRelationshipDefinition x)
-> (forall x.
    Rep TypeRelationshipDefinition x -> TypeRelationshipDefinition)
-> Generic TypeRelationshipDefinition
forall x.
Rep TypeRelationshipDefinition x -> TypeRelationshipDefinition
forall x.
TypeRelationshipDefinition -> Rep TypeRelationshipDefinition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
TypeRelationshipDefinition -> Rep TypeRelationshipDefinition x
from :: forall x.
TypeRelationshipDefinition -> Rep TypeRelationshipDefinition x
$cto :: forall x.
Rep TypeRelationshipDefinition x -> TypeRelationshipDefinition
to :: forall x.
Rep TypeRelationshipDefinition x -> TypeRelationshipDefinition
Generic)

instance NFData TypeRelationshipDefinition

instance HasCodec TypeRelationshipDefinition where
  codec :: JSONCodec TypeRelationshipDefinition
codec =
    Text
-> ObjectCodec
     TypeRelationshipDefinition TypeRelationshipDefinition
-> JSONCodec TypeRelationshipDefinition
forall input output.
Text -> ObjectCodec input output -> ValueCodec input output
AC.object Text
"TypeRelationshipDefinition"
      (ObjectCodec TypeRelationshipDefinition TypeRelationshipDefinition
 -> JSONCodec TypeRelationshipDefinition)
-> ObjectCodec
     TypeRelationshipDefinition TypeRelationshipDefinition
-> JSONCodec TypeRelationshipDefinition
forall a b. (a -> b) -> a -> b
$ RelationshipName
-> RelType
-> SourceName
-> QualifiedTable
-> HashMap ObjectFieldName PGCol
-> TypeRelationshipDefinition
TypeRelationshipDefinition
      (RelationshipName
 -> RelType
 -> SourceName
 -> QualifiedTable
 -> HashMap ObjectFieldName PGCol
 -> TypeRelationshipDefinition)
-> Codec Object TypeRelationshipDefinition RelationshipName
-> Codec
     Object
     TypeRelationshipDefinition
     (RelType
      -> SourceName
      -> QualifiedTable
      -> HashMap ObjectFieldName PGCol
      -> TypeRelationshipDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> ObjectCodec RelationshipName RelationshipName
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"name"
      ObjectCodec RelationshipName RelationshipName
-> (TypeRelationshipDefinition -> RelationshipName)
-> Codec Object TypeRelationshipDefinition RelationshipName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TypeRelationshipDefinition -> RelationshipName
_trdName
        Codec
  Object
  TypeRelationshipDefinition
  (RelType
   -> SourceName
   -> QualifiedTable
   -> HashMap ObjectFieldName PGCol
   -> TypeRelationshipDefinition)
-> Codec Object TypeRelationshipDefinition RelType
-> Codec
     Object
     TypeRelationshipDefinition
     (SourceName
      -> QualifiedTable
      -> HashMap ObjectFieldName PGCol
      -> TypeRelationshipDefinition)
forall a b.
Codec Object TypeRelationshipDefinition (a -> b)
-> Codec Object TypeRelationshipDefinition a
-> Codec Object TypeRelationshipDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec RelType RelType
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"type"
      ObjectCodec RelType RelType
-> (TypeRelationshipDefinition -> RelType)
-> Codec Object TypeRelationshipDefinition RelType
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TypeRelationshipDefinition -> RelType
_trdType
        Codec
  Object
  TypeRelationshipDefinition
  (SourceName
   -> QualifiedTable
   -> HashMap ObjectFieldName PGCol
   -> TypeRelationshipDefinition)
-> Codec Object TypeRelationshipDefinition SourceName
-> Codec
     Object
     TypeRelationshipDefinition
     (QualifiedTable
      -> HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
forall a b.
Codec Object TypeRelationshipDefinition (a -> b)
-> Codec Object TypeRelationshipDefinition a
-> Codec Object TypeRelationshipDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> SourceName -> ObjectCodec SourceName SourceName
forall output.
HasCodec output =>
Text -> output -> ObjectCodec output output
optionalFieldWithDefault' Text
"source" SourceName
defaultSource
      ObjectCodec SourceName SourceName
-> (TypeRelationshipDefinition -> SourceName)
-> Codec Object TypeRelationshipDefinition SourceName
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TypeRelationshipDefinition -> SourceName
_trdSource
        Codec
  Object
  TypeRelationshipDefinition
  (QualifiedTable
   -> HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
-> Codec Object TypeRelationshipDefinition QualifiedTable
-> Codec
     Object
     TypeRelationshipDefinition
     (HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
forall a b.
Codec Object TypeRelationshipDefinition (a -> b)
-> Codec Object TypeRelationshipDefinition a
-> Codec Object TypeRelationshipDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text -> ObjectCodec QualifiedTable QualifiedTable
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"remote_table"
      ObjectCodec QualifiedTable QualifiedTable
-> (TypeRelationshipDefinition -> QualifiedTable)
-> Codec Object TypeRelationshipDefinition QualifiedTable
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TypeRelationshipDefinition -> QualifiedTable
_trdRemoteTable
        Codec
  Object
  TypeRelationshipDefinition
  (HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
-> Codec
     Object TypeRelationshipDefinition (HashMap ObjectFieldName PGCol)
-> ObjectCodec
     TypeRelationshipDefinition TypeRelationshipDefinition
forall a b.
Codec Object TypeRelationshipDefinition (a -> b)
-> Codec Object TypeRelationshipDefinition a
-> Codec Object TypeRelationshipDefinition b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Text
-> ObjectCodec
     (HashMap ObjectFieldName PGCol) (HashMap ObjectFieldName PGCol)
forall output. HasCodec output => Text -> ObjectCodec output output
requiredField' Text
"field_mapping"
      ObjectCodec
  (HashMap ObjectFieldName PGCol) (HashMap ObjectFieldName PGCol)
-> (TypeRelationshipDefinition -> HashMap ObjectFieldName PGCol)
-> Codec
     Object TypeRelationshipDefinition (HashMap ObjectFieldName PGCol)
forall oldInput output newInput.
ObjectCodec oldInput output
-> (newInput -> oldInput) -> ObjectCodec newInput output
AC..= TypeRelationshipDefinition -> HashMap ObjectFieldName PGCol
_trdFieldMapping

instance J.FromJSON TypeRelationshipDefinition where
  parseJSON :: Value -> Parser TypeRelationshipDefinition
parseJSON = String
-> (Object -> Parser TypeRelationshipDefinition)
-> Value
-> Parser TypeRelationshipDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"TypeRelationshipDefinition" ((Object -> Parser TypeRelationshipDefinition)
 -> Value -> Parser TypeRelationshipDefinition)
-> (Object -> Parser TypeRelationshipDefinition)
-> Value
-> Parser TypeRelationshipDefinition
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    RelationshipName
-> RelType
-> SourceName
-> QualifiedTable
-> HashMap ObjectFieldName PGCol
-> TypeRelationshipDefinition
TypeRelationshipDefinition
      (RelationshipName
 -> RelType
 -> SourceName
 -> QualifiedTable
 -> HashMap ObjectFieldName PGCol
 -> TypeRelationshipDefinition)
-> Parser RelationshipName
-> Parser
     (RelType
      -> SourceName
      -> QualifiedTable
      -> HashMap ObjectFieldName PGCol
      -> TypeRelationshipDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o
      Object -> Key -> Parser RelationshipName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
      Parser
  (RelType
   -> SourceName
   -> QualifiedTable
   -> HashMap ObjectFieldName PGCol
   -> TypeRelationshipDefinition)
-> Parser RelType
-> Parser
     (SourceName
      -> QualifiedTable
      -> HashMap ObjectFieldName PGCol
      -> TypeRelationshipDefinition)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser RelType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
      Parser
  (SourceName
   -> QualifiedTable
   -> HashMap ObjectFieldName PGCol
   -> TypeRelationshipDefinition)
-> Parser SourceName
-> Parser
     (QualifiedTable
      -> HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (Maybe SourceName)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"source"
      Parser (Maybe SourceName) -> SourceName -> Parser SourceName
forall a. Parser (Maybe a) -> a -> Parser a
.!= SourceName
defaultSource
      Parser
  (QualifiedTable
   -> HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
-> Parser QualifiedTable
-> Parser
     (HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser QualifiedTable
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"remote_table"
      Parser
  (HashMap ObjectFieldName PGCol -> TypeRelationshipDefinition)
-> Parser (HashMap ObjectFieldName PGCol)
-> Parser TypeRelationshipDefinition
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o
      Object -> Key -> Parser (HashMap ObjectFieldName PGCol)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"field_mapping"

-- | TODO: deduplicate this in favour of RelName
newtype RelationshipName = RelationshipName {RelationshipName -> Name
unRelationshipName :: G.Name}
  deriving (Int -> RelationshipName -> ShowS
[RelationshipName] -> ShowS
RelationshipName -> String
(Int -> RelationshipName -> ShowS)
-> (RelationshipName -> String)
-> ([RelationshipName] -> ShowS)
-> Show RelationshipName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RelationshipName -> ShowS
showsPrec :: Int -> RelationshipName -> ShowS
$cshow :: RelationshipName -> String
show :: RelationshipName -> String
$cshowList :: [RelationshipName] -> ShowS
showList :: [RelationshipName] -> ShowS
Show, RelationshipName -> RelationshipName -> Bool
(RelationshipName -> RelationshipName -> Bool)
-> (RelationshipName -> RelationshipName -> Bool)
-> Eq RelationshipName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RelationshipName -> RelationshipName -> Bool
== :: RelationshipName -> RelationshipName -> Bool
$c/= :: RelationshipName -> RelationshipName -> Bool
/= :: RelationshipName -> RelationshipName -> Bool
Eq, Eq RelationshipName
Eq RelationshipName
-> (RelationshipName -> RelationshipName -> Ordering)
-> (RelationshipName -> RelationshipName -> Bool)
-> (RelationshipName -> RelationshipName -> Bool)
-> (RelationshipName -> RelationshipName -> Bool)
-> (RelationshipName -> RelationshipName -> Bool)
-> (RelationshipName -> RelationshipName -> RelationshipName)
-> (RelationshipName -> RelationshipName -> RelationshipName)
-> Ord RelationshipName
RelationshipName -> RelationshipName -> Bool
RelationshipName -> RelationshipName -> Ordering
RelationshipName -> RelationshipName -> RelationshipName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: RelationshipName -> RelationshipName -> Ordering
compare :: RelationshipName -> RelationshipName -> Ordering
$c< :: RelationshipName -> RelationshipName -> Bool
< :: RelationshipName -> RelationshipName -> Bool
$c<= :: RelationshipName -> RelationshipName -> Bool
<= :: RelationshipName -> RelationshipName -> Bool
$c> :: RelationshipName -> RelationshipName -> Bool
> :: RelationshipName -> RelationshipName -> Bool
$c>= :: RelationshipName -> RelationshipName -> Bool
>= :: RelationshipName -> RelationshipName -> Bool
$cmax :: RelationshipName -> RelationshipName -> RelationshipName
max :: RelationshipName -> RelationshipName -> RelationshipName
$cmin :: RelationshipName -> RelationshipName -> RelationshipName
min :: RelationshipName -> RelationshipName -> RelationshipName
Ord, Eq RelationshipName
Eq RelationshipName
-> (Int -> RelationshipName -> Int)
-> (RelationshipName -> Int)
-> Hashable RelationshipName
Int -> RelationshipName -> Int
RelationshipName -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
$chashWithSalt :: Int -> RelationshipName -> Int
hashWithSalt :: Int -> RelationshipName -> Int
$chash :: RelationshipName -> Int
hash :: RelationshipName -> Int
Hashable, Value -> Parser [RelationshipName]
Value -> Parser RelationshipName
(Value -> Parser RelationshipName)
-> (Value -> Parser [RelationshipName])
-> FromJSON RelationshipName
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
$cparseJSON :: Value -> Parser RelationshipName
parseJSON :: Value -> Parser RelationshipName
$cparseJSONList :: Value -> Parser [RelationshipName]
parseJSONList :: Value -> Parser [RelationshipName]
J.FromJSON, [RelationshipName] -> Value
[RelationshipName] -> Encoding
RelationshipName -> Value
RelationshipName -> Encoding
(RelationshipName -> Value)
-> (RelationshipName -> Encoding)
-> ([RelationshipName] -> Value)
-> ([RelationshipName] -> Encoding)
-> ToJSON RelationshipName
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: RelationshipName -> Value
toJSON :: RelationshipName -> Value
$ctoEncoding :: RelationshipName -> Encoding
toEncoding :: RelationshipName -> Encoding
$ctoJSONList :: [RelationshipName] -> Value
toJSONList :: [RelationshipName] -> Value
$ctoEncodingList :: [RelationshipName] -> Encoding
toEncodingList :: [RelationshipName] -> Encoding
J.ToJSON, RelationshipName -> Text
(RelationshipName -> Text) -> ToTxt RelationshipName
forall a. (a -> Text) -> ToTxt a
$ctoTxt :: RelationshipName -> Text
toTxt :: RelationshipName -> Text
ToTxt, (forall x. RelationshipName -> Rep RelationshipName x)
-> (forall x. Rep RelationshipName x -> RelationshipName)
-> Generic RelationshipName
forall x. Rep RelationshipName x -> RelationshipName
forall x. RelationshipName -> Rep RelationshipName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. RelationshipName -> Rep RelationshipName x
from :: forall x. RelationshipName -> Rep RelationshipName x
$cto :: forall x. Rep RelationshipName x -> RelationshipName
to :: forall x. Rep RelationshipName x -> RelationshipName
Generic, RelationshipName -> ()
(RelationshipName -> ()) -> NFData RelationshipName
forall a. (a -> ()) -> NFData a
$crnf :: RelationshipName -> ()
rnf :: RelationshipName -> ()
NFData)

instance HasCodec RelationshipName where
  codec :: JSONCodec RelationshipName
codec = (Name -> RelationshipName)
-> (RelationshipName -> Name)
-> Codec Value Name Name
-> JSONCodec RelationshipName
forall oldOutput newOutput newInput oldInput context.
(oldOutput -> newOutput)
-> (newInput -> oldInput)
-> Codec context oldInput oldOutput
-> Codec context newInput newOutput
dimapCodec Name -> RelationshipName
RelationshipName RelationshipName -> Name
unRelationshipName Codec Value Name Name
forall value. HasCodec value => JSONCodec value
codec

--------------------------------------------------------------------------------
-- Schema cache

-- | While we do not persist resolved types in the schema cache, they are used
-- when building the cache to validate and resolve actions and their
-- relationships.
data AnnotatedCustomTypes = AnnotatedCustomTypes
  { AnnotatedCustomTypes -> HashMap Name AnnotatedInputType
_actInputTypes :: HashMap G.Name AnnotatedInputType,
    AnnotatedCustomTypes -> HashMap Name AnnotatedObjectType
_actObjectTypes :: HashMap G.Name AnnotatedObjectType
  }

instance Semigroup AnnotatedCustomTypes where
  AnnotatedCustomTypes HashMap Name AnnotatedInputType
no1 HashMap Name AnnotatedObjectType
o1 <> :: AnnotatedCustomTypes
-> AnnotatedCustomTypes -> AnnotatedCustomTypes
<> AnnotatedCustomTypes HashMap Name AnnotatedInputType
no2 HashMap Name AnnotatedObjectType
o2 =
    HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedObjectType -> AnnotatedCustomTypes
AnnotatedCustomTypes (HashMap Name AnnotatedInputType
no1 HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedInputType
forall a. Semigroup a => a -> a -> a
<> HashMap Name AnnotatedInputType
no2) (HashMap Name AnnotatedObjectType
o1 HashMap Name AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
-> HashMap Name AnnotatedObjectType
forall a. Semigroup a => a -> a -> a
<> HashMap Name AnnotatedObjectType
o2)

instance Monoid AnnotatedCustomTypes where
  mempty :: AnnotatedCustomTypes
mempty = HashMap Name AnnotatedInputType
-> HashMap Name AnnotatedObjectType -> AnnotatedCustomTypes
AnnotatedCustomTypes HashMap Name AnnotatedInputType
forall a. Monoid a => a
mempty HashMap Name AnnotatedObjectType
forall a. Monoid a => a
mempty

data AnnotatedInputType
  = NOCTScalar AnnotatedScalarType
  | NOCTEnum EnumTypeDefinition
  | NOCTInputObject InputObjectTypeDefinition
  deriving (AnnotatedInputType -> AnnotatedInputType -> Bool
(AnnotatedInputType -> AnnotatedInputType -> Bool)
-> (AnnotatedInputType -> AnnotatedInputType -> Bool)
-> Eq AnnotatedInputType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnotatedInputType -> AnnotatedInputType -> Bool
== :: AnnotatedInputType -> AnnotatedInputType -> Bool
$c/= :: AnnotatedInputType -> AnnotatedInputType -> Bool
/= :: AnnotatedInputType -> AnnotatedInputType -> Bool
Eq, Eq AnnotatedInputType
Eq AnnotatedInputType
-> (AnnotatedInputType -> AnnotatedInputType -> Ordering)
-> (AnnotatedInputType -> AnnotatedInputType -> Bool)
-> (AnnotatedInputType -> AnnotatedInputType -> Bool)
-> (AnnotatedInputType -> AnnotatedInputType -> Bool)
-> (AnnotatedInputType -> AnnotatedInputType -> Bool)
-> (AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType)
-> (AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType)
-> Ord AnnotatedInputType
AnnotatedInputType -> AnnotatedInputType -> Bool
AnnotatedInputType -> AnnotatedInputType -> Ordering
AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnnotatedInputType -> AnnotatedInputType -> Ordering
compare :: AnnotatedInputType -> AnnotatedInputType -> Ordering
$c< :: AnnotatedInputType -> AnnotatedInputType -> Bool
< :: AnnotatedInputType -> AnnotatedInputType -> Bool
$c<= :: AnnotatedInputType -> AnnotatedInputType -> Bool
<= :: AnnotatedInputType -> AnnotatedInputType -> Bool
$c> :: AnnotatedInputType -> AnnotatedInputType -> Bool
> :: AnnotatedInputType -> AnnotatedInputType -> Bool
$c>= :: AnnotatedInputType -> AnnotatedInputType -> Bool
>= :: AnnotatedInputType -> AnnotatedInputType -> Bool
$cmax :: AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType
max :: AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType
$cmin :: AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType
min :: AnnotatedInputType -> AnnotatedInputType -> AnnotatedInputType
Ord, (forall x. AnnotatedInputType -> Rep AnnotatedInputType x)
-> (forall x. Rep AnnotatedInputType x -> AnnotatedInputType)
-> Generic AnnotatedInputType
forall x. Rep AnnotatedInputType x -> AnnotatedInputType
forall x. AnnotatedInputType -> Rep AnnotatedInputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnotatedInputType -> Rep AnnotatedInputType x
from :: forall x. AnnotatedInputType -> Rep AnnotatedInputType x
$cto :: forall x. Rep AnnotatedInputType x -> AnnotatedInputType
to :: forall x. Rep AnnotatedInputType x -> AnnotatedInputType
Generic)

data AnnotatedScalarType
  = ASTCustom ScalarTypeDefinition
  | ASTReusedScalar G.Name (AnyBackend ScalarWrapper)
  deriving (AnnotatedScalarType -> AnnotatedScalarType -> Bool
(AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> (AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> Eq AnnotatedScalarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
== :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
$c/= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
/= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
Eq, Eq AnnotatedScalarType
Eq AnnotatedScalarType
-> (AnnotatedScalarType -> AnnotatedScalarType -> Ordering)
-> (AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> (AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> (AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> (AnnotatedScalarType -> AnnotatedScalarType -> Bool)
-> (AnnotatedScalarType
    -> AnnotatedScalarType -> AnnotatedScalarType)
-> (AnnotatedScalarType
    -> AnnotatedScalarType -> AnnotatedScalarType)
-> Ord AnnotatedScalarType
AnnotatedScalarType -> AnnotatedScalarType -> Bool
AnnotatedScalarType -> AnnotatedScalarType -> Ordering
AnnotatedScalarType -> AnnotatedScalarType -> AnnotatedScalarType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: AnnotatedScalarType -> AnnotatedScalarType -> Ordering
compare :: AnnotatedScalarType -> AnnotatedScalarType -> Ordering
$c< :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
< :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
$c<= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
<= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
$c> :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
> :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
$c>= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
>= :: AnnotatedScalarType -> AnnotatedScalarType -> Bool
$cmax :: AnnotatedScalarType -> AnnotatedScalarType -> AnnotatedScalarType
max :: AnnotatedScalarType -> AnnotatedScalarType -> AnnotatedScalarType
$cmin :: AnnotatedScalarType -> AnnotatedScalarType -> AnnotatedScalarType
min :: AnnotatedScalarType -> AnnotatedScalarType -> AnnotatedScalarType
Ord, (forall x. AnnotatedScalarType -> Rep AnnotatedScalarType x)
-> (forall x. Rep AnnotatedScalarType x -> AnnotatedScalarType)
-> Generic AnnotatedScalarType
forall x. Rep AnnotatedScalarType x -> AnnotatedScalarType
forall x. AnnotatedScalarType -> Rep AnnotatedScalarType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnotatedScalarType -> Rep AnnotatedScalarType x
from :: forall x. AnnotatedScalarType -> Rep AnnotatedScalarType x
$cto :: forall x. Rep AnnotatedScalarType x -> AnnotatedScalarType
to :: forall x. Rep AnnotatedScalarType x -> AnnotatedScalarType
Generic)

data ScalarWrapper b = ScalarWrapper {forall (b :: BackendType). ScalarWrapper b -> ScalarType b
unwrapScalar :: ScalarType b, forall (b :: BackendType).
ScalarWrapper b -> ScalarTypeParsingContext b
parsingContext :: ScalarTypeParsingContext b}

deriving instance (Backend b) => Eq (ScalarWrapper b)

deriving instance (Backend b) => Ord (ScalarWrapper b)

data AnnotatedOutputType
  = AOTObject AnnotatedObjectType
  | AOTScalar AnnotatedScalarType
  deriving ((forall x. AnnotatedOutputType -> Rep AnnotatedOutputType x)
-> (forall x. Rep AnnotatedOutputType x -> AnnotatedOutputType)
-> Generic AnnotatedOutputType
forall x. Rep AnnotatedOutputType x -> AnnotatedOutputType
forall x. AnnotatedOutputType -> Rep AnnotatedOutputType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnotatedOutputType -> Rep AnnotatedOutputType x
from :: forall x. AnnotatedOutputType -> Rep AnnotatedOutputType x
$cto :: forall x. Rep AnnotatedOutputType x -> AnnotatedOutputType
to :: forall x. Rep AnnotatedOutputType x -> AnnotatedOutputType
Generic)

data AnnotatedObjectType = AnnotatedObjectType
  { AnnotatedObjectType -> ObjectTypeName
_aotName :: ObjectTypeName,
    AnnotatedObjectType -> Maybe Description
_aotDescription :: Maybe G.Description,
    AnnotatedObjectType
-> NonEmpty
     (ObjectFieldDefinition (GType, AnnotatedObjectFieldType))
_aotFields :: NonEmpty (ObjectFieldDefinition (G.GType, AnnotatedObjectFieldType)),
    AnnotatedObjectType -> [AnnotatedTypeRelationship]
_aotRelationships :: [AnnotatedTypeRelationship]
  }
  deriving ((forall x. AnnotatedObjectType -> Rep AnnotatedObjectType x)
-> (forall x. Rep AnnotatedObjectType x -> AnnotatedObjectType)
-> Generic AnnotatedObjectType
forall x. Rep AnnotatedObjectType x -> AnnotatedObjectType
forall x. AnnotatedObjectType -> Rep AnnotatedObjectType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. AnnotatedObjectType -> Rep AnnotatedObjectType x
from :: forall x. AnnotatedObjectType -> Rep AnnotatedObjectType x
$cto :: forall x. Rep AnnotatedObjectType x -> AnnotatedObjectType
to :: forall x. Rep AnnotatedObjectType x -> AnnotatedObjectType
Generic)

data AnnotatedObjectFieldType
  = AOFTScalar AnnotatedScalarType
  | AOFTEnum EnumTypeDefinition
  | AOFTObject G.Name
  deriving ((forall x.
 AnnotatedObjectFieldType -> Rep AnnotatedObjectFieldType x)
-> (forall x.
    Rep AnnotatedObjectFieldType x -> AnnotatedObjectFieldType)
-> Generic AnnotatedObjectFieldType
forall x.
Rep AnnotatedObjectFieldType x -> AnnotatedObjectFieldType
forall x.
AnnotatedObjectFieldType -> Rep AnnotatedObjectFieldType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AnnotatedObjectFieldType -> Rep AnnotatedObjectFieldType x
from :: forall x.
AnnotatedObjectFieldType -> Rep AnnotatedObjectFieldType x
$cto :: forall x.
Rep AnnotatedObjectFieldType x -> AnnotatedObjectFieldType
to :: forall x.
Rep AnnotatedObjectFieldType x -> AnnotatedObjectFieldType
Generic)

-- TODO: deduplicate this with 'RemoteSourceFieldInfo'
data AnnotatedTypeRelationship = AnnotatedTypeRelationship
  { AnnotatedTypeRelationship -> RelationshipName
_atrName :: RelationshipName,
    AnnotatedTypeRelationship -> RelType
_atrType :: RelType,
    AnnotatedTypeRelationship -> SourceName
_atrSource :: SourceName,
    AnnotatedTypeRelationship -> SourceConfig ('Postgres 'Vanilla)
_atrSourceConfig :: SourceConfig ('Postgres 'Vanilla),
    -- TODO: see comment in 'TypeRelationship'
    AnnotatedTypeRelationship -> TableName ('Postgres 'Vanilla)
_atrTableName :: TableName ('Postgres 'Vanilla),
    AnnotatedTypeRelationship
-> HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
_atrFieldMapping :: HashMap ObjectFieldName (ColumnInfo ('Postgres 'Vanilla))
  }
  deriving ((forall x.
 AnnotatedTypeRelationship -> Rep AnnotatedTypeRelationship x)
-> (forall x.
    Rep AnnotatedTypeRelationship x -> AnnotatedTypeRelationship)
-> Generic AnnotatedTypeRelationship
forall x.
Rep AnnotatedTypeRelationship x -> AnnotatedTypeRelationship
forall x.
AnnotatedTypeRelationship -> Rep AnnotatedTypeRelationship x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x.
AnnotatedTypeRelationship -> Rep AnnotatedTypeRelationship x
from :: forall x.
AnnotatedTypeRelationship -> Rep AnnotatedTypeRelationship x
$cto :: forall x.
Rep AnnotatedTypeRelationship x -> AnnotatedTypeRelationship
to :: forall x.
Rep AnnotatedTypeRelationship x -> AnnotatedTypeRelationship
Generic)

-------------------------------------------------------------------------------
-- Template haskell derivation
-- ...and other instances that need to live here in a particular order, due to
-- GHC 9.0 TH changes...

$(J.deriveJSON hasuraJSON ''InputObjectFieldDefinition)
$(J.deriveJSON hasuraJSON ''InputObjectTypeDefinition)
$(J.deriveJSON hasuraJSON ''ObjectFieldDefinition)
$(J.deriveJSON hasuraJSON ''ScalarTypeDefinition)

$(J.deriveJSON hasuraJSON ''EnumValueDefinition)

$(J.deriveToJSON hasuraJSON ''TypeRelationshipDefinition)

instance J.ToJSON AnnotatedScalarType where
  toJSON :: AnnotatedScalarType -> Value
toJSON = \case
    ASTCustom ScalarTypeDefinition
std ->
      [Pair] -> Value
J.object [Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
J.String Text
"ASTCustom", Key
"contents" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= ScalarTypeDefinition -> Value
forall a. ToJSON a => a -> Value
J.toJSON ScalarTypeDefinition
std]
    -- warning: can't be parsed back, as it does not include the
    -- backend-specific scalar information.
    ASTReusedScalar Name
name AnyBackend ScalarWrapper
_scalar ->
      [Pair] -> Value
J.object [Key
"tag" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text -> Value
J.String Text
"ASTReusedScalar", Key
"contents" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Name -> Value
forall a. ToJSON a => a -> Value
J.toJSON Name
name]

$(makeLenses ''TypeRelationshipDefinition)

$(J.deriveJSON hasuraJSON ''EnumTypeDefinition)

instance J.FromJSON CustomTypes where
  parseJSON :: Value -> Parser CustomTypes
parseJSON = String
-> (Object -> Parser CustomTypes) -> Value -> Parser CustomTypes
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"CustomTypes" \Object
o ->
    [InputObjectTypeDefinition]
-> [ObjectTypeDefinition]
-> [ScalarTypeDefinition]
-> [EnumTypeDefinition]
-> CustomTypes
CustomTypes
      ([InputObjectTypeDefinition]
 -> [ObjectTypeDefinition]
 -> [ScalarTypeDefinition]
 -> [EnumTypeDefinition]
 -> CustomTypes)
-> Parser [InputObjectTypeDefinition]
-> Parser
     ([ObjectTypeDefinition]
      -> [ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser (Maybe [InputObjectTypeDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"input_objects" Parser (Maybe [InputObjectTypeDefinition])
-> [InputObjectTypeDefinition]
-> Parser [InputObjectTypeDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      Parser
  ([ObjectTypeDefinition]
   -> [ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
-> Parser [ObjectTypeDefinition]
-> Parser
     ([ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ObjectTypeDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"objects" Parser (Maybe [ObjectTypeDefinition])
-> [ObjectTypeDefinition] -> Parser [ObjectTypeDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      Parser
  ([ScalarTypeDefinition] -> [EnumTypeDefinition] -> CustomTypes)
-> Parser [ScalarTypeDefinition]
-> Parser ([EnumTypeDefinition] -> CustomTypes)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [ScalarTypeDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"scalars" Parser (Maybe [ScalarTypeDefinition])
-> [ScalarTypeDefinition] -> Parser [ScalarTypeDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])
      Parser ([EnumTypeDefinition] -> CustomTypes)
-> Parser [EnumTypeDefinition] -> Parser CustomTypes
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [EnumTypeDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"enums" Parser (Maybe [EnumTypeDefinition])
-> [EnumTypeDefinition] -> Parser [EnumTypeDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])

instance J.FromJSON ObjectTypeDefinition where
  parseJSON :: Value -> Parser ObjectTypeDefinition
parseJSON = String
-> (Object -> Parser ObjectTypeDefinition)
-> Value
-> Parser ObjectTypeDefinition
forall a. String -> (Object -> Parser a) -> Value -> Parser a
J.withObject String
"ObjectTypeDefinition" \Object
o ->
    ObjectTypeName
-> Maybe Description
-> NonEmpty (ObjectFieldDefinition GraphQLType)
-> [TypeRelationshipDefinition]
-> ObjectTypeDefinition
ObjectTypeDefinition
      (ObjectTypeName
 -> Maybe Description
 -> NonEmpty (ObjectFieldDefinition GraphQLType)
 -> [TypeRelationshipDefinition]
 -> ObjectTypeDefinition)
-> Parser ObjectTypeName
-> Parser
     (Maybe Description
      -> NonEmpty (ObjectFieldDefinition GraphQLType)
      -> [TypeRelationshipDefinition]
      -> ObjectTypeDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Key -> Parser ObjectTypeName
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name")
      Parser
  (Maybe Description
   -> NonEmpty (ObjectFieldDefinition GraphQLType)
   -> [TypeRelationshipDefinition]
   -> ObjectTypeDefinition)
-> Parser (Maybe Description)
-> Parser
     (NonEmpty (ObjectFieldDefinition GraphQLType)
      -> [TypeRelationshipDefinition] -> ObjectTypeDefinition)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe Description)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"description")
      Parser
  (NonEmpty (ObjectFieldDefinition GraphQLType)
   -> [TypeRelationshipDefinition] -> ObjectTypeDefinition)
-> Parser (NonEmpty (ObjectFieldDefinition GraphQLType))
-> Parser ([TypeRelationshipDefinition] -> ObjectTypeDefinition)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object
-> Key -> Parser (NonEmpty (ObjectFieldDefinition GraphQLType))
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"fields")
      Parser ([TypeRelationshipDefinition] -> ObjectTypeDefinition)
-> Parser [TypeRelationshipDefinition]
-> Parser ObjectTypeDefinition
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o Object -> Key -> Parser (Maybe [TypeRelationshipDefinition])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"relationships" Parser (Maybe [TypeRelationshipDefinition])
-> [TypeRelationshipDefinition]
-> Parser [TypeRelationshipDefinition]
forall a. Parser (Maybe a) -> a -> Parser a
.!= [])

$(J.deriveToJSON hasuraJSON ''ObjectTypeDefinition)
$(J.deriveToJSON hasuraJSON ''CustomTypes)
$(J.deriveToJSON hasuraJSON ''AnnotatedInputType)
$(J.deriveToJSON hasuraJSON ''AnnotatedObjectFieldType)
$(J.deriveToJSON hasuraJSON ''AnnotatedTypeRelationship)
$(J.deriveToJSON hasuraJSON ''AnnotatedObjectType)
$(J.deriveToJSON hasuraJSON ''AnnotatedOutputType)