{-# 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,
    DirectiveDefinitions,
    DirectiveDefinition (..),
    Directives,
    Directive (..),
    fieldVisibility,
    lookupDeprecated,
    lookupDeprecatedReason,
    unsafeFromFields,
    fieldsToArguments,
    fieldContentArgs,
    mkInputValue,
    mkObjectField,
    mkField,
    renderArgumentValues,
    renderDirectives,
  )
where

import Data.Morpheus.Error.NameCollision
  ( NameCollision (..),
  )
import Data.Morpheus.Ext.OrdMap
  ( OrdMap,
    unsafeFromList,
  )
import Data.Morpheus.Internal.Utils
  ( Elems (..),
    Empty (..),
    KeyOf (..),
    Selectable (..),
    toPair,
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    intercalate,
    renderArguments,
    renderEntry,
    renderObject,
    space,
  )
import Data.Morpheus.Types.Internal.AST.Base
  ( Description,
    FieldName,
    FieldName (..),
    Msg (..),
    Position,
    TRUE,
    TypeName,
    ValidationError (..),
    msgValidation,
    sysFields,
  )
import Data.Morpheus.Types.Internal.AST.DirectiveLocation (DirectiveLocation)
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 (Argument s) where
  nameCollision :: Argument s -> ValidationError
nameCollision Argument {FieldName
argumentName :: FieldName
argumentName :: forall (stage :: Stage). Argument stage -> FieldName
argumentName, Position
argumentPosition :: Position
argumentPosition :: forall (valid :: Stage). Argument valid -> Position
argumentPosition} =
    ValidationError :: Message -> [Position] -> ValidationError
ValidationError
      { validationMessage :: Message
validationMessage = Message
"There can Be only One Argument Named " Message -> Message -> Message
forall a. Semigroup a => a -> a -> a
<> FieldName -> Message
forall a. Msg a => a -> Message
msg FieldName
argumentName,
        validationLocations :: [Position]
validationLocations = [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 a coll. Elems a coll => coll -> [a]
elems
  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 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 {Position
FieldName
Arguments s
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 = [Directive s]

renderDirectives :: Directives s -> Rendering
renderDirectives :: Directives s -> Rendering
renderDirectives Directives s
xs
  | Directives s -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Directives 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) -> Directives 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 Directives s
dirs)
  where
    dirs :: Directives s
dirs = (Directive s -> Bool) -> Directives s -> Directives s
forall a. (a -> Bool) -> [a] -> [a]
filter Directive s -> Bool
forall (s :: Stage). Directive s -> Bool
notSystem 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)

type DirectiveDefinitions s = [DirectiveDefinition s]

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

instance Selectable FieldName (ArgumentDefinition s) (DirectiveDefinition s) where
  selectOr :: d
-> (ArgumentDefinition s -> d)
-> FieldName
-> DirectiveDefinition s
-> d
selectOr d
fb ArgumentDefinition s -> d
f FieldName
key DirectiveDefinition {ArgumentsDefinition s
directiveDefinitionArgs :: ArgumentsDefinition s
directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionArgs} =
    d
-> (ArgumentDefinition s -> d)
-> FieldName
-> ArgumentsDefinition s
-> d
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr d
fb ArgumentDefinition s -> d
f FieldName
key ArgumentsDefinition s
directiveDefinitionArgs

lookupDeprecated :: [Directive s] -> Maybe (Directive s)
lookupDeprecated :: [Directive s] -> Maybe (Directive s)
lookupDeprecated = (Directive s -> Bool) -> [Directive s] -> Maybe (Directive s)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Directive s -> Bool
forall (s :: Stage). Directive s -> Bool
isDeprecation
  where
    isDeprecation :: Directive s -> Bool
isDeprecation Directive {directiveName :: forall (s :: Stage). Directive s -> FieldName
directiveName = FieldName
"deprecated"} = Bool
True
    isDeprecation Directive s
_ = Bool
False

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 a c d. Selectable k a c => d -> (a -> d) -> k -> c -> 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, [Directive s]
Maybe Description
FieldName
TypeRef
fieldDirectives :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> [Directive 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 :: [Directive s]
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
..} = FieldDefinition :: forall (cat :: TypeCategory) (s :: Stage).
Maybe Description
-> FieldName
-> TypeRef
-> Maybe (FieldContent TRUE cat s)
-> [Directive 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, [Directive s]
Maybe Description
FieldName
TypeRef
fieldDirectives :: [Directive s]
fieldType :: TypeRef
fieldName :: FieldName
fieldDescription :: Maybe Description
fieldDirectives :: [Directive 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 a. (Hashable k, Eq k) => [(k, a)] -> OrdMap k 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 -> [Directive s]
fieldDirectives :: [Directive 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

fieldContentArgs :: FieldContent b cat s -> ArgumentsDefinition s
fieldContentArgs :: FieldContent b cat s -> ArgumentsDefinition s
fieldContentArgs (FieldArgs ArgumentsDefinition s
args) = ArgumentsDefinition s
args
fieldContentArgs FieldContent b cat 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 Selectable FieldName (ArgumentDefinition s) (FieldDefinition OUT s) where
  selectOr :: d
-> (ArgumentDefinition s -> d)
-> FieldName
-> FieldDefinition OUT s
-> d
selectOr d
fb ArgumentDefinition s -> d
f FieldName
key FieldDefinition {fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent TRUE cat s)
fieldContent = Just (FieldArgs ArgumentsDefinition s
args)} = d
-> (ArgumentDefinition s -> d)
-> FieldName
-> ArgumentsDefinition s
-> d
forall k a c d. Selectable k a c => d -> (a -> d) -> k -> c -> d
selectOr d
fb ArgumentDefinition s -> d
f FieldName
key ArgumentsDefinition s
args
  selectOr d
fb ArgumentDefinition s -> d
_ FieldName
_ FieldDefinition OUT s
_ = d
fb

instance NameCollision (FieldDefinition cat s) where
  nameCollision :: FieldDefinition cat s -> ValidationError
nameCollision FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName} =
    ValidationError
"There can Be only One field Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> FieldName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation 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 a coll. Elems a coll => coll -> [a]
elems

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 FieldDefinition {FieldName
fieldName :: FieldName
fieldName :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName} = FieldName
fieldName FieldName -> [FieldName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [FieldName]
sysFields

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)
-> [Directive 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 :: [Directive s]
fieldDirectives = []
    }

mkInputValue :: FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition cat s
mkInputValue :: FieldName -> [TypeWrapper] -> TypeName -> FieldDefinition cat s
mkInputValue FieldName
fieldName [TypeWrapper]
typeWrappers TypeName
typeConName =
  Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent TRUE cat s)
-> FieldName -> TypeRef -> FieldDefinition cat s
mkField
    Maybe (FieldContent TRUE cat s)
forall a. Maybe a
Nothing
    FieldName
fieldName
    TypeRef :: TypeName -> [TypeWrapper] -> TypeRef
TypeRef {[TypeWrapper]
typeWrappers :: [TypeWrapper]
typeWrappers :: [TypeWrapper]
typeWrappers, TypeName
typeConName :: TypeName
typeConName :: TypeName
typeConName}

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 a coll. Elems a coll => coll -> [a]
elems

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 (ArgumentDefinition s) where
  nameCollision :: ArgumentDefinition s -> ValidationError
nameCollision ArgumentDefinition {FieldDefinition IN s
argument :: FieldDefinition IN s
argument :: forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument} =
    ValidationError
"There can Be only One argument Named " ValidationError -> ValidationError -> ValidationError
forall a. Semigroup a => a -> a -> a
<> FieldName -> ValidationError
forall a. Msg a => a -> ValidationError
msgValidation (FieldDefinition IN s -> FieldName
forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> FieldName
fieldName FieldDefinition IN s
argument)