{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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,
    addDirectives,
  )
where

import Data.Mergeable
  ( IsMap (lookup),
    NameCollision (..),
    OrdMap,
  )
import Data.Mergeable.SafeHashMap (SafeHashMap)
import Data.Morpheus.Internal.Utils
  ( Empty (..),
    KeyOf (..),
    selectOr,
    toPair,
    unsafeFromList,
  )
import Data.Morpheus.Rendering.RenderGQL
  ( RenderGQL (..),
    Rendering,
    intercalate,
    newline,
    nonNillSpace,
    renderArguments,
    renderEntry,
    renderObject,
    space,
    unwords,
  )
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, unwords)

-- scalar
------------------------------------------------------------------
data Argument (valid :: Stage) = Argument
  { forall (valid :: Stage). Argument valid -> Position
argumentPosition :: Position,
    forall (valid :: Stage). Argument valid -> Name 'FIELD
argumentName :: FieldName,
    forall (valid :: Stage). Argument valid -> Value valid
argumentValue :: Value valid
  }
  deriving (Int -> Argument valid -> ShowS
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
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (valid :: Stage) (m :: * -> *).
Quote m =>
Argument valid -> m Exp
forall (valid :: Stage) (m :: * -> *).
Quote m =>
Argument valid -> Code m (Argument valid)
forall (m :: * -> *). Quote m => Argument valid -> m Exp
forall (m :: * -> *).
Quote m =>
Argument valid -> Code m (Argument valid)
liftTyped :: forall (m :: * -> *).
Quote m =>
Argument valid -> Code m (Argument valid)
$cliftTyped :: forall (valid :: Stage) (m :: * -> *).
Quote m =>
Argument valid -> Code m (Argument valid)
lift :: forall (m :: * -> *). Quote m => Argument valid -> m Exp
$clift :: forall (valid :: Stage) (m :: * -> *).
Quote m =>
Argument valid -> m Exp
Lift, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (valid :: Stage) x. Rep (Argument valid) x -> Argument valid
forall (valid :: Stage) x. Argument valid -> Rep (Argument valid) x
$cto :: forall (valid :: Stage) x. Rep (Argument valid) x -> Argument valid
$cfrom :: forall (valid :: Stage) x. Argument valid -> Rep (Argument valid) x
Generic, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (valid :: Stage). Eq (Argument valid)
forall (valid :: Stage). Int -> Argument valid -> Int
forall (valid :: Stage). Argument valid -> Int
hash :: Argument valid -> Int
$chash :: forall (valid :: Stage). Argument valid -> Int
hashWithSalt :: Int -> Argument valid -> Int
$chashWithSalt :: forall (valid :: Stage). Int -> Argument valid -> Int
Hashable)

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

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

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

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

renderArgumentValues :: Arguments s -> Rendering
renderArgumentValues :: forall (s :: Stage). Arguments s -> Rendering
renderArgumentValues = forall a. RenderGQL a => [a] -> Rendering
renderArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall {valid :: Stage}. Argument valid -> Bool
notNull forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
  { forall (s :: Stage). Directive s -> Position
directivePosition :: Position,
    forall (s :: Stage). Directive s -> Name 'FIELD
directiveName :: FieldName,
    forall (s :: Stage). Directive s -> Arguments s
directiveArgs :: Arguments s
  }
  deriving (Int -> Directive s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *). Quote m => Directive s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
Directive s -> Code m (Directive s)
forall (m :: * -> *). Quote m => Directive s -> m Exp
forall (m :: * -> *).
Quote m =>
Directive s -> Code m (Directive s)
liftTyped :: forall (m :: * -> *).
Quote m =>
Directive s -> Code m (Directive s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
Directive s -> Code m (Directive s)
lift :: forall (m :: * -> *). Quote m => Directive s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *). Quote m => Directive s -> m Exp
Lift, Directive s -> Directive s -> Bool
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, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (s :: Stage) x. Rep (Directive s) x -> Directive s
forall (s :: Stage) x. Directive s -> Rep (Directive s) x
$cto :: forall (s :: Stage) x. Rep (Directive s) x -> Directive s
$cfrom :: forall (s :: Stage) x. Directive s -> Rep (Directive s) x
Generic, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall (s :: Stage). Eq (Directive s)
forall (s :: Stage). Int -> Directive s -> Int
forall (s :: Stage). Directive s -> Int
hash :: Directive s -> Int
$chash :: forall (s :: Stage). Directive s -> Int
hashWithSalt :: Int -> Directive s -> Int
$chashWithSalt :: forall (s :: Stage). Int -> Directive s -> Int
Hashable)

instance NameCollision GQLError (Directive s) where
  nameCollision :: Directive s -> GQLError
nameCollision Directive {Name 'FIELD
directiveName :: Name 'FIELD
directiveName :: forall (s :: Stage). Directive s -> Name 'FIELD
directiveName} =
    GQLError
"The directive "
      forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (Name 'FIELD
"@" forall a. Semigroup a => a -> a -> a
<> Name 'FIELD
directiveName)
      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 -> Name 'FIELD
keyOf = forall (s :: Stage). Directive s -> Name 'FIELD
directiveName

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

instance RenderGQL (Directives s) where
  renderGQL :: Directives s -> Rendering
renderGQL Directives s
dirs = [Rendering] -> Rendering
unwords (forall a. RenderGQL a => a -> Rendering
renderGQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Directives s
dirs)

type Directives s = OrdMap FieldName (Directive s)

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

data DirectiveDefinition s = DirectiveDefinition
  { forall (s :: Stage). DirectiveDefinition s -> Name 'FIELD
directiveDefinitionName :: FieldName,
    forall (s :: Stage). DirectiveDefinition s -> Maybe Description
directiveDefinitionDescription :: Maybe Description,
    forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionArgs :: ArgumentsDefinition s,
    forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionLocations :: [DirectiveLocation]
  }
  deriving (Int -> DirectiveDefinition s -> ShowS
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 -> DirectiveDefinition s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (s :: Stage).
DirectiveDefinition s -> DirectiveDefinition s -> Bool
/= :: DirectiveDefinition s -> DirectiveDefinition s -> Bool
$c/= :: forall (s :: Stage).
DirectiveDefinition s -> DirectiveDefinition s -> Bool
== :: DirectiveDefinition s -> DirectiveDefinition s -> Bool
$c== :: forall (s :: Stage).
DirectiveDefinition s -> DirectiveDefinition s -> Bool
Eq, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *).
Quote m =>
DirectiveDefinition s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
DirectiveDefinition s -> Code m (DirectiveDefinition s)
forall (m :: * -> *). Quote m => DirectiveDefinition s -> m Exp
forall (m :: * -> *).
Quote m =>
DirectiveDefinition s -> Code m (DirectiveDefinition s)
liftTyped :: forall (m :: * -> *).
Quote m =>
DirectiveDefinition s -> Code m (DirectiveDefinition s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DirectiveDefinition s -> Code m (DirectiveDefinition s)
lift :: forall (m :: * -> *). Quote m => DirectiveDefinition s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *).
Quote m =>
DirectiveDefinition s -> m Exp
Lift)

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

type DirectivesDefinition s = SafeHashMap FieldName (DirectiveDefinition s)

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

instance RenderGQL (DirectiveDefinition s) where
  renderGQL :: DirectiveDefinition s -> Rendering
renderGQL DirectiveDefinition {[DirectiveLocation]
Maybe Description
ArgumentsDefinition s
Name 'FIELD
directiveDefinitionLocations :: [DirectiveLocation]
directiveDefinitionArgs :: ArgumentsDefinition s
directiveDefinitionDescription :: Maybe Description
directiveDefinitionName :: Name 'FIELD
directiveDefinitionLocations :: forall (s :: Stage). DirectiveDefinition s -> [DirectiveLocation]
directiveDefinitionArgs :: forall (s :: Stage). DirectiveDefinition s -> ArgumentsDefinition s
directiveDefinitionDescription :: forall (s :: Stage). DirectiveDefinition s -> Maybe Description
directiveDefinitionName :: forall (s :: Stage). DirectiveDefinition s -> Name 'FIELD
..} =
    Rendering
"directive"
      forall a. Semigroup a => a -> a -> a
<> Rendering
space
      forall a. Semigroup a => a -> a -> a
<> Rendering
"@"
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL Name 'FIELD
directiveDefinitionName
      forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL ArgumentsDefinition s
directiveDefinitionArgs
      forall a. Semigroup a => a -> a -> a
<> Rendering
space
      forall a. Semigroup a => a -> a -> a
<> Rendering
"on"
      forall a. Semigroup a => a -> a -> a
<> Rendering
space
      forall a. Semigroup a => a -> a -> a
<> Rendering -> [Rendering] -> Rendering
intercalate Rendering
" | " (forall a. RenderGQL a => a -> Rendering
renderGQL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DirectiveLocation]
directiveDefinitionLocations)
      forall a. Semigroup a => a -> a -> a
<> Rendering
newline

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

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

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

instance ToCategory FieldDefinition a ANY where
  toCategory :: forall (s :: Stage). 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
Name 'FIELD
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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
..} = FieldDefinition {fieldContent :: Maybe (FieldContent 'True ANY s)
fieldContent = forall (a :: TypeCategory -> Stage -> *) (k :: TypeCategory)
       (s :: Stage).
ToCategory a k ANY =>
a k s -> a ANY s
toAny forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (FieldContent 'True a s)
fieldContent, Maybe Description
Directives s
Name 'FIELD
TypeRef
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
..}

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

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

fieldsToArguments :: FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments :: forall (s :: Stage). FieldsDefinition IN s -> ArgumentsDefinition s
fieldsToArguments = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap 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
  { forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldDescription :: Maybe Description,
    forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Name 'FIELD
fieldName :: FieldName,
    forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType :: TypeRef,
    forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent 'True cat s)
fieldContent :: Maybe (FieldContent TRUE cat s),
    forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Directives s
fieldDirectives :: Directives s
  }
  deriving (Int -> FieldDefinition cat s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (cat :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
FieldDefinition cat s -> m Exp
forall (cat :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
FieldDefinition cat s -> Code m (FieldDefinition cat s)
forall (m :: * -> *). Quote m => FieldDefinition cat s -> m Exp
forall (m :: * -> *).
Quote m =>
FieldDefinition cat s -> Code m (FieldDefinition cat s)
liftTyped :: forall (m :: * -> *).
Quote m =>
FieldDefinition cat s -> Code m (FieldDefinition cat s)
$cliftTyped :: forall (cat :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
FieldDefinition cat s -> Code m (FieldDefinition cat s)
lift :: forall (m :: * -> *). Quote m => FieldDefinition cat s -> m Exp
$clift :: forall (cat :: TypeCategory) (s :: Stage) (m :: * -> *).
Quote m =>
FieldDefinition cat s -> m Exp
Lift, FieldDefinition cat s -> FieldDefinition cat s -> Bool
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 ::
    { forall (s :: Stage) (cat :: TypeCategory).
FieldContent (IN <=? cat) cat s -> Value s
defaultInputValue :: Value s
    } ->
    FieldContent (IN <=? cat) cat s
  FieldArgs ::
    { forall (s :: Stage) (cat :: TypeCategory).
FieldContent (OUT <=? cat) cat s -> ArgumentsDefinition s
fieldArgsDef :: ArgumentsDefinition s
    } ->
    FieldContent (OUT <=? cat) cat s

fieldArguments :: FieldDefinition c s -> ArgumentsDefinition s
fieldArguments :: forall (c :: TypeCategory) (s :: Stage).
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
_ = 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 -> Name 'FIELD
keyOf = forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Name 'FIELD
fieldName

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

instance RenderGQL (FieldDefinition cat s) where
  renderGQL :: FieldDefinition cat s -> Rendering
renderGQL FieldDefinition {fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent 'True cat s)
fieldContent = Just (FieldArgs ArgumentsDefinition s
args), Maybe Description
Directives s
Name 'FIELD
TypeRef
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
..} =
    forall a. RenderGQL a => a -> Rendering
renderGQL Name 'FIELD
fieldName forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL ArgumentsDefinition s
args forall a. Semigroup a => a -> a -> a
<> Rendering
": " forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL TypeRef
fieldType forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
fieldDirectives
  renderGQL FieldDefinition {fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent 'True cat s)
fieldContent = Just (DefaultInputValue Value s
x), Maybe Description
Directives s
Name 'FIELD
TypeRef
fieldDirectives :: Directives s
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
..} =
    forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry Name 'FIELD
fieldName TypeRef
fieldType forall a. Semigroup a => a -> a -> a
<> Rendering
" = " forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL Value s
x forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
fieldDirectives
  renderGQL FieldDefinition {Maybe Description
Maybe (FieldContent 'True cat s)
Directives s
Name 'FIELD
TypeRef
fieldDirectives :: Directives s
fieldContent :: Maybe (FieldContent 'True cat s)
fieldType :: TypeRef
fieldName :: Name 'FIELD
fieldDescription :: Maybe Description
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 -> Name 'FIELD
fieldDescription :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe Description
fieldContent :: forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Maybe (FieldContent 'True cat s)
..} =
    forall name value.
(RenderGQL name, RenderGQL value) =>
name -> value -> Rendering
renderEntry Name 'FIELD
fieldName TypeRef
fieldType forall a. Semigroup a => a -> a -> a
<> forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
fieldDirectives

addDirectives :: Directives s -> Rendering
addDirectives :: forall (s :: Stage). Directives s -> Rendering
addDirectives Directives s
dirs = forall (t :: * -> *) a. Foldable t => t a -> Rendering
nonNillSpace Directives s
dirs forall a. Semigroup a => a -> a -> a
<> forall a. RenderGQL a => a -> Rendering
renderGQL Directives s
dirs

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

instance Nullable (FieldDefinition cat s) where
  isNullable :: FieldDefinition cat s -> Bool
isNullable = forall a. Nullable a => a -> Bool
isNullable forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Nullable a => a -> a
toNullable (forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> TypeRef
fieldType FieldDefinition cat s
field)}

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

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

mkObjectField ::
  ArgumentsDefinition s ->
  FieldName ->
  TypeWrapper ->
  TypeName ->
  FieldDefinition OUT s
mkObjectField :: forall (s :: Stage).
ArgumentsDefinition s
-> Name 'FIELD -> TypeWrapper -> TypeName -> FieldDefinition OUT s
mkObjectField ArgumentsDefinition s
args Name 'FIELD
fieldName TypeWrapper
typeWrappers TypeName
typeConName =
  forall (cat :: TypeCategory) (s :: Stage).
Maybe (FieldContent 'True cat s)
-> Name 'FIELD -> TypeRef -> FieldDefinition cat s
mkField
    (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (s :: Stage) (cat :: TypeCategory).
ArgumentsDefinition s -> FieldContent (OUT <=? cat) cat s
FieldArgs ArgumentsDefinition s
args)
    Name 'FIELD
fieldName
    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 = forall a. RenderGQL a => [a] -> Rendering
renderArguments forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList

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

newtype ArgumentDefinition s = ArgumentDefinition
  { forall (s :: Stage). ArgumentDefinition s -> FieldDefinition IN s
argument :: FieldDefinition IN s
  }
  deriving (Int -> ArgumentDefinition s -> ShowS
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, forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (s :: Stage) (m :: * -> *).
Quote m =>
ArgumentDefinition s -> m Exp
forall (s :: Stage) (m :: * -> *).
Quote m =>
ArgumentDefinition s -> Code m (ArgumentDefinition s)
forall (m :: * -> *). Quote m => ArgumentDefinition s -> m Exp
forall (m :: * -> *).
Quote m =>
ArgumentDefinition s -> Code m (ArgumentDefinition s)
liftTyped :: forall (m :: * -> *).
Quote m =>
ArgumentDefinition s -> Code m (ArgumentDefinition s)
$cliftTyped :: forall (s :: Stage) (m :: * -> *).
Quote m =>
ArgumentDefinition s -> Code m (ArgumentDefinition s)
lift :: forall (m :: * -> *). Quote m => ArgumentDefinition s -> m Exp
$clift :: forall (s :: Stage) (m :: * -> *).
Quote m =>
ArgumentDefinition s -> m Exp
Lift, ArgumentDefinition s -> ArgumentDefinition s -> Bool
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 -> Name 'FIELD
keyOf = forall k a. KeyOf k a => a -> k
keyOf forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 " forall a. Semigroup a => a -> a -> a
<> forall a. Msg a => a -> GQLError
msg (forall (cat :: TypeCategory) (s :: Stage).
FieldDefinition cat s -> Name 'FIELD
fieldName FieldDefinition IN s
argument)