{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Data.Morpheus.Server.Types.GQLType
  ( GQLType
      ( KIND,
        description,
        getDescriptions,
        typeOptions,
        getDirectives,
        defaultValues,
        directives,
        __type,
        __isEmptyType
      ),
    __typeData,
    deriveTypename,
    deriveFingerprint,
    encodeArguments,
    DirectiveUsage (..),
    DeriveArguments (..),
    applyOnTypeName,
    DirectiveUsages (..),
    typeDirective,
    fieldDirective,
    enumDirective,
  )
where

-- MORPHEUS

import Control.Monad.Except (MonadError (throwError))
import qualified Data.HashMap.Strict as M
import Data.Morpheus.App.Internal.Resolving
  ( Resolver,
    SubscriptionField,
  )
import Data.Morpheus.Internal.Ext
import Data.Morpheus.Internal.Utils
import Data.Morpheus.Kind
  ( CUSTOM,
    DerivingKind (..),
    SCALAR,
    TYPE,
    WRAPPER,
  )
import Data.Morpheus.NamedResolvers (NamedResolverT (..))
import Data.Morpheus.Server.Deriving.Utils (ConsRep (..), DataType (..), DeriveWith, FieldRep (..))
import Data.Morpheus.Server.Deriving.Utils.DeriveGType (DeriveValueOptions (..), deriveValue)
import Data.Morpheus.Server.Deriving.Utils.Kinded (CategoryValue (..), KindedProxy (KindedProxy), kinded)
import Data.Morpheus.Server.Deriving.Utils.Proxy (ContextValue (..))
import Data.Morpheus.Server.Types.Directives
  ( GQLDirective (..),
    ToLocations,
    visitTypeName,
  )
import Data.Morpheus.Server.Types.Internal
  ( GQLTypeOptions (..),
    TypeData (..),
    defaultTypeOptions,
    mkTypeData,
    prefixInputs,
  )
import Data.Morpheus.Server.Types.SchemaT (SchemaT)
import Data.Morpheus.Server.Types.TypeName
  ( TypeFingerprint,
    getFingerprint,
    getTypename,
  )
import Data.Morpheus.Server.Types.Types
  ( Arg,
    Pair,
    TypeGuard,
    Undefined (..),
  )
import Data.Morpheus.Types.GQLScalar (EncodeScalar (..))
import Data.Morpheus.Types.GQLWrapper (EncodeWrapperValue (..))
import Data.Morpheus.Types.ID (ID)
import Data.Morpheus.Types.Internal.AST
  ( Argument (..),
    Arguments,
    ArgumentsDefinition,
    CONST,
    Description,
    Directives,
    FieldName,
    IN,
    OUT,
    ObjectEntry (..),
    Position (..),
    TypeCategory (..),
    TypeName,
    TypeWrapper (..),
    Value (..),
    internal,
    mkBaseType,
    packName,
    toNullable,
    unpackName,
  )
import Data.Sequence (Seq)
import Data.Text
  ( pack,
    unpack,
  )
import Data.Vector (Vector)
import GHC.Generics
import Relude hiding (Seq, Undefined, fromList, intercalate)

__typeData ::
  forall kinded (kind :: TypeCategory) (a :: Type).
  (GQLType a, CategoryValue kind) =>
  kinded kind a ->
  TypeData
__typeData :: forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
proxy = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type kinded kind a
proxy (forall (c :: TypeCategory) (f :: TypeCategory -> *).
CategoryValue c =>
f c -> TypeCategory
categoryValue (forall {k} (t :: k). Proxy t
Proxy @kind))

deriveTypename :: (GQLType a, CategoryValue kind) => kinded kind a -> TypeName
deriveTypename :: forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeName
deriveTypename kinded kind a
proxy = TypeData -> TypeName
gqlTypeName forall a b. (a -> b) -> a -> b
$ forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
proxy

deriveFingerprint :: (GQLType a, CategoryValue kind) => kinded kind a -> TypeFingerprint
deriveFingerprint :: forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeFingerprint
deriveFingerprint kinded kind a
proxy = TypeData -> TypeFingerprint
gqlFingerprint forall a b. (a -> b) -> a -> b
$ forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData kinded kind a
proxy

deriveTypeData :: Typeable a => f a -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData :: forall a (f :: * -> *).
Typeable a =>
f a -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData f a
proxy Bool -> String -> String
typeNameModifier TypeCategory
cat =
  TypeData
    { gqlTypeName :: TypeName
gqlTypeName = forall a (t :: NAME). NamePacking a => a -> Name t
packName forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
pack forall a b. (a -> b) -> a -> b
$ Bool -> String -> String
typeNameModifier (TypeCategory
cat forall a. Eq a => a -> a -> Bool
== TypeCategory
IN) String
originalTypeName,
      gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper
mkBaseType,
      gqlFingerprint :: TypeFingerprint
gqlFingerprint = forall a (f :: * -> *).
Typeable a =>
TypeCategory -> f a -> TypeFingerprint
getFingerprint TypeCategory
cat f a
proxy
    }
  where
    originalTypeName :: String
originalTypeName = Text -> String
unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (t :: NAME). NamePacking a => Name t -> a
unpackName forall a b. (a -> b) -> a -> b
$ forall a (f :: * -> *). Typeable a => f a -> TypeName
getTypename f a
proxy

list :: TypeWrapper -> TypeWrapper
list :: TypeWrapper -> TypeWrapper
list = forall a b c. (a -> b -> c) -> b -> a -> c
flip TypeWrapper -> Bool -> TypeWrapper
TypeList Bool
True

wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper :: (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
f TypeData {TypeWrapper
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlFingerprint :: TypeData -> TypeFingerprint
gqlTypeName :: TypeData -> TypeName
..} = TypeData {gqlWrappers :: TypeWrapper
gqlWrappers = TypeWrapper -> TypeWrapper
f TypeWrapper
gqlWrappers, TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
gqlFingerprint :: TypeFingerprint
gqlTypeName :: TypeName
..}

-- | GraphQL type, every graphQL type should have an instance of 'GHC.Generics.Generic' and 'GQLType'.
--
--  @
--    ... deriving (Generic, GQLType)
--  @
--
-- if you want to add description
--
--  @
--       ... deriving (Generic)
--
--     instance GQLType ... where
--       description = const "your description ..."
--  @
{-# DEPRECATED getDirectives "use: directives" #-}

class GQLType a where
  type KIND a :: DerivingKind
  type KIND a = TYPE

  -- | A description of the type.
  --
  -- Used for documentation in the GraphQL schema.
  description :: f a -> Maybe Text
  description f a
_ = forall a. Maybe a
Nothing

  directives :: f a -> DirectiveUsages
  directives f a
_ = forall a. Monoid a => a
mempty

  -- | A dictionary of descriptions for fields, keyed on field name.
  --
  -- Used for documentation in the GraphQL schema.
  getDescriptions :: f a -> Map Text Description
  getDescriptions f a
_ = forall a. Monoid a => a
mempty

  typeOptions :: f a -> GQLTypeOptions -> GQLTypeOptions
  typeOptions f a
_ = forall a. a -> a
id

  getDirectives :: f a -> Map Text (Directives CONST)
  getDirectives f a
_ = forall a. Monoid a => a
mempty

  defaultValues :: f a -> Map Text (Value CONST)
  defaultValues f a
_ = forall a. Monoid a => a
mempty

  __isEmptyType :: f a -> Bool
  __isEmptyType f a
_ = Bool
False

  __type :: f a -> TypeCategory -> TypeData
  default __type :: Typeable a => f a -> TypeCategory -> TypeData
  __type f a
proxy TypeCategory
category = TypeData -> DirectiveUsages -> TypeData
editTypeData TypeData
derivedType (forall a (f :: * -> *). GQLType a => f a -> DirectiveUsages
directives f a
proxy)
    where
      derivedType :: TypeData
derivedType = forall a (f :: * -> *).
Typeable a =>
f a -> (Bool -> String -> String) -> TypeCategory -> TypeData
deriveTypeData f a
proxy Bool -> String -> String
typeNameModifier TypeCategory
category
      GQLTypeOptions {Bool -> String -> String
typeNameModifier :: GQLTypeOptions -> Bool -> String -> String
typeNameModifier :: Bool -> String -> String
typeNameModifier} = forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions f a
proxy GQLTypeOptions
defaultTypeOptions

instance GQLType Int where
  type KIND Int = SCALAR
  __type :: forall (f :: * -> *). f Int -> TypeCategory -> TypeData
__type f Int
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Int"

instance GQLType Double where
  type KIND Double = SCALAR
  __type :: forall (f :: * -> *). f Double -> TypeCategory -> TypeData
__type f Double
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float"

instance GQLType Float where
  type KIND Float = SCALAR
  __type :: forall (f :: * -> *). f Float -> TypeCategory -> TypeData
__type f Float
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Float32"

instance GQLType Text where
  type KIND Text = SCALAR
  __type :: forall (f :: * -> *). f Text -> TypeCategory -> TypeData
__type f Text
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"String"

instance GQLType Bool where
  type KIND Bool = SCALAR
  __type :: forall (f :: * -> *). f Bool -> TypeCategory -> TypeData
__type f Bool
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"Boolean"

instance GQLType ID where
  type KIND ID = SCALAR
  __type :: forall (f :: * -> *). f ID -> TypeCategory -> TypeData
__type f ID
_ = forall a. TypeName -> a -> TypeData
mkTypeData TypeName
"ID"

-- WRAPPERS
instance GQLType ()

instance GQLType a => GQLType (Maybe a) where
  type KIND (Maybe a) = WRAPPER
  __type :: forall (f :: * -> *). f (Maybe a) -> TypeCategory -> TypeData
__type f (Maybe a)
_ = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper forall a. Nullable a => a -> a
toNullable forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)

instance GQLType a => GQLType [a] where
  type KIND [a] = WRAPPER
  __type :: forall (f :: * -> *). f [a] -> TypeCategory -> TypeData
__type f [a]
_ = (TypeWrapper -> TypeWrapper) -> TypeData -> TypeData
wrapper TypeWrapper -> TypeWrapper
list forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)

instance GQLType a => GQLType (Set a) where
  type KIND (Set a) = WRAPPER
  __type :: forall (f :: * -> *). f (Set a) -> TypeCategory -> TypeData
__type f (Set a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]

instance GQLType a => GQLType (NonEmpty a) where
  type KIND (NonEmpty a) = WRAPPER
  __type :: forall (f :: * -> *). f (NonEmpty a) -> TypeCategory -> TypeData
__type f (NonEmpty a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]

instance GQLType a => GQLType (Seq a) where
  type KIND (Seq a) = WRAPPER
  __type :: forall (f :: * -> *). f (Seq a) -> TypeCategory -> TypeData
__type f (Seq a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]

instance GQLType a => GQLType (Vector a) where
  type KIND (Vector a) = WRAPPER
  __type :: forall (f :: * -> *). f (Vector a) -> TypeCategory -> TypeData
__type f (Vector a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[a]

instance GQLType a => GQLType (SubscriptionField a) where
  type KIND (SubscriptionField a) = WRAPPER
  __type :: forall (f :: * -> *).
f (SubscriptionField a) -> TypeCategory -> TypeData
__type f (SubscriptionField a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a

instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b) where
  typeOptions :: forall (f :: * -> *).
f (Pair a b) -> GQLTypeOptions -> GQLTypeOptions
typeOptions f (Pair a b)
_ = GQLTypeOptions -> GQLTypeOptions
prefixInputs

-- Manual

instance Typeable m => GQLType (Undefined m) where
  type KIND (Undefined m) = CUSTOM
  __isEmptyType :: forall (f :: * -> *). f (Undefined m) -> Bool
__isEmptyType f (Undefined m)
_ = Bool
True

instance GQLType b => GQLType (a -> b) where
  type KIND (a -> b) = CUSTOM
  __type :: forall (f :: * -> *). f (a -> b) -> TypeCategory -> TypeData
__type f (a -> b)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @b

instance (GQLType k, GQLType v, Typeable k, Typeable v) => GQLType (Map k v) where
  type KIND (Map k v) = CUSTOM
  __type :: forall (f :: * -> *). f (Map k v) -> TypeCategory -> TypeData
__type f (Map k v)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @[Pair k v]

instance GQLType a => GQLType (Resolver o e m a) where
  type KIND (Resolver o e m a) = CUSTOM
  __type :: forall (f :: * -> *).
f (Resolver o e m a) -> TypeCategory -> TypeData
__type f (Resolver o e m a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @a

instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where
  __type :: forall (f :: * -> *). f (a, b) -> TypeCategory -> TypeData
__type f (a, b)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type forall a b. (a -> b) -> a -> b
$ forall {k} (t :: k). Proxy t
Proxy @(Pair a b)
  typeOptions :: forall (f :: * -> *). f (a, b) -> GQLTypeOptions -> GQLTypeOptions
typeOptions f (a, b)
_ = GQLTypeOptions -> GQLTypeOptions
prefixInputs

instance (GQLType value) => GQLType (Arg name value) where
  type KIND (Arg name value) = CUSTOM
  __type :: forall (f :: * -> *).
f (Arg name value) -> TypeCategory -> TypeData
__type f (Arg name value)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @value)

instance (GQLType interface) => GQLType (TypeGuard interface possibleTypes) where
  type KIND (TypeGuard interface possibleTypes) = CUSTOM
  __type :: forall (f :: * -> *).
f (TypeGuard interface possibleTypes) -> TypeCategory -> TypeData
__type f (TypeGuard interface possibleTypes)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @interface)

instance (GQLType a) => GQLType (Proxy a) where
  type KIND (Proxy a) = KIND a
  __type :: forall (f :: * -> *). f (Proxy a) -> TypeCategory -> TypeData
__type f (Proxy a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy @a)

instance (GQLType a) => GQLType (NamedResolverT m a) where
  type KIND (NamedResolverT m a) = CUSTOM
  __type :: forall (f :: * -> *).
f (NamedResolverT m a) -> TypeCategory -> TypeData
__type f (NamedResolverT m a)
_ = forall a (f :: * -> *).
GQLType a =>
f a -> TypeCategory -> TypeData
__type (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)

type Decode a = EncodeKind (KIND a) a

encodeArguments :: forall a. Decode a => a -> GQLResult (Arguments CONST)
encodeArguments :: forall a. Decode a => a -> GQLResult (Arguments CONST)
encodeArguments a
x = forall a. Decode a => a -> GQLResult (Value CONST)
encode a
x forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {f :: * -> *} {valid :: Stage}.
MonadError GQLError f =>
Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue
  where
    unpackValue :: Value valid -> f (OrdMap FieldName (Argument valid))
unpackValue (Object Object valid
v) = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {valid :: Stage}. ObjectEntry valid -> Argument valid
toArgument Object valid
v
    unpackValue Value valid
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"TODO: expected arguments!")
    toArgument :: ObjectEntry valid -> Argument valid
toArgument ObjectEntry {Value valid
FieldName
entryName :: forall (s :: Stage). ObjectEntry s -> FieldName
entryValue :: forall (s :: Stage). ObjectEntry s -> Value s
entryValue :: Value valid
entryName :: FieldName
..} = forall (valid :: Stage).
Position -> FieldName -> Value valid -> Argument valid
Argument (Int -> Int -> Position
Position Int
0 Int
0) FieldName
entryName Value valid
entryValue

encode :: forall a. Decode a => a -> GQLResult (Value CONST)
encode :: forall a. Decode a => a -> GQLResult (Value CONST)
encode a
x = forall (kind :: DerivingKind) a.
EncodeKind kind a =>
ContextValue kind a -> GQLResult (Value CONST)
encodeKind (forall (kind :: DerivingKind) a. a -> ContextValue kind a
ContextValue a
x :: ContextValue (KIND a) a)

class EncodeKind (kind :: DerivingKind) (a :: Type) where
  encodeKind :: ContextValue kind a -> GQLResult (Value CONST)

instance (EncodeWrapperValue f, Decode a) => EncodeKind WRAPPER (f a) where
  encodeKind :: ContextValue WRAPPER (f a) -> GQLResult (Value CONST)
encodeKind = forall (f :: * -> *) (m :: * -> *) a.
(EncodeWrapperValue f, Monad m) =>
(a -> m (Value CONST)) -> f a -> m (Value CONST)
encodeWrapperValue forall a. Decode a => a -> GQLResult (Value CONST)
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

instance (EncodeScalar a) => EncodeKind SCALAR a where
  encodeKind :: ContextValue SCALAR a -> GQLResult (Value CONST)
encodeKind = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (stage :: Stage). ScalarValue -> Value stage
Scalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. EncodeScalar a => a -> ScalarValue
encodeScalar forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

instance (EncodeConstraint a) => EncodeKind TYPE a where
  encodeKind :: ContextValue TYPE a -> GQLResult (Value CONST)
encodeKind = forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: DerivingKind) a. ContextValue kind a -> a
unContextValue

convertNode ::
  DataType (GQLResult (Value CONST)) ->
  GQLResult (Value CONST)
convertNode :: DataType (GQLResult (Value CONST)) -> GQLResult (Value CONST)
convertNode
  DataType
    { Bool
tyIsUnion :: forall v. DataType v -> Bool
tyIsUnion :: Bool
tyIsUnion,
      tyCons :: forall v. DataType v -> ConsRep v
tyCons = ConsRep {[FieldRep (GQLResult (Value CONST))]
consFields :: forall v. ConsRep v -> [FieldRep v]
consFields :: [FieldRep (GQLResult (Value CONST))]
consFields, TypeName
consName :: forall v. ConsRep v -> TypeName
consName :: TypeName
consName}
    } = [FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
encodeTypeFields [FieldRep (GQLResult (Value CONST))]
consFields
    where
      encodeTypeFields ::
        [FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
      encodeTypeFields :: [FieldRep (GQLResult (Value CONST))] -> GQLResult (Value CONST)
encodeTypeFields [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (stage :: Stage). TypeName -> Value stage
Enum TypeName
consName
      encodeTypeFields [FieldRep (GQLResult (Value CONST))]
fields | Bool -> Bool
not Bool
tyIsUnion = forall (stage :: Stage). Object stage -> Value stage
Object forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall {m :: * -> *} {s :: Stage}.
Monad m =>
FieldRep (m (Value s)) -> m (ObjectEntry s)
fromField [FieldRep (GQLResult (Value CONST))]
fields forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) k a (map :: * -> * -> *).
(Monad m, KeyOf k a, FromList m map k a) =>
[a] -> m (map k a)
fromElems)
        where
          fromField :: FieldRep (m (Value s)) -> m (ObjectEntry s)
fromField FieldRep {FieldName
fieldSelector :: forall a. FieldRep a -> FieldName
fieldSelector :: FieldName
fieldSelector, m (Value s)
fieldValue :: forall a. FieldRep a -> a
fieldValue :: m (Value s)
fieldValue} = do
            Value s
entryValue <- m (Value s)
fieldValue
            forall (f :: * -> *) a. Applicative f => a -> f a
pure ObjectEntry {entryName :: FieldName
entryName = FieldName
fieldSelector, Value s
entryValue :: Value s
entryValue :: Value s
entryValue}
      -- Type References --------------------------------------------------------------
      encodeTypeFields [FieldRep (GQLResult (Value CONST))]
_ = forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GQLError -> GQLError
internal GQLError
"TODO: union not supported")

-- Types & Constrains -------------------------------------------------------
class (EncodeKind (KIND a) a, GQLType a) => ExplorerConstraint a

instance (EncodeKind (KIND a) a, GQLType a) => ExplorerConstraint a

exploreResolvers :: forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers :: forall a. EncodeConstraint a => a -> GQLResult (Value CONST)
exploreResolvers =
  DataType (GQLResult (Value CONST)) -> GQLResult (Value CONST)
convertNode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kind :: TypeCategory) a (constraint :: * -> Constraint)
       value.
(CategoryValue kind, Generic a,
 DeriveWith constraint value (Rep a)) =>
DeriveValueOptions kind constraint value -> a -> DataType value
deriveValue
      ( DeriveValueOptions
          { __valueApply :: forall a. ExplorerConstraint a => a -> GQLResult (Value CONST)
__valueApply = forall a. Decode a => a -> GQLResult (Value CONST)
encode,
            __valueTypeName :: TypeName
__valueTypeName = forall a (kind :: TypeCategory) (kinded :: TypeCategory -> * -> *).
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeName
deriveTypename (forall {k} {k1} (k2 :: k) (a :: k1). KindedProxy k2 a
KindedProxy :: KindedProxy IN a),
            __valueGQLOptions :: GQLTypeOptions
__valueGQLOptions = forall a (f :: * -> *).
GQLType a =>
f a -> GQLTypeOptions -> GQLTypeOptions
typeOptions (forall {k} (t :: k). Proxy t
Proxy @a) GQLTypeOptions
defaultTypeOptions,
            __valueGetType :: forall (f :: * -> *) a. ExplorerConstraint a => f a -> TypeData
__valueGetType = forall (kinded :: TypeCategory -> * -> *) (kind :: TypeCategory) a.
(GQLType a, CategoryValue kind) =>
kinded kind a -> TypeData
__typeData forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k1} {k2} (f :: k1 -> *) (k3 :: k1) (f' :: k2 -> *)
       (a :: k2).
f k3 -> f' a -> KindedProxy k3 a
kinded (forall {k} (t :: k). Proxy t
Proxy @IN)
          } ::
          DeriveValueOptions IN ExplorerConstraint (GQLResult (Value CONST))
      )

type EncodeConstraint a =
  ( Generic a,
    GQLType a,
    DeriveWith ExplorerConstraint (GQLResult (Value CONST)) (Rep a)
  )

class DeriveArguments (k :: DerivingKind) a where
  deriveArgumentsDefinition :: f k a -> SchemaT OUT (ArgumentsDefinition CONST)

-- DIRECTIVES

data DirectiveUsages = DirectiveUsages
  { DirectiveUsages -> [DirectiveUsage]
typeDirectives :: [DirectiveUsage],
    DirectiveUsages -> HashMap FieldName [DirectiveUsage]
fieldDirectives :: M.HashMap FieldName [DirectiveUsage],
    DirectiveUsages -> HashMap TypeName [DirectiveUsage]
enumValueDirectives :: M.HashMap TypeName [DirectiveUsage]
  }

instance Monoid DirectiveUsages where
  mempty :: DirectiveUsages
mempty = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

instance Semigroup DirectiveUsages where
  DirectiveUsages [DirectiveUsage]
td1 HashMap FieldName [DirectiveUsage]
fd1 HashMap TypeName [DirectiveUsage]
ed1 <> :: DirectiveUsages -> DirectiveUsages -> DirectiveUsages
<> DirectiveUsages [DirectiveUsage]
td2 HashMap FieldName [DirectiveUsage]
fd2 HashMap TypeName [DirectiveUsage]
ed2 = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages ([DirectiveUsage]
td1 forall a. Semigroup a => a -> a -> a
<> [DirectiveUsage]
td2) (HashMap FieldName [DirectiveUsage]
fd1 forall a. Semigroup a => a -> a -> a
<> HashMap FieldName [DirectiveUsage]
fd2) (HashMap TypeName [DirectiveUsage]
ed1 forall a. Semigroup a => a -> a -> a
<> HashMap TypeName [DirectiveUsage]
ed2)

type TypeDirectiveConstraint a = (GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a, ToLocations (DIRECTIVE_LOCATIONS a))

typeDirective :: TypeDirectiveConstraint a => a -> DirectiveUsages
typeDirective :: forall a. TypeDirectiveConstraint a => a -> DirectiveUsages
typeDirective a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
 ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x] forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

fieldDirective :: TypeDirectiveConstraint a => FieldName -> a -> DirectiveUsages
fieldDirective :: forall a.
TypeDirectiveConstraint a =>
FieldName -> a -> DirectiveUsages
fieldDirective FieldName
fieldName a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty (forall k v. Hashable k => k -> v -> HashMap k v
M.singleton FieldName
fieldName [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
 ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x]) forall a. Monoid a => a
mempty

enumDirective :: TypeDirectiveConstraint a => TypeName -> a -> DirectiveUsages
enumDirective :: forall a.
TypeDirectiveConstraint a =>
TypeName -> a -> DirectiveUsages
enumDirective TypeName
fieldName a
x = [DirectiveUsage]
-> HashMap FieldName [DirectiveUsage]
-> HashMap TypeName [DirectiveUsage]
-> DirectiveUsages
DirectiveUsages forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall k v. Hashable k => k -> v -> HashMap k v
M.singleton TypeName
fieldName [forall a.
(GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a,
 ToLocations (DIRECTIVE_LOCATIONS a)) =>
a -> DirectiveUsage
DirectiveUsage a
x])

data DirectiveUsage where
  DirectiveUsage :: (GQLDirective a, GQLType a, Decode a, DeriveArguments (KIND a) a, ToLocations (DIRECTIVE_LOCATIONS a)) => a -> DirectiveUsage

applyOnTypeName :: DirectiveUsage -> TypeName -> TypeName
applyOnTypeName :: DirectiveUsage -> TypeName -> TypeName
applyOnTypeName (DirectiveUsage a
x) = forall a. GQLDirective a => a -> TypeName -> TypeName
visitTypeName a
x

typeNameWithDirectives :: TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives :: TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr DirectiveUsage -> TypeName -> TypeName
applyOnTypeName

editTypeData :: TypeData -> DirectiveUsages -> TypeData
editTypeData :: TypeData -> DirectiveUsages -> TypeData
editTypeData TypeData {TypeWrapper
TypeName
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlTypeName :: TypeName
gqlWrappers :: TypeData -> TypeWrapper
gqlFingerprint :: TypeData -> TypeFingerprint
gqlTypeName :: TypeData -> TypeName
..} DirectiveUsages {[DirectiveUsage]
typeDirectives :: [DirectiveUsage]
typeDirectives :: DirectiveUsages -> [DirectiveUsage]
typeDirectives} = TypeData {gqlTypeName :: TypeName
gqlTypeName = TypeName -> [DirectiveUsage] -> TypeName
typeNameWithDirectives TypeName
gqlTypeName [DirectiveUsage]
typeDirectives, TypeWrapper
TypeFingerprint
gqlFingerprint :: TypeFingerprint
gqlWrappers :: TypeWrapper
gqlWrappers :: TypeWrapper
gqlFingerprint :: TypeFingerprint
..}