{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Types.Internal.AST.Fields
  ( Arguments,
    Argument (..),
    ArgumentDefinition (..),
    ArgumentsDefinition,
    FieldDefinition (..),
    FieldsDefinition,
    FieldContent (..),
    InputFieldsDefinition,
    DirectivesDefinition,
    DirectiveDefinition (..),
    Directives,
    Directive (..),
    fieldVisibility,
    lookupDeprecated,
    lookupDeprecatedReason,
    unsafeFromFields,
    fieldsToArguments,
    fieldArguments,
    mkObjectField,
    mkField,
    renderArgumentValues,
    renderDirectives,
  )
where

import Data.Mergeable
  ( IsMap (lookup),
    NameCollision (..),
    OrdMap,
  )
import Data.Morpheus.Internal.Utils
  ( Empty (..),
    KeyOf (..),
    selectOr,
    toPair,
    unsafeFromList,
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    intercalate,
    renderArguments,
    renderEntry,
    renderObject,
    space,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    Position,
    TRUE,
  )
import Data.Morpheus.Types.Internal.AST.DirectiveLocation (DirectiveLocation)
import Data.Morpheus.Types.Internal.AST.Error
  ( GQLError,
    at,
    msg,
  )
import Data.Morpheus.Types.Internal.AST.Name
  ( FieldName,
    TypeName,
    isNotSystemFieldName,
  )
import Data.Morpheus.Types.Internal.AST.Stage
  ( Stage,
  )
import Data.Morpheus.Types.Internal.AST.Type
  ( Nullable (..),
    TypeRef (..),
    TypeWrapper (..),
  )
import Data.Morpheus.Types.Internal.AST.TypeCategory
  ( ANY,
    IN,
    OUT,
    ToCategory (..),
    TypeCategory,
    toAny,
    type (<=?),
  )
import Data.Morpheus.Types.Internal.AST.Value
  ( ScalarValue (..),
    Value (..),
  )
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift (..))
import Relude hiding (empty, intercalate)

-- scalar
------------------------------------------------------------------
data Argument (valid :: Stage) = Argument
  { Argument valid -> Position
argumentPosition :: Position,
    Argument valid -> FieldName
argumentName :: FieldName,
    Argument valid -> Value valid
argumentValue :: Value valid
  }
  deriving (Int -> Argument valid -> ShowS
[Argument valid] -> ShowS
Argument valid -> String
(Int -> Argument valid -> ShowS)
-> (Argument valid -> String)
-> ([Argument valid] -> ShowS)
-> Show (Argument valid)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (valid :: Stage). Int -> Argument valid -> ShowS
forall (valid :: Stage). [Argument valid] -> ShowS
forall (valid :: Stage). Argument valid -> String
showList :: [Argument valid] -> ShowS
$cshowList :: forall (valid :: Stage). [Argument valid] -> ShowS
show :: Argument valid -> String
$cshow :: forall (valid :: Stage). Argument valid -> String
showsPrec :: Int -> Argument valid -> ShowS
$cshowsPrec :: forall (valid :: Stage). Int -> Argument valid -> ShowS
Show, Argument valid -> Argument valid -> Bool
(Argument valid -> Argument valid -> Bool)
-> (Argument valid -> Argument valid -> Bool)
-> Eq (Argument valid)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (valid :: Stage). Argument valid -> Argument valid -> Bool
/= :: Argument valid -> Argument valid -> Bool
$c/= :: forall (valid :: Stage). Argument valid -> Argument valid -> Bool
== :: Argument valid -> Argument valid -> Bool
$c== :: forall (valid :: Stage). Argument valid -> Argument valid -> Bool
Eq, Argument valid -> Q Exp
Argument valid -> Q (TExp (Argument valid))
(Argument valid -> Q Exp)
-> (Argument valid -> Q (TExp (Argument valid)))
-> Lift (Argument valid)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (valid :: Stage). Argument valid -> Q Exp
forall (valid :: Stage).
Argument valid -> Q (TExp (Argument valid))
liftTyped :: Argument valid -> Q (TExp (Argument valid))
$cliftTyped :: forall (valid :: Stage).
Argument valid -> Q (TExp (Argument valid))
lift :: Argument valid -> Q Exp
$clift :: forall (valid :: Stage). Argument valid -> Q Exp
Lift)

instance KeyOf FieldName (Argument stage) where
  keyOf :: Argument stage -> FieldName
keyOf = Argument stage -> FieldName
forall (stage :: Stage). Argument stage -> FieldName
argumentName

instance RenderGQL (Argument s) where
  renderGQL :: Argument s -> Rendering
renderGQL Argument {FieldName
argumentName :: FieldName
argumentName :: forall (stage :: Stage). Argument stage -> FieldName
argumentName, Value s
argumentValue :: Value s
argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue} =
    FieldName -> Value s -> Rendering
forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry FieldName
argumentName Value s
argumentValue

instance NameCollision GQLError (Argument s) where
  nameCollision :: Argument s -> GQLError
nameCollision Argument {FieldName
argumentName :: FieldName
argumentName :: forall (stage :: Stage). Argument stage -> FieldName
argumentName, Position
argumentPosition :: Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentPosition} =
    (GQLError
"There can Be only One Argument Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
argumentName)
      GQLError -> Position -> GQLError
`at` Position
argumentPosition

type Arguments (s :: Stage) = OrdMap FieldName (Argument s)

renderArgumentValues :: Arguments s -> Rendering
renderArgumentValues :: Arguments s -> Rendering
renderArgumentValues = [Argument s] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderArguments ([Argument s] -> Rendering)
-> (Arguments s -> [Argument s]) -> Arguments s -> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Argument s -> Bool) -> [Argument s] -> [Argument s]
forall a. (a -> Bool) -> [a] -> [a]
filter Argument s -> Bool
forall (valid :: Stage). Argument valid -> Bool
notNull ([Argument s] -> [Argument s])
-> (Arguments s -> [Argument s]) -> Arguments s -> [Argument s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arguments s -> [Argument s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList
  where
    notNull :: Argument valid -> Bool
notNull Argument {argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue = Value valid
Null} = Bool
False
    notNull Argument valid
_ = Bool
True

-- directive
------------------------------------------------------------------
data Directive (s :: Stage) = Directive
  { Directive s -> Position
directivePosition :: Position,
    Directive s -> FieldName
directiveName :: FieldName,
    Directive s -> Arguments s
directiveArgs :: Arguments s
  }
  deriving (Int -> Directive s -> ShowS
[Directive s] -> ShowS
Directive s -> String
(Int -> Directive s -> ShowS)
-> (Directive s -> String)
-> ([Directive s] -> ShowS)
-> Show (Directive s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> Directive s -> ShowS
forall (s :: Stage). [Directive s] -> ShowS
forall (s :: Stage). Directive s -> String
showList :: [Directive s] -> ShowS
$cshowList :: forall (s :: Stage). [Directive s] -> ShowS
show :: Directive s -> String
$cshow :: forall (s :: Stage). Directive s -> String
showsPrec :: Int -> Directive s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> Directive s -> ShowS
Show, Directive s -> Q Exp
Directive s -> Q (TExp (Directive s))
(Directive s -> Q Exp)
-> (Directive s -> Q (TExp (Directive s))) -> Lift (Directive s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). Directive s -> Q Exp
forall (s :: Stage). Directive s -> Q (TExp (Directive s))
liftTyped :: Directive s -> Q (TExp (Directive s))
$cliftTyped :: forall (s :: Stage). Directive s -> Q (TExp (Directive s))
lift :: Directive s -> Q Exp
$clift :: forall (s :: Stage). Directive s -> Q Exp
Lift, Directive s -> Directive s -> Bool
(Directive s -> Directive s -> Bool)
-> (Directive s -> Directive s -> Bool) -> Eq (Directive s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage). Directive s -> Directive s -> Bool
/= :: Directive s -> Directive s -> Bool
$c/= :: forall (s :: Stage). Directive s -> Directive s -> Bool
== :: Directive s -> Directive s -> Bool
$c== :: forall (s :: Stage). Directive s -> Directive s -> Bool
Eq)

instance NameCollision GQLError (Directive s) where
  nameCollision :: Directive s -> GQLError
nameCollision Directive {FieldName
directiveName :: FieldName
directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName} =
    GQLError
"The directive "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg (FieldName
"@" FieldName -> FieldName -> FieldName
forall a. Semigroup a => a -> a -> a
<> FieldName
directiveName)
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
" can only be used once at his location."

instance KeyOf FieldName (Directive s) where
  keyOf :: Directive s -> FieldName
keyOf = Directive s -> FieldName
forall (s :: Stage). Directive s -> FieldName
directiveName

instance RenderGQL (Directive s) where
  renderGQL :: Directive s -> Rendering
renderGQL Directive {Arguments s
Position
FieldName
directiveArgs :: Arguments s
directiveName :: FieldName
directivePosition :: Position
directiveArgs :: forall (s :: Stage). Directive s -> Arguments s
directiveName :: forall (s :: Stage). Directive s -> FieldName
directivePosition :: forall (s :: Stage). Directive s -> Position
..} =
    Rendering
"@" Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldName
directiveName
      Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Arguments s -> Rendering
forall (s :: Stage). Arguments s -> Rendering
renderArgumentValues Arguments s
directiveArgs

type Directives s = OrdMap FieldName (Directive s)

renderDirectives :: Directives s -> Rendering
renderDirectives :: Directives s -> Rendering
renderDirectives Directives s
xs
  | [Directive s] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Directive s]
dirs = Rendering
""
  | Bool
otherwise = Rendering
space Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering -> [Rendering] -> Rendering
intercalate Rendering
space ((Directive s -> Rendering) -> [Directive s] -> [Rendering]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Directive s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL [Directive s]
dirs)
  where
    dirs :: [Directive s]
dirs = (Directive s -> Bool) -> [Directive s] -> [Directive s]
forall a. (a -> Bool) -> [a] -> [a]
filter Directive s -> Bool
forall (s :: Stage). Directive s -> Bool
notSystem (Directives s -> [Directive s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Directives s
xs)
    notSystem :: Directive s -> Bool
notSystem Directive {directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName = FieldName
"include"} = Bool
False
    notSystem Directive {directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName = FieldName
"skip"} = Bool
False
    notSystem Directive s
_ = Bool
True

data DirectiveDefinition s = DirectiveDefinition
  { DirectiveDefinition s -> FieldName
directiveDefinitionName :: FieldName,
    DirectiveDefinition s -> Maybe Description
directiveDefinitionDescription :: Maybe Description,
    DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionArgs :: ArgumentsDefinition s,
    DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionLocations :: [DirectiveLocation]
  }
  deriving (Int -> DirectiveDefinition s -> ShowS
[DirectiveDefinition s] -> ShowS
DirectiveDefinition s -> String
(Int -> DirectiveDefinition s -> ShowS)
-> (DirectiveDefinition s -> String)
-> ([DirectiveDefinition s] -> ShowS)
-> Show (DirectiveDefinition s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> DirectiveDefinition s -> ShowS
forall (s :: Stage). [DirectiveDefinition s] -> ShowS
forall (s :: Stage). DirectiveDefinition s -> String
showList :: [DirectiveDefinition s] -> ShowS
$cshowList :: forall (s :: Stage). [DirectiveDefinition s] -> ShowS
show :: DirectiveDefinition s -> String
$cshow :: forall (s :: Stage). DirectiveDefinition s -> String
showsPrec :: Int -> DirectiveDefinition s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> DirectiveDefinition s -> ShowS
Show, DirectiveDefinition s -> Q Exp
DirectiveDefinition s -> Q (TExp (DirectiveDefinition s))
(DirectiveDefinition s -> Q Exp)
-> (DirectiveDefinition s -> Q (TExp (DirectiveDefinition s)))
-> Lift (DirectiveDefinition s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). DirectiveDefinition s -> Q Exp
forall (s :: Stage).
DirectiveDefinition s -> Q (TExp (DirectiveDefinition s))
liftTyped :: DirectiveDefinition s -> Q (TExp (DirectiveDefinition s))
$cliftTyped :: forall (s :: Stage).
DirectiveDefinition s -> Q (TExp (DirectiveDefinition s))
lift :: DirectiveDefinition s -> Q Exp
$clift :: forall (s :: Stage). DirectiveDefinition s -> Q Exp
Lift)

instance NameCollision GQLError (DirectiveDefinition s) where
  nameCollision :: DirectiveDefinition s -> GQLError
nameCollision DirectiveDefinition {FieldName
directiveDefinitionName :: FieldName
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionName} =
    GQLError
"There can Be only One DirectiveDefinition Named "
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
directiveDefinitionName
      GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> GQLError
"."

type DirectivesDefinition s = OrdMap FieldName (DirectiveDefinition s)

instance KeyOf FieldName (DirectiveDefinition s) where
  keyOf :: DirectiveDefinition s -> FieldName
keyOf = DirectiveDefinition s -> FieldName
forall (s :: Stage). DirectiveDefinition s -> FieldName
directiveDefinitionName

-- instance IsMap FieldName (ArgumentDefinition s) (DirectiveDefinition s) where
--   lookup key DirectiveDefinition {directiveDefinitionArgs} = lookup key directiveDefinitionArgs

lookupDeprecated :: Directives s -> Maybe (Directive s)
lookupDeprecated :: Directives s -> Maybe (Directive s)
lookupDeprecated = FieldName -> Directives s -> Maybe (Directive s)
forall k (m :: * -> *) a. IsMap k m => k -> m a -> Maybe a
lookup FieldName
"deprecated"

lookupDeprecatedReason :: Directive s -> Maybe Description
lookupDeprecatedReason :: Directive s -> Maybe Description
lookupDeprecatedReason Directive {Arguments s
directiveArgs :: Arguments s
directiveArgs :: forall (s :: Stage). Directive s -> Arguments s
directiveArgs} =
  Maybe Description
-> (Argument s -> Maybe Description)
-> FieldName
-> Arguments s
-> Maybe Description
forall k (c :: * -> *) d a.
IsMap k c =>
d -> (a -> d) -> k -> c a -> d
selectOr
    Maybe Description
forall a. Maybe a
Nothing
    Argument s -> Maybe Description
forall (s :: Stage). Argument s -> Maybe Description
argumentStringValue
    (FieldName
"reason" :: FieldName)
    Arguments s
directiveArgs

argumentStringValue :: Argument s -> Maybe Description
argumentStringValue :: Argument s -> Maybe Description
argumentStringValue Argument {argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue = Value s
Null} = Maybe Description
forall a. Maybe a
Nothing
argumentStringValue Argument {argumentValue :: forall (valid :: Stage). Argument valid -> Value valid
argumentValue = (Scalar (String Description
x))} = Description -> Maybe Description
forall a. a -> Maybe a
Just Description
x
argumentStringValue Argument s
_ = Description -> Maybe Description
forall a. a -> Maybe a
Just Description
"can't read deprecated Reason Value"

instance ToCategory FieldDefinition a ANY where
  toCategory :: FieldDefinition a s -> FieldDefinition ANY s
toCategory FieldDefinition {Maybe (FieldContent TRUE a s)
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE a s)
fieldContent, Maybe Description
Directives s
FieldName
TypeRef
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
..} = FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition {fieldContent :: Maybe (FieldContent TRUE ANY s)
fieldContent = FieldContent TRUE a s -> FieldContent TRUE ANY s
forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny (FieldContent TRUE a s -> FieldContent TRUE ANY s)
-> Maybe (FieldContent TRUE a s) -> Maybe (FieldContent TRUE ANY s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldContent TRUE a s)
fieldContent, Maybe Description
Directives s
FieldName
TypeRef
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
..}

instance ToCategory (FieldContent TRUE) a ANY where
  toCategory :: FieldContent TRUE a s -> FieldContent TRUE ANY s
toCategory (FieldArgs ArgumentsDefinition s
x) = ArgumentsDefinition s -> FieldContent (OUT <=? ANY) ANY s
forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs ArgumentsDefinition s
x
  toCategory (DefaultInputValue Value s
x) = Value s -> FieldContent (IN <=? ANY) ANY s
forall (s :: Stage) (cat :: TypeCategory).
Value s -> FieldContent (IN <=? cat) cat s
DefaultInputValue Value s
x

unsafeFromFields :: [FieldDefinition cat s] -> FieldsDefinition cat s
unsafeFromFields :: [FieldDefinition cat s] -> FieldsDefinition cat s
unsafeFromFields = [(FieldName, FieldDefinition cat s)] -> FieldsDefinition cat s
forall k (m :: * -> *) a. IsMap k m => [(k, a)] -> m a
unsafeFromList ([(FieldName, FieldDefinition cat s)] -> FieldsDefinition cat s)
-> ([FieldDefinition cat s]
    -> [(FieldName, FieldDefinition cat s)])
-> [FieldDefinition cat s]
-> FieldsDefinition cat s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDefinition cat s -> (FieldName, FieldDefinition cat s))
-> [FieldDefinition cat s] -> [(FieldName, FieldDefinition cat s)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition cat s -> (FieldName, FieldDefinition cat s)
forall k a. KeyOf k a => a -> (k, a)
toPair

fieldsToArguments :: FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments :: FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments = (FieldDefinition IN s -> ArgumentDefinition s)
-> FieldsDefinition IN s -> ArgumentsDefinition s
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FieldDefinition IN s -> ArgumentDefinition s
forall (s :: Stage). FieldDefinition IN s -> ArgumentDefinition s
ArgumentDefinition

-- 3.6 Objects : https://graphql.github.io/graphql-spec/June2018/#sec-Objects
------------------------------------------------------------------------------
--  ObjectTypeDefinition:
--    Description(opt) type Name ImplementsInterfaces(opt) Directives(Const)(opt) FieldsDefinition(opt)
--
--  ImplementsInterfaces
--    implements &(opt) NamedType
--    ImplementsInterfaces & NamedType
--
--  FieldsDefinition
--    { FieldDefinition(list) }
--
type FieldsDefinition cat s = OrdMap FieldName (FieldDefinition cat s)

--  FieldDefinition
--    Description(opt) Name ArgumentsDefinition(opt) : Type Directives(Const)(opt)
--
-- InputValueDefinition
--   Description(opt) Name: Type DefaultValue(opt) Directives[Const](opt)

data FieldDefinition (cat :: TypeCategory) (s :: Stage) = FieldDefinition
  { FieldDefinition cat s -> Maybe Description
fieldDescription :: Maybe Description,
    FieldDefinition cat s -> FieldName
fieldName :: FieldName,
    FieldDefinition cat s -> TypeRef
fieldType :: TypeRef,
    FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE cat s),
    FieldDefinition cat s -> Directives s
fieldDirectives :: Directives s
  }
  deriving (Int -> FieldDefinition cat s -> ShowS
[FieldDefinition cat s] -> ShowS
FieldDefinition cat s -> String
(Int -> FieldDefinition cat s -> ShowS)
-> (FieldDefinition cat s -> String)
-> ([FieldDefinition cat s] -> ShowS)
-> Show (FieldDefinition cat s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (cat :: TypeCategory) (s :: Stage).
Int -> FieldDefinition cat s -> ShowS
forall (cat :: TypeCategory) (s :: Stage).
[FieldDefinition cat s] -> ShowS
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> String
showList :: [FieldDefinition cat s] -> ShowS
$cshowList :: forall (cat :: TypeCategory) (s :: Stage).
[FieldDefinition cat s] -> ShowS
show :: FieldDefinition cat s -> String
$cshow :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> String
showsPrec :: Int -> FieldDefinition cat s -> ShowS
$cshowsPrec :: forall (cat :: TypeCategory) (s :: Stage).
Int -> FieldDefinition cat s -> ShowS
Show, FieldDefinition cat s -> Q Exp
FieldDefinition cat s -> Q (TExp (FieldDefinition cat s))
(FieldDefinition cat s -> Q Exp)
-> (FieldDefinition cat s -> Q (TExp (FieldDefinition cat s)))
-> Lift (FieldDefinition cat s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Q Exp
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Q (TExp (FieldDefinition cat s))
liftTyped :: FieldDefinition cat s -> Q (TExp (FieldDefinition cat s))
$cliftTyped :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Q (TExp (FieldDefinition cat s))
lift :: FieldDefinition cat s -> Q Exp
$clift :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Q Exp
Lift, FieldDefinition cat s -> FieldDefinition cat s -> Bool
(FieldDefinition cat s -> FieldDefinition cat s -> Bool)
-> (FieldDefinition cat s -> FieldDefinition cat s -> Bool)
-> Eq (FieldDefinition cat s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldDefinition cat s -> Bool
/= :: FieldDefinition cat s -> FieldDefinition cat s -> Bool
$c/= :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldDefinition cat s -> Bool
== :: FieldDefinition cat s -> FieldDefinition cat s -> Bool
$c== :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldDefinition cat s -> Bool
Eq)

data FieldContent (bool :: Bool) (cat :: TypeCategory) (s :: Stage) where
  DefaultInputValue ::
    { FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue :: Value s
    } ->
    FieldContent (IN <=? cat) cat s
  FieldArgs ::
    { FieldContent (OUT <=? cat) cat s -> ArgumentsDefinition s
fieldArgsDef :: ArgumentsDefinition s
    } ->
    FieldContent (OUT <=? cat) cat s

fieldArguments :: FieldDefinition c s -> ArgumentsDefinition s
fieldArguments :: FieldDefinition c s -> ArgumentsDefinition s
fieldArguments FieldDefinition {fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent = Just (FieldArgs ArgumentsDefinition s
args)} = ArgumentsDefinition s
args
fieldArguments FieldDefinition c s
_ = ArgumentsDefinition s
forall coll. Empty coll => coll
empty

deriving instance Eq (FieldContent bool cat s)

deriving instance Show (FieldContent bool cat s)

deriving instance Lift (FieldContent bool cat s)

instance KeyOf FieldName (FieldDefinition cat s) where
  keyOf :: FieldDefinition cat s -> FieldName
keyOf = FieldDefinition cat s -> FieldName
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName

instance NameCollision GQLError (FieldDefinition cat s) where
  nameCollision :: FieldDefinition cat s -> GQLError
nameCollision FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName} =
    GQLError
"There can Be only One field Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg FieldName
fieldName

instance RenderGQL (FieldDefinition cat s) where
  renderGQL :: FieldDefinition cat s -> Rendering
renderGQL FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, TypeRef
fieldType :: TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType, fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent = Just (FieldArgs ArgumentsDefinition s
args)} =
    FieldName -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL FieldName
fieldName Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> ArgumentsDefinition s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL ArgumentsDefinition s
args Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> Rendering
": " Rendering -> Rendering -> Rendering
forall a. Semigroup a => a -> a -> a
<> TypeRef -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL TypeRef
fieldType
  renderGQL FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName, TypeRef
fieldType :: TypeRef
fieldType :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType} =
    FieldName -> TypeRef -> Rendering
forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry FieldName
fieldName TypeRef
fieldType

instance RenderGQL (FieldsDefinition cat s) where
  renderGQL :: FieldsDefinition cat s -> Rendering
renderGQL = [FieldDefinition cat s] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderObject ([FieldDefinition cat s] -> Rendering)
-> (FieldsDefinition cat s -> [FieldDefinition cat s])
-> FieldsDefinition cat s
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FieldDefinition cat s -> Bool)
-> [FieldDefinition cat s] -> [FieldDefinition cat s]
forall a. (a -> Bool) -> [a] -> [a]
filter FieldDefinition cat s -> Bool
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Bool
fieldVisibility ([FieldDefinition cat s] -> [FieldDefinition cat s])
-> (FieldsDefinition cat s -> [FieldDefinition cat s])
-> FieldsDefinition cat s
-> [FieldDefinition cat s]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldsDefinition cat s -> [FieldDefinition cat s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance Nullable (FieldDefinition cat s) where
  isNullable :: FieldDefinition cat s -> Bool
isNullable = TypeRef -> Bool
forall a. Nullable a => a -> Bool
isNullable (TypeRef -> Bool)
-> (FieldDefinition cat s -> TypeRef)
-> FieldDefinition cat s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition cat s -> TypeRef
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType
  toNullable :: FieldDefinition cat s -> FieldDefinition cat s
toNullable FieldDefinition cat s
field = FieldDefinition cat s
field {fieldType :: TypeRef
fieldType = TypeRef -> TypeRef
forall a. Nullable a => a -> a
toNullable (FieldDefinition cat s -> TypeRef
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType FieldDefinition cat s
field)}

fieldVisibility :: FieldDefinition cat s -> Bool
fieldVisibility :: FieldDefinition cat s -> Bool
fieldVisibility = FieldName -> Bool
isNotSystemFieldName (FieldName -> Bool)
-> (FieldDefinition cat s -> FieldName)
-> FieldDefinition cat s
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldDefinition cat s -> FieldName
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName

mkField ::
  Maybe (FieldContent TRUE cat s) ->
  FieldName ->
  TypeRef ->
  FieldDefinition cat s
mkField :: Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField Maybe (FieldContent TRUE cat s)
fieldContent FieldName
fieldName TypeRef
fieldType =
  FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> Directives s
-> FieldDefinition cat s
FieldDefinition
    { FieldName
fieldName :: FieldName
fieldName :: FieldName
fieldName,
      Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldContent :: Maybe (FieldContent TRUE cat s)
fieldContent,
      fieldDescription :: Maybe Description
fieldDescription = Maybe Description
forall a. Maybe a
Nothing,
      TypeRef
fieldType :: TypeRef
fieldType :: TypeRef
fieldType,
      fieldDirectives :: Directives s
fieldDirectives = Directives s
forall coll. Empty coll => coll
empty
    }

mkObjectField ::
  ArgumentsDefinition s ->
  FieldName ->
  TypeWrapper ->
  TypeName ->
  FieldDefinition OUT s
mkObjectField :: ArgumentsDefinition s
-> FieldName -> TypeWrapper -> TypeName -> FieldDefinition OUT s
mkObjectField ArgumentsDefinition s
args FieldName
fieldName TypeWrapper
typeWrappers TypeName
typeConName =
  Maybe (FieldContent TRUE OUT s)
-> FieldName -> TypeRef -> FieldDefinition OUT s
forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField
    (FieldContent TRUE OUT s -> Maybe (FieldContent TRUE OUT s)
forall a. a -> Maybe a
Just (FieldContent TRUE OUT s -> Maybe (FieldContent TRUE OUT s))
-> FieldContent TRUE OUT s -> Maybe (FieldContent TRUE OUT s)
forall a b. (a -> b) -> a -> b
$ ArgumentsDefinition s -> FieldContent (OUT <=? OUT) OUT s
forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs ArgumentsDefinition s
args)
    FieldName
fieldName
    TypeRef :: TypeName -> TypeWrapper -> TypeRef
TypeRef {TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers :: TypeWrapper
typeWrappers, TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName}

-- 3.10 Input Objects: https://spec.graphql.org/June2018/#sec-Input-Objects
---------------------------------------------------------------------------
--- InputFieldsDefinition
-- { InputValueDefinition(list) }

type InputFieldsDefinition s = OrdMap FieldName (InputValueDefinition s)

type InputValueDefinition = FieldDefinition IN

-- 3.6.1 Field Arguments : https://graphql.github.io/graphql-spec/June2018/#sec-Field-Arguments
-----------------------------------------------------------------------------------------------
-- ArgumentsDefinition:
--   (InputValueDefinition(list))

type ArgumentsDefinition s = OrdMap FieldName (ArgumentDefinition s)

instance RenderGQL (ArgumentsDefinition s) where
  renderGQL :: ArgumentsDefinition s -> Rendering
renderGQL = [ArgumentDefinition s] -> Rendering
forall a. RenderGQL a => [a] -> Rendering
renderArguments ([ArgumentDefinition s] -> Rendering)
-> (ArgumentsDefinition s -> [ArgumentDefinition s])
-> ArgumentsDefinition s
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentsDefinition s -> [ArgumentDefinition s]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

instance RenderGQL (ArgumentDefinition s) where
  renderGQL :: ArgumentDefinition s -> Rendering
renderGQL = FieldDefinition IN s -> Rendering
forall a. RenderGQL a => a -> Rendering
renderGQL (FieldDefinition IN s -> Rendering)
-> (ArgumentDefinition s -> FieldDefinition IN s)
-> ArgumentDefinition s
-> Rendering
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentDefinition s -> FieldDefinition IN s
forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument

newtype ArgumentDefinition s = ArgumentDefinition
  { ArgumentDefinition s -> FieldDefinition IN s
argument :: FieldDefinition IN s
  }
  deriving (Int -> ArgumentDefinition s -> ShowS
[ArgumentDefinition s] -> ShowS
ArgumentDefinition s -> String
(Int -> ArgumentDefinition s -> ShowS)
-> (ArgumentDefinition s -> String)
-> ([ArgumentDefinition s] -> ShowS)
-> Show (ArgumentDefinition s)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (s :: Stage). Int -> ArgumentDefinition s -> ShowS
forall (s :: Stage). [ArgumentDefinition s] -> ShowS
forall (s :: Stage). ArgumentDefinition s -> String
showList :: [ArgumentDefinition s] -> ShowS
$cshowList :: forall (s :: Stage). [ArgumentDefinition s] -> ShowS
show :: ArgumentDefinition s -> String
$cshow :: forall (s :: Stage). ArgumentDefinition s -> String
showsPrec :: Int -> ArgumentDefinition s -> ShowS
$cshowsPrec :: forall (s :: Stage). Int -> ArgumentDefinition s -> ShowS
Show, ArgumentDefinition s -> Q Exp
ArgumentDefinition s -> Q (TExp (ArgumentDefinition s))
(ArgumentDefinition s -> Q Exp)
-> (ArgumentDefinition s -> Q (TExp (ArgumentDefinition s)))
-> Lift (ArgumentDefinition s)
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
forall (s :: Stage). ArgumentDefinition s -> Q Exp
forall (s :: Stage).
ArgumentDefinition s -> Q (TExp (ArgumentDefinition s))
liftTyped :: ArgumentDefinition s -> Q (TExp (ArgumentDefinition s))
$cliftTyped :: forall (s :: Stage).
ArgumentDefinition s -> Q (TExp (ArgumentDefinition s))
lift :: ArgumentDefinition s -> Q Exp
$clift :: forall (s :: Stage). ArgumentDefinition s -> Q Exp
Lift, ArgumentDefinition s -> ArgumentDefinition s -> Bool
(ArgumentDefinition s -> ArgumentDefinition s -> Bool)
-> (ArgumentDefinition s -> ArgumentDefinition s -> Bool)
-> Eq (ArgumentDefinition s)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage).
ArgumentDefinition s -> ArgumentDefinition s -> Bool
/= :: ArgumentDefinition s -> ArgumentDefinition s -> Bool
$c/= :: forall (s :: Stage).
ArgumentDefinition s -> ArgumentDefinition s -> Bool
== :: ArgumentDefinition s -> ArgumentDefinition s -> Bool
$c== :: forall (s :: Stage).
ArgumentDefinition s -> ArgumentDefinition s -> Bool
Eq)

instance KeyOf FieldName (ArgumentDefinition s) where
  keyOf :: ArgumentDefinition s -> FieldName
keyOf = FieldDefinition IN s -> FieldName
forall k a. KeyOf k a => a -> k
keyOf (FieldDefinition IN s -> FieldName)
-> (ArgumentDefinition s -> FieldDefinition IN s)
-> ArgumentDefinition s
-> FieldName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ArgumentDefinition s -> FieldDefinition IN s
forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument

instance NameCollision GQLError (ArgumentDefinition s) where
  nameCollision :: ArgumentDefinition s -> GQLError
nameCollision ArgumentDefinition {FieldDefinition IN s
argument :: FieldDefinition IN s
argument :: forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument} =
    GQLError
"There can Be only One argument Named " GQLError -> GQLError -> GQLError
forall a. Semigroup a => a -> a -> a
<> FieldName -> GQLError
forall a. Msg a => a -> GQLError
msg (FieldDefinition IN s -> FieldName
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName FieldDefinition IN s
argument)