packages feed

morpheus-graphql 0.16.0 → 0.17.0

raw patch · 78 files changed

+2590/−1887 lines, 78 filesdep +morpheus-graphql-appdep ~morpheus-graphql-coredep ~morpheus-graphql-subscriptions

Dependencies added: morpheus-graphql-app

Dependency ranges changed: morpheus-graphql-core, morpheus-graphql-subscriptions

Files

README.md view
@@ -29,7 +29,7 @@ resolver: lts-16.2  extra-deps:-  - morpheus-graphql-0.16.0+  - morpheus-graphql-0.17.0 ```  As Morpheus is quite new, make sure stack can find morpheus-graphql by running `stack upgrade` and `stack update`@@ -232,59 +232,39 @@  ```haskell data Character-  = CharacterDeity Deity -- Only <tyConName><conName> should generate direct link-  -- RECORDS+  = CharacterDeity Deity -- will be unwrapped, since Character + Deity = CharacterDeity+  | SomeDeity Deity -- will be wrapped since Character + Deity != SomeDeity   | Creature { creatureName :: Text, creatureAge :: Int }-  --- Types-  | SomeDeity Deity-  | CharacterInt Int-  | SomeMulti Int Text-  --- ENUMS+  | Demigod Text Text   | Zeus-  | Cronus   deriving (Generic, GQLType) ```  where `Deity` is an object. -As you see there are different kinds of unions. `morpheus` handles them all.+As we see, there are different kinds of unions. `Morpheus` handles them all.  This type will be represented as  ```gql-union Character =-    Deity # unwrapped union: because "Character" <> "Deity" == "CharacterDeity"-  | Creature-  | SomeDeity # wrapped union: because "Character" <> "Deity" /= SomeDeity-  | CharacterInt-  | SomeMulti-  | CharacterEnumObject # no-argument constructors all wrapped into an enum-type Creature {-  creatureName: String!-  creatureAge: Int!-}+union Character = Deity | SomeDeity | Creature | SomeMulti | Zeus  type SomeDeity {   _0: Deity! } -type CharacterInt {-  _0: Int!+type Creature {+  creatureName: String!+  creatureAge: Int! } -type SomeMulti {+type Demigod {   _0: Int!   _1: String! } -# enum-type CharacterEnumObject {-  enum: CharacterEnum!-}--enum CharacterEnum {-  Zeus-  Cronus+type Zeus {+  _: Unit! } ``` @@ -348,10 +328,12 @@ ```haskell data Odd = Odd Int  deriving (Generic) -instance GQLScalar Odd where-  parseValue (Int x) = pure $ Odd (...  )-  parseValue (String x) = pure $ Odd (...  )-  serialize  (Odd value) = Int value+instance DecodeScalar Euro where+  decodeScalar (Int x) = pure $ Odd (... )+  decodeScalar _ = Left "invalid Value!"++instance EncodeScalar Euro where+  encodeScalar (Odd value) = Int value  instance GQLType Odd where   type KIND Odd = SCALAR
changelog.md view
@@ -1,5 +1,128 @@ # Changelog +## 0.17.0 - 25.02.2021++## new features++- (issue [#543](https://github.com/morpheusgraphql/morpheus-graphql/issues/543) & [#558](https://github.com/morpheusgraphql/morpheus-graphql/issues/558)): `GQLTypeOptions` supports new option `typeNameModifier`.+  Before the schema failed if you wanted to use the same type for input and output, and the user had no control over the eventual GraphQL type name of the generated schema. Now with this option you can+  provide a function of type `Bool -> String -> String` that generates a custom GraphQL type name. The first argument is a `Bool` that is `True` if the type is an input, and `False` otherwise. The second+  argument is a `String` representing the initial, auto-generated GraphQL type name. The function returns the desired type name. thanks @nalchevanidze & @bradsherman++  e.g this schema will not fail. morpheus will generate types: `Deity` and `InputDeity`++  ```hs+  data Deity = Deity+  { name :: Text,+    age :: Int+  }+  deriving (Show, Generic)++  deityTypeNameModifier isInput original+    | isInput = "Input" ++ original+    | otherwise = original++  instance GQLType Deity where+    typeOptions _ opt = opt {typeNameModifier = deityTypeNameModifier}++  newtype DeityArgs = DeityArgs+    { input :: Deity+    }+    deriving (Show, Generic, GQLType)++  newtype Query (m :: * -> *) = Query+    { deity :: DeityArgs -> m Deity+    }+    deriving (Generic, GQLType)+  ```++- exposed `EncodeWrapper` and `DecodeWrapper` type-classes.++### Breaking Changes++- `Map k v` is now represented as just `[Pair k v]`+- `GQLScalar` was replaced with `EncodeScalar` and `DecodeScalar` type-classes.+- Exclusive input objects: Sum types used as input types are represented as input objects, where only one field must have a value. Namespaced constructors (i.e., where referenced type name concatenated with union type name is equal to constructor name) are unpacked. Furthermore, empty constructors are represented as fields with the unit type.++  for example:++  ```hs+      data Device+        | DevicePC PC+        | Laptops { macAdress :: ID }+        | Smartphone+  ```++  this type will generate the following SDL:++  ```graphql+  enum Unit {+    Unit+  }++  input Laptop {+    macAdress: ID+  }++  input Device {+    PC: PC+    Laptops: Laptops+    Smartphone: Unit+  }+  ```++- For each nullary constructor will be defined GQL object type with a single field `_: Unit` (since GraphQL does not allow empty objects).++  for example:++  ```haskell+  data Person = Client { name :: Text } | Accountant | Developer+  ```++  this type will generate the following SDL:++  ```graphql+  enum Unit {+    Unit+  }++  type Student {+    name: String!+  }++  type Accountant {+    _: Unit!+  }++  type Developer {+    _: Unit!+  }++  union Person = Client | Accountant | Developer+  ```++- changed signature of `GQLType.typeOptions` from `f a -> GQLTypeOptions` to `f a -> GQLTypeOptions -> GQLTypeOptions`.++  now you can write:++  ```hs+    typeOptions _ options = options { fieldLabelModifier = <my function> }+  ```++whre argument options is default gql options.++- deexposed constructor of `GQLTypeOptions`.+- Type name for parametrized types like `One (Two Three)` will be generated directly, concatenating them `OneTwoThree` instead of `One_Two_Three.`+- Haskell `Float` was renamed to custom scalar type `Float32.`+- Haskell `Double` now represents GraphQL `Float`.++### Minor Changes++- deprecated kinds `INPUT`, `ENUM` and `OUTPUT` in favor of more generalized kind `TYPE`.+  now you can derive INPUT, ENUM and OUTPUT automatically with `deriving (Generic, GQLType)`.+- more likely to rebuild when a file loaded by `importGQLDocument` or+  `importGQLDocumentWithNamespace` is changed+ ## 0.16.0 - 05.11.2020  ## Breaking changes@@ -1330,3 +1453,7 @@   - `gqlResolver` : packs `m Either String a` to `Resolver m a`   - `gqlEffectResolver`: resolver constructor for effectedResolver   - `liftEffectResolver`: lifts normal resolver to Effect Resolver.++```++```
morpheus-graphql.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4f4683e0c6a040813b49314a575621595a6cc515377d78372f2e6ac0c718be74+-- hash: d368fd8eff3a4df2fceeb6a1ce9443206bae51f0198ffac9b2bcfbc651591e6e  name:           morpheus-graphql-version:        0.16.0+version:        0.17.0 synopsis:       Morpheus GraphQL description:    Build GraphQL APIs with your favourite functional language! category:       web, graphql@@ -168,17 +168,21 @@     test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql     test/Feature/InputType/variables/valueNotProvided/nullableVariable/query.gql     test/Feature/Schema/nameCollision/query.gql-    test/Feature/TypeInference/introspection/complexInput/query.gql-    test/Feature/TypeInference/introspection/complexUnion/query.gql-    test/Feature/TypeInference/introspection/complexUnionEnum/query.gql-    test/Feature/TypeInference/introspection/complexUnionIndexedTypes/query.gql-    test/Feature/TypeInference/introspection/complexUnionRecord/query.gql-    test/Feature/TypeInference/introspection/complexUnionScalar/query.gql+    test/Feature/TypeCategoryCollision/Fail/failOnColision/query.gql+    test/Feature/TypeCategoryCollision/Success/prefixed/query.gql     test/Feature/TypeInference/introspection/enum/query.gql+    test/Feature/TypeInference/introspection/input-union/empty/query.gql+    test/Feature/TypeInference/introspection/input-union/input-union/query.gql     test/Feature/TypeInference/introspection/inputObject/query.gql     test/Feature/TypeInference/introspection/object/query.gql+    test/Feature/TypeInference/introspection/union/named-products/query.gql+    test/Feature/TypeInference/introspection/union/nullary-constructors/query.gql+    test/Feature/TypeInference/introspection/union/positional-products/query.gql+    test/Feature/TypeInference/introspection/union/scalars/query.gql+    test/Feature/TypeInference/introspection/union/union/query.gql     test/Feature/TypeInference/resolving/complexUnion/query.gql-    test/Feature/TypeInference/resolving/input/query.gql+    test/Feature/TypeInference/resolving/input/fail/query.gql+    test/Feature/TypeInference/resolving/input/success/query.gql     test/Feature/TypeInference/resolving/object/query.gql     test/Feature/UnionType/cannotBeSpreadOnType/query.gql     test/Feature/UnionType/fragmentOnAAndB/query.gql@@ -360,18 +364,24 @@     test/Feature/InputType/variables/valueNotProvided/nullableVariable/response.json     test/Feature/Schema/cases.json     test/Feature/Schema/nameCollision/response.json+    test/Feature/TypeCategoryCollision/Fail/cases.json+    test/Feature/TypeCategoryCollision/Fail/failOnColision/response.json+    test/Feature/TypeCategoryCollision/Success/cases.json+    test/Feature/TypeCategoryCollision/Success/prefixed/response.json     test/Feature/TypeInference/cases.json-    test/Feature/TypeInference/introspection/complexInput/response.json-    test/Feature/TypeInference/introspection/complexUnion/response.json-    test/Feature/TypeInference/introspection/complexUnionEnum/response.json-    test/Feature/TypeInference/introspection/complexUnionIndexedTypes/response.json-    test/Feature/TypeInference/introspection/complexUnionRecord/response.json-    test/Feature/TypeInference/introspection/complexUnionScalar/response.json     test/Feature/TypeInference/introspection/enum/response.json+    test/Feature/TypeInference/introspection/input-union/empty/response.json+    test/Feature/TypeInference/introspection/input-union/input-union/response.json     test/Feature/TypeInference/introspection/inputObject/response.json     test/Feature/TypeInference/introspection/object/response.json+    test/Feature/TypeInference/introspection/union/named-products/response.json+    test/Feature/TypeInference/introspection/union/nullary-constructors/response.json+    test/Feature/TypeInference/introspection/union/positional-products/response.json+    test/Feature/TypeInference/introspection/union/scalars/response.json+    test/Feature/TypeInference/introspection/union/union/response.json     test/Feature/TypeInference/resolving/complexUnion/response.json-    test/Feature/TypeInference/resolving/input/response.json+    test/Feature/TypeInference/resolving/input/fail/response.json+    test/Feature/TypeInference/resolving/input/success/response.json     test/Feature/TypeInference/resolving/object/response.json     test/Feature/UnionType/cannotBeSpreadOnType/response.json     test/Feature/UnionType/cases.json@@ -417,6 +427,7 @@       Data.Morpheus.Server.Types.GQLType       Data.Morpheus.Server.Types.SchemaT       Data.Morpheus.Server.Types.Types+      Data.Morpheus.Utils.Kinded       Paths_morpheus_graphql   hs-source-dirs:       src@@ -426,7 +437,8 @@     , base >=4.7 && <5     , bytestring >=0.10.4 && <0.11     , containers >=0.4.2.1 && <0.7-    , morpheus-graphql-core >=0.16.0 && <0.17.0+    , morpheus-graphql-app >=0.17.0 && <0.18.0+    , morpheus-graphql-core >=0.17.0 && <0.18.0     , mtl >=2.0 && <=3.0     , relude >=0.3.0     , template-haskell >=2.0 && <=3.0@@ -448,6 +460,8 @@       Feature.InputType.API       Feature.Schema.A2       Feature.Schema.API+      Feature.TypeCategoryCollision.Fail.API+      Feature.TypeCategoryCollision.Success.API       Feature.TypeInference.API       Feature.UnionType.API       Feature.WrappedTypeName.API@@ -471,8 +485,9 @@     , bytestring >=0.10.4 && <0.11     , containers >=0.4.2.1 && <0.7     , morpheus-graphql-    , morpheus-graphql-core >=0.16.0 && <0.17.0-    , morpheus-graphql-subscriptions >=0.16.0 && <0.17.0+    , morpheus-graphql-app >=0.17.0 && <0.18.0+    , morpheus-graphql-core >=0.17.0 && <0.18.0+    , morpheus-graphql-subscriptions >=0.17.0 && <0.18.0     , mtl >=2.0 && <=3.0     , relude >=0.3.0     , tasty
src/Data/Morpheus.hs view
@@ -13,8 +13,9 @@ where  -- MORPHEUS-import Data.Morpheus.Core+import Data.Morpheus.App   ( App,+    MapAPI,     runApp,     withDebugger,   )@@ -25,7 +26,6 @@ import Data.Morpheus.Types   ( RootResolver (..),   )-import Data.Morpheus.Types.IO (MapAPI) import Relude  -- | main query processor and resolver
src/Data/Morpheus/Document.hs view
@@ -14,6 +14,9 @@   ( ByteString,     pack,   )+import Data.Morpheus.App.Internal.Resolving+  ( resultOr,+  ) import Data.Morpheus.Core   ( render,   )@@ -29,14 +32,15 @@     gqlDocument,   ) import Data.Morpheus.Types (RootResolver)-import Data.Morpheus.Types.Internal.Resolving-  ( resultOr,-  ) import Language.Haskell.TH+import Language.Haskell.TH.Syntax+  ( qAddDependentFile,+  ) import Relude hiding (ByteString)  importGQLDocument :: FilePath -> Q [Dec]-importGQLDocument src =+importGQLDocument src = do+  qAddDependentFile src   runIO (readFile src)     >>= compileDocument       ServerDecContext@@ -44,7 +48,8 @@         }  importGQLDocumentWithNamespace :: FilePath -> Q [Dec]-importGQLDocumentWithNamespace src =+importGQLDocumentWithNamespace src = do+  qAddDependentFile src   runIO (readFile src)     >>= compileDocument       ServerDecContext
src/Data/Morpheus/Kind.hs view
@@ -11,80 +11,90 @@     WRAPPER,     UNION,     INPUT_OBJECT,+    DerivingKind,     GQL_KIND,     OUTPUT,     INPUT,     INTERFACE,     ToValue (..),     isObject,+    TYPE,+    CUSTOM,   ) where  import Relude -data GQL_KIND+{-# DEPRECATED GQL_KIND "use: DerivingKind" #-}++type GQL_KIND = DerivingKind++data DerivingKind   = SCALAR-  | ENUM-  | INPUT-  | OUTPUT+  | TYPE   | WRAPPER   | INTERFACE+  | CUSTOM -class ToValue (a :: GQL_KIND) where-  toValue :: f a -> GQL_KIND+class ToValue (a :: DerivingKind) where+  toValue :: f a -> DerivingKind  instance ToValue 'SCALAR where   toValue _ = SCALAR -instance ToValue 'ENUM where-  toValue _ = ENUM- instance ToValue 'WRAPPER where   toValue _ = WRAPPER -instance ToValue 'INPUT where-  toValue _ = INPUT--instance ToValue 'OUTPUT where-  toValue _ = OUTPUT+instance ToValue 'TYPE where+  toValue _ = TYPE  instance ToValue 'INTERFACE where   toValue _ = INTERFACE -isObject :: GQL_KIND -> Bool-isObject INPUT = True-isObject OUTPUT = True+instance ToValue 'CUSTOM where+  toValue _ = CUSTOM++isObject :: DerivingKind -> Bool+isObject TYPE = True isObject INTERFACE = True isObject _ = False +-- | GraphQL input, type, union , enum+type TYPE = 'TYPE+ -- | GraphQL Scalar: Int, Float, String, Boolean or any user defined custom Scalar type type SCALAR = 'SCALAR --- | GraphQL Enum-type ENUM = 'ENUM+-- | GraphQL interface+type INTERFACE = 'INTERFACE  -- | GraphQL Arrays , Resolvers and NonNull fields type WRAPPER = 'WRAPPER --- | GraphQL Object and union-type OUTPUT = 'OUTPUT+type CUSTOM = 'CUSTOM --- | GraphQL input Object and input union-type INPUT = 'INPUT+-- deprecated types -{-# DEPRECATED INPUT_OBJECT "use more generalized kind: INPUT" #-}+{-# DEPRECATED ENUM "use: deriving(GQLType), will be automatically inferred" #-} --- | GraphQL input Object-type INPUT_OBJECT = 'INPUT+type ENUM = 'TYPE +{-# DEPRECATED OUTPUT "use: deriving(GQLType), will be automatically inferred" #-}++type OUTPUT = 'TYPE++{-# DEPRECATED INPUT "use: deriving(GQLType), will be automatically inferred" #-}++type INPUT = 'TYPE++{-# DEPRECATED INPUT_OBJECT "use: deriving(GQLType), will be automatically inferred" #-}++type INPUT_OBJECT = 'TYPE+ {-# DEPRECATED UNION "use: deriving(GQLType), IMPORTANT: only types with <type constructor name><constructor name> will sustain their form, other union constructors will be wrapped inside an new object" #-} --- | GraphQL Union-type UNION = 'OUTPUT+type UNION = 'TYPE  {-# DEPRECATED OBJECT "use: deriving(GQLType), will be automatically inferred" #-} --- | GraphQL Object-type OBJECT = 'OUTPUT--type INTERFACE = 'INTERFACE+type OBJECT = 'TYPE
src/Data/Morpheus/Server/Deriving/App.hs view
@@ -13,10 +13,13 @@  import Control.Monad (Monad) import Data.Functor.Identity (Identity (..))-import Data.Morpheus.Core+import Data.Morpheus.App   ( App (..),     mkApp,   )+import Data.Morpheus.App.Internal.Resolving+  ( resultOr,+  ) import Data.Morpheus.Server.Deriving.Encode   ( EncodeConstraints,     deriveModel,@@ -27,9 +30,6 @@   ) import Data.Morpheus.Types   ( RootResolver (..),-  )-import Data.Morpheus.Types.Internal.Resolving-  ( resultOr,   )  type RootResolverConstraint m e query mutation subscription =
src/Data/Morpheus/Server/Deriving/Channels.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -15,6 +16,12 @@   ) where +import Data.Morpheus.App.Internal.Resolving+  ( Channel,+    Resolver,+    ResolverState,+    SubscriptionField (..),+  ) import Data.Morpheus.Internal.Utils   ( Failure (..),     elems,@@ -36,17 +43,12 @@ import Data.Morpheus.Types.Internal.AST   ( FieldName (..),     InternalError,+    OUT,     SUBSCRIPTION,     Selection (..),     SelectionContent (..),     VALID,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Channel,-    Resolver,-    ResolverState,-    SubscriptionField (..),-  ) import GHC.Generics import Relude @@ -127,6 +129,7 @@     . toValue       ( TypeConstraint (getChannel . runIdentity) :: TypeConstraint (GetChannel e) (ChannelRes e) Identity       )+      (Proxy @OUT)  convertNode :: DataType (ChannelRes e) -> [(FieldName, ChannelRes e)] convertNode DataType {tyCons = ConsRep {consFields}} = map toChannels consFields
src/Data/Morpheus/Server/Deriving/Decode.hs view
@@ -7,7 +7,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}@@ -21,45 +20,53 @@   ) where -import Control.Applicative (pure, (<*>))-import Control.Monad ((>>=))-import Data.Functor (Functor (..), (<$>))-import Data.List (elem)-import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty-import Data.Maybe (Maybe (..))-import Data.Morpheus.Internal.Utils-  ( elems,+import Data.Morpheus.App.Internal.Resolving+  ( Failure (..),+    ResolverState,   ) import Data.Morpheus.Kind-  ( ENUM,-    GQL_KIND,-    INPUT,-    OUTPUT,+  ( DerivingKind,     SCALAR,+    TYPE,+    WRAPPER,   ) import Data.Morpheus.Server.Deriving.Utils   ( conNameProxy,     datatypeNameProxy,     selNameProxy,   )-import Data.Morpheus.Server.Internal.TH.Decode (decodeFieldWith, withInputObject, withInputUnion, withList, withMaybe, withRefinedList, withScalar)+import Data.Morpheus.Server.Internal.TH.Decode+  ( decodeFieldWith,+    handleEither,+    withInputObject,+    withInputUnion,+    withScalar,+  ) import Data.Morpheus.Server.Types.GQLType   ( GQLType       ( KIND,-        typeOptions,-        __type+        typeOptions       ),     GQLTypeOptions (..),     TypeData (..),+    __typeData,+    defaultTypeOptions,   ) import Data.Morpheus.Types.GQLScalar-  ( GQLScalar (..),+  ( DecodeScalar (..),   )+import Data.Morpheus.Types.GQLWrapper+  ( DecodeWrapper (..),+    DecodeWrapperConstraint,+  ) import Data.Morpheus.Types.Internal.AST   ( Argument (..),     Arguments,+    IN,     InternalError,+    LEAF,+    Message,+    Object,     ObjectEntry (..),     TypeName (..),     VALID,@@ -68,21 +75,11 @@     Value (..),     msg,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Failure (..),-    ResolverState,+import Data.Morpheus.Utils.Kinded+  ( KindedProxy (..),   )-import Data.Proxy (Proxy (..))-import Data.Semigroup (Semigroup (..))-import Data.Sequence (Seq)-import qualified Data.Sequence as Seq-import Data.Set (Set)-import qualified Data.Set as Set-import Data.String (IsString (fromString))-import Data.Vector (Vector)-import qualified Data.Vector as Vector import GHC.Generics-import Prelude (Either (Left, Right), Eq (..), Foldable (length), Ord, maybe, otherwise, show, ($), (-), (.))+import Relude  type DecodeConstraint a =   ( Generic a,@@ -100,57 +97,35 @@ class Decode a where   decode :: ValidValue -> ResolverState a -instance {-# OVERLAPPABLE #-} DecodeKind (KIND a) a => Decode a where+instance DecodeKind (KIND a) a => Decode a where   decode = decodeKind (Proxy @(KIND a)) -instance Decode a => Decode (Maybe a) where-  decode = withMaybe decode--instance Decode a => Decode [a] where-  decode = withList decode--instance Decode a => Decode (NonEmpty a) where-  decode = withRefinedList (maybe (Left "Expected a NonEmpty list") Right . NonEmpty.nonEmpty) decode---- | Should this instance dedupe silently or fail on dupes ?-instance (Ord a, Decode a) => Decode (Set a) where-  decode val = do-    listVal <- withList (decode @a) val-    let setVal = Set.fromList listVal-    let setLength = length setVal-    let listLength = length setVal-    if listLength == setLength-      then pure setVal-      else failure (fromString ("Expected a List without duplicates, found " <> show (setLength - listLength) <> " duplicates") :: InternalError)--instance (Decode a) => Decode (Seq a) where-  decode = fmap Seq.fromList . withList decode--instance (Decode a) => Decode (Vector a) where-  decode = fmap Vector.fromList . withList decode- -- | Decode GraphQL type with Specific Kind-class DecodeKind (kind :: GQL_KIND) a where+class DecodeKind (kind :: DerivingKind) a where   decodeKind :: Proxy kind -> ValidValue -> ResolverState a  -- SCALAR-instance (GQLScalar a, GQLType a) => DecodeKind SCALAR a where-  decodeKind _ = withScalar (gqlTypeName $ __type (Proxy @a)) parseValue---- ENUM-instance DecodeConstraint a => DecodeKind ENUM a where-  decodeKind _ = decodeType---- TODO: remove-instance DecodeConstraint a => DecodeKind OUTPUT a where-  decodeKind _ = decodeType+instance (DecodeScalar a, GQLType a) => DecodeKind SCALAR a where+  decodeKind _ = withScalar (gqlTypeName $ __typeData (KindedProxy :: KindedProxy LEAF a)) decodeScalar  -- INPUT_OBJECT and  INPUT_UNION-instance DecodeConstraint a => DecodeKind INPUT a where+instance DecodeConstraint a => DecodeKind TYPE a where   decodeKind _ = decodeType +instance (Decode a, DecodeWrapperConstraint f a, DecodeWrapper f) => DecodeKind WRAPPER (f a) where+  decodeKind _ value =+    runExceptT (decodeWrapper decode value)+      >>= handleEither+ decodeType :: forall a. DecodeConstraint a => ValidValue -> ResolverState a-decodeType = fmap to . decodeRep . (typeOptions (Proxy @a),,Cont D_CONS "")+decodeType = fmap to . (`runReaderT` context) . decodeRep+  where+    context =+      Context+        { options = typeOptions (Proxy @a) defaultTypeOptions,+          contKind = D_CONS,+          typeName = ""+        }  -- data Input  = --    InputHuman Human  -- direct link: { __typename: Human, Human: {field: ""} }@@ -160,11 +135,14 @@ --     deriving (Generic, GQLType)  decideUnion ::-  ([TypeName], value -> ResolverState (f1 a)) ->-  ([TypeName], value -> ResolverState (f2 a)) ->+  ( Functor m,+    Failure Message m+  ) =>+  ([TypeName], value -> m (f1 a)) ->+  ([TypeName], value -> m (f2 a)) ->   TypeName ->   value ->-  ResolverState ((:+:) f1 f2 a)+  m ((:+:) f1 f2 a) decideUnion (left, f1) (right, f2) name value   | name `elem` left =     L1 <$> f1 value@@ -176,11 +154,26 @@         <> msg name         <> "\" could not find in Union" +traverseUnion ::+  (DecodeRep f, DecodeRep g) =>+  ([TypeName], [TypeName]) ->+  TypeName ->+  Object VALID ->+  ValidObject ->+  DecoderT ((f :+: g) a)+traverseUnion (l1, r1) name unions object+  | [name] == l1 =+    L1 <$> decodeRep (Object object)+  | [name] == r1 =+    R1 <$> decodeRep (Object object)+  | otherwise = decideUnion (l1, decodeRep) (r1, decodeRep) name (Object unions)+ data Tag = D_CONS | D_UNION deriving (Eq, Ord) -data Cont = Cont+data Context = Context   { contKind :: Tag,-    typeName :: TypeName+    typeName :: TypeName,+    options :: GQLTypeOptions   }  data Info = Info@@ -193,83 +186,90 @@   Info _ t1 <> Info D_UNION t2 = Info D_UNION (t1 <> t2)   Info D_CONS t1 <> Info D_CONS t2 = Info D_CONS (t1 <> t2) +type DecoderT = ReaderT Context ResolverState++withTypeName :: TypeName -> DecoderT a -> DecoderT a+withTypeName typeName = local (\ctx -> ctx {typeName})++withKind :: Tag -> DecoderT a -> DecoderT a+withKind contKind = local (\ctx -> ctx {contKind})++getUnionInfos ::+  forall f a b.+  (DecodeRep a, DecodeRep b) =>+  f (a :+: b) ->+  DecoderT (Info, Info)+getUnionInfos _ =+  ( \context ->+      ( tags (Proxy @a) context,+        tags (Proxy @b) context+      )+  )+    <$> ask+ -- -- GENERICS ---class DecodeRep f where-  tags :: Proxy f -> (GQLTypeOptions, TypeName) -> Info-  decodeRep :: (GQLTypeOptions, ValidValue, Cont) -> ResolverState (f a)+class DecodeRep (f :: * -> *) where+  tags :: Proxy f -> Context -> Info+  decodeRep :: ValidValue -> DecoderT (f a)  instance (Datatype d, DecodeRep f) => DecodeRep (M1 D d f) where   tags _ = tags (Proxy @f)-  decodeRep (ns, x, y) =-    M1-      <$> decodeRep-        (ns, x, y {typeName = datatypeNameProxy (Proxy @d)})--getEnumTag :: ValidObject -> ResolverState TypeName-getEnumTag x = case elems x of-  [ObjectEntry "enum" (Enum value)] -> pure value-  _ -> failure ("bad union enum object" :: InternalError)+  decodeRep value =+    withTypeName+      (datatypeNameProxy (Proxy @d))+      (M1 <$> decodeRep value)  instance (DecodeRep a, DecodeRep b) => DecodeRep (a :+: b) where   tags _ = tags (Proxy @a) <> tags (Proxy @b)-  decodeRep = __decode-    where-      __decode (opt, Object obj, cont) = withInputUnion handleUnion obj-        where-          handleUnion name unions object-            | name == typeName cont <> "EnumObject" =-              getEnumTag object >>= __decode . (opt,,ctx) . Enum-            | [name] == l1 =-              L1 <$> decodeRep (opt, Object object, ctx)-            | [name] == r1 =-              R1 <$> decodeRep (opt, Object object, ctx)-            | otherwise =-              decideUnion (l1, decodeRep) (r1, decodeRep) name (opt, Object unions, ctx)-          l1 = tagName l1t-          r1 = tagName r1t-          l1t = tags (Proxy @a) (opt, typeName cont)-          r1t = tags (Proxy @b) (opt, typeName cont)-          ctx = cont {contKind = kind (l1t <> r1t)}-      __decode (opt, Enum name, cxt) =-        decideUnion-          (tagName $ tags (Proxy @a) (opt, typeName cxt), decodeRep)-          (tagName $ tags (Proxy @b) (opt, typeName cxt), decodeRep)-          name-          (opt, Enum name, cxt)-      __decode _ = failure ("lists and scalars are not allowed in Union" :: InternalError)+  decodeRep (Object obj) =+    do+      (left, right) <- getUnionInfos (Proxy @(a :+: b))+      withKind (kind (left <> right)) $+        withInputUnion+          (traverseUnion (tagName left, tagName right))+          obj+  decodeRep (Enum name) = do+    (left, right) <- getUnionInfos (Proxy @(a :+: b))+    decideUnion+      (tagName left, decodeRep)+      (tagName right, decodeRep)+      name+      (Enum name)+  decodeRep _ = failure ("lists and scalars are not allowed in Union" :: InternalError)  instance (Constructor c, DecodeFields a) => DecodeRep (M1 C c a) where   decodeRep = fmap M1 . decodeFields-  tags _ (opt, baseName) = getTag (refType (Proxy @a))+  tags _ Context {typeName, options} = getTag (refType (Proxy @a))     where       getTag (Just memberRef)         | isUnionRef memberRef = Info {kind = D_UNION, tagName = [memberRef]}         | otherwise = Info {kind = D_CONS, tagName = [consName]}       getTag Nothing = Info {kind = D_CONS, tagName = [consName]}       ---------      consName = conNameProxy opt (Proxy @c)+      consName = conNameProxy options (Proxy @c)       -----------      isUnionRef x = baseName <> x == consName+      isUnionRef x = typeName <> x == consName -class DecodeFields f where+class DecodeFields (f :: * -> *) where   refType :: Proxy f -> Maybe TypeName-  decodeFields :: (GQLTypeOptions, ValidValue, Cont) -> ResolverState (f a)+  decodeFields :: ValidValue -> DecoderT (f a)  instance (DecodeFields f, DecodeFields g) => DecodeFields (f :*: g) where   refType _ = Nothing   decodeFields gql = (:*:) <$> decodeFields gql <*> decodeFields gql  instance (Selector s, GQLType a, Decode a) => DecodeFields (M1 S s (K1 i a)) where-  refType _ = Just $ gqlTypeName $ __type (Proxy @a)-  decodeFields (opt, value, Cont {contKind})-    | contKind == D_UNION = M1 . K1 <$> decode value-    | otherwise = __decode value-    where-      __decode = fmap (M1 . K1) . decodeRec-      fieldName = selNameProxy opt (Proxy @s)-      decodeRec = withInputObject (decodeFieldWith decode fieldName)+  refType _ = Just $ gqlTypeName $ __typeData (KindedProxy :: KindedProxy IN a)+  decodeFields value = M1 . K1 <$> do+    Context {options, contKind} <- ask+    if contKind == D_UNION+      then lift (decode value)+      else+        let fieldName = selNameProxy options (Proxy @s)+            fieldDecoder = decodeFieldWith (lift . decode) fieldName+         in withInputObject fieldDecoder value  instance DecodeFields U1 where   refType _ = Nothing
src/Data/Morpheus/Server/Deriving/Encode.hs view
@@ -7,7 +7,9 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-} @@ -17,28 +19,27 @@   ) where --- MORPHEUS--import Control.Applicative (Applicative (..))-import Control.Monad (Monad ((>>=)))-import Data.Functor (fmap)-import Data.Functor.Identity (Identity (..))-import Data.List.NonEmpty (NonEmpty)-import qualified Data.List.NonEmpty as NonEmpty-import Data.Map (Map) import qualified Data.Map as M-  ( toList,-  )-import Data.Maybe-  ( Maybe (..),-    maybe,+import Data.Morpheus.App.Internal.Resolving+  ( LiftOperation,+    Resolver,+    ResolverEntry,+    ResolverState,+    ResolverValue (..),+    RootResolverValue (..),+    failure,+    getArguments,+    liftResolverState,+    mkObject,+    mkUnion,   ) import Data.Morpheus.Kind-  ( ENUM,-    GQL_KIND,+  ( CUSTOM,+    DerivingKind,     INTERFACE,-    OUTPUT,     SCALAR,+    TYPE,+    WRAPPER,   ) import Data.Morpheus.Server.Deriving.Channels   ( ChannelsConstraint,@@ -59,136 +60,113 @@   ) import Data.Morpheus.Server.Types.GQLType (GQLType (..)) import Data.Morpheus.Server.Types.Types-  ( MapKind,-    Pair (..),-    mapKindFromList,+  ( Pair (..),   ) import Data.Morpheus.Types   ( RootResolver (..),   )-import Data.Morpheus.Types.GQLScalar (GQLScalar (..))+import Data.Morpheus.Types.GQLScalar+  ( EncodeScalar (..),+  )+import Data.Morpheus.Types.GQLWrapper (EncodeWrapper (..)) import Data.Morpheus.Types.Internal.AST-  ( InternalError,+  ( IN,+    InternalError,     MUTATION,     OperationType,     QUERY,     SUBSCRIPTION,     TypeRef (..),   )-import Data.Morpheus.Types.Internal.Resolving-  ( FieldResModel,-    LiftOperation,-    ResModel (..),-    Resolver,-    ResolverState,-    RootResModel (..),-    SubscriptionField (..),-    failure,-    getArguments,-    liftResolverState,-    mkObject,-  )-import Data.Proxy (Proxy (..))-import Data.Set (Set)-import qualified Data.Set as S-  ( toList,-  )-import Data.Traversable (traverse)-import Data.Vector (Vector)-import qualified Data.Vector as Vector import GHC.Generics   ( Generic (..),   )-import Prelude-  ( ($),-    (.),-    otherwise,-  )+import Relude -newtype ContextValue (kind :: GQL_KIND) a = ContextValue+newtype ContextValue (kind :: DerivingKind) a = ContextValue   { unContextValue :: a   } -class Encode o e (m :: * -> *) resolver where-  encode :: resolver -> Resolver o e m (ResModel o e m)+class Encode (m :: * -> *) resolver where+  encode :: resolver -> m (ResolverValue m) -instance {-# OVERLAPPABLE #-} (EncodeKind (KIND a) a o e m, LiftOperation o) => Encode o e m a where+instance (EncodeKind (KIND a) m a) => Encode m a where   encode resolver = encodeKind (ContextValue resolver :: ContextValue (KIND a) a) --- MAYBE-instance (Monad m, LiftOperation o, Encode o e m a) => Encode o e m (Maybe a) where-  encode = maybe (pure ResNull) encode+-- ENCODE GQL KIND+class EncodeKind (kind :: DerivingKind) (m :: * -> *) (a :: *) where+  encodeKind :: ContextValue kind a -> m (ResolverValue m) --- LIST []-instance (Monad m, Encode o e m a, LiftOperation o) => Encode o e m [a] where-  encode = fmap ResList . traverse encode+instance+  ( EncodeWrapper f,+    Encode m a,+    Monad m+  ) =>+  EncodeKind WRAPPER m (f a)+  where+  encodeKind = encodeWrapper encode . unContextValue ---  Tuple  (a,b)-instance Encode o e m (Pair k v) => Encode o e m (k, v) where-  encode (key, value) = encode (Pair key value)+instance+  ( EncodeScalar a,+    Monad m+  ) =>+  EncodeKind SCALAR m a+  where+  encodeKind = pure . ResScalar . encodeScalar . unContextValue ---  NonEmpty-instance Encode o e m [a] => Encode o e m (NonEmpty a) where-  encode = encode . NonEmpty.toList+instance+  ( EncodeConstraint m a,+    Monad m+  ) =>+  EncodeKind TYPE m a+  where+  encodeKind = pure . exploreResolvers . unContextValue ---  Vector-instance Encode o e m [a] => Encode o e m (Vector a) where-  encode = encode . Vector.toList+instance+  ( EncodeConstraint m a,+    Monad m+  ) =>+  EncodeKind INTERFACE m a+  where+  encodeKind = pure . exploreResolvers . unContextValue ---  Set-instance Encode o e m [a] => Encode o e m (Set a) where-  encode = encode . S.toList+--  Tuple  (a,b)+instance+  Encode m (Pair k v) =>+  EncodeKind CUSTOM m (k, v)+  where+  encodeKind = encode . uncurry Pair . unContextValue  --  Map-instance (Monad m, LiftOperation o, Encode o e m (MapKind k v (Resolver o e m))) => Encode o e m (Map k v) where-  encode value =-    encode ((mapKindFromList $ M.toList value) :: MapKind k v (Resolver o e m))---- SUBSCRIPTION-instance (Monad m, LiftOperation o, Encode o e m a) => Encode o e m (SubscriptionField a) where-  encode (SubscriptionField _ res) = encode res+instance (Monad m, Encode m [Pair k v]) => EncodeKind CUSTOM m (Map k v) where+  encodeKind = encode . fmap (uncurry Pair) . M.toList . unContextValue  --  GQL a -> Resolver b, MUTATION, SUBSCRIPTION, QUERY instance   ( DecodeConstraint a,     Generic a,     Monad m,-    LiftOperation o,-    Encode o e m b+    Encode (Resolver o e m) b,+    LiftOperation o   ) =>-  Encode o e m (a -> b)+  EncodeKind CUSTOM (Resolver o e m) (a -> b)   where-  encode f =+  encodeKind (ContextValue f) =     getArguments       >>= liftResolverState . decodeArguments       >>= encode . f  --  GQL a -> Resolver b, MUTATION, SUBSCRIPTION, QUERY-instance (Monad m, Encode o e m b, LiftOperation o) => Encode o e m (Resolver o e m b) where-  encode x = x >>= encode---- ENCODE GQL KIND-class EncodeKind (kind :: GQL_KIND) a o e (m :: * -> *) where-  encodeKind :: LiftOperation o => ContextValue kind a -> Resolver o e m (ResModel o e m)---- SCALAR-instance (GQLScalar a, Monad m) => EncodeKind SCALAR a o e m where-  encodeKind = pure . ResScalar . serialize . unContextValue---- ENUM-instance EncodeConstraint o e m a => EncodeKind ENUM a o e m where-  encodeKind = pure . exploreResolvers . unContextValue--instance EncodeConstraint o e m a => EncodeKind OUTPUT a o e m where-  encodeKind = pure . exploreResolvers . unContextValue--instance EncodeConstraint o e m a => EncodeKind INTERFACE a o e m where-  encodeKind = pure . exploreResolvers . unContextValue+instance+  (Monad m, Encode (Resolver o e m) b, LiftOperation o) =>+  EncodeKind CUSTOM (Resolver o e m) (Resolver o e m b)+  where+  encodeKind (ContextValue value) = value >>= encode  convertNode ::-  (Monad m, LiftOperation o) =>-  DataType (Resolver o e m (ResModel o e m)) ->-  ResModel o e m+  Monad m =>+  DataType (m (ResolverValue m)) ->+  ResolverValue m convertNode   DataType     { tyName,@@ -199,41 +177,36 @@     | otherwise = mkObject tyName (fmap toFieldRes consFields)     where       -- ENUM-      encodeUnion [] = ResEnum tyName consName+      encodeUnion [] = ResEnum consName       -- Type References --------------------------------------------------------------       encodeUnion [FieldRep {fieldTypeRef = TypeRef {typeConName}, fieldValue}]         | isUnionRef tyName cons = ResUnion typeConName fieldValue       -- Inline Union Types -----------------------------------------------------------------------------      encodeUnion fields =-        ResUnion-          consName-          $ pure-          $ mkObject-            consName-            (fmap toFieldRes fields)+      encodeUnion fields = mkUnion consName (fmap toFieldRes fields)  -- Types & Constrains ------------------------------------------------------- exploreResolvers ::-  forall o e m a.-  ( EncodeConstraint o e m a,-    LiftOperation o+  forall m a.+  ( EncodeConstraint m a,+    Monad m   ) =>   a ->-  ResModel o e m+  ResolverValue m exploreResolvers =   convertNode     . toValue       ( TypeConstraint (encode . runIdentity) ::-          TypeConstraint (Encode o e m) (Resolver o e m (ResModel o e m)) Identity+          TypeConstraint (Encode m) (m (ResolverValue m)) Identity       )+      (Proxy @IN)  ----- HELPERS ---------------------------- objectResolvers ::-  ( EncodeConstraint o e m a,-    LiftOperation o+  ( EncodeConstraint m a,+    Monad m   ) =>   a ->-  ResolverState (ResModel o e m)+  ResolverState (ResolverValue m) objectResolvers value = constraintObject (exploreResolvers value)   where     constraintObject obj@ResObject {} =@@ -241,16 +214,15 @@     constraintObject _ =       failure ("resolver must be an object" :: InternalError) -type EncodeObjectConstraint (o :: OperationType) e (m :: * -> *) a =-  EncodeConstraint o e m (a (Resolver o e m))--type EncodeConstraint (o :: OperationType) e (m :: * -> *) a =-  ( Monad m,-    GQLType a,+type EncodeConstraint (m :: * -> *) a =+  ( GQLType a,     Generic a,-    TypeRep (Encode o e m) (Resolver o e m (ResModel o e m)) (Rep a)+    TypeRep (Encode m) (m (ResolverValue m)) (Rep a)   ) +type EncodeObjectConstraint (o :: OperationType) e (m :: * -> *) a =+  EncodeConstraint (Resolver o e m) (a (Resolver o e m))+ type EncodeConstraints e m query mut sub =   ( ChannelsConstraint e m sub,     EncodeObjectConstraint QUERY e m query,@@ -258,21 +230,21 @@     EncodeObjectConstraint SUBSCRIPTION e m sub   ) -toFieldRes :: FieldRep (Resolver o e m (ResModel o e m)) -> FieldResModel o e m+toFieldRes :: FieldRep (m (ResolverValue m)) -> ResolverEntry m toFieldRes FieldRep {fieldSelector, fieldValue} = (fieldSelector, fieldValue)  deriveModel ::   forall e m query mut sub.   (Monad m, EncodeConstraints e m query mut sub) =>   RootResolver m e query mut sub ->-  RootResModel e m+  RootResolverValue e m deriveModel   RootResolver     { queryResolver,       mutationResolver,       subscriptionResolver     } =-    RootResModel+    RootResolverValue       { query = objectResolvers queryResolver,         mutation = objectResolvers mutationResolver,         subscription = objectResolvers subscriptionResolver,@@ -280,5 +252,5 @@       }     where       channelMap-        | isEmptyType (Proxy :: Proxy (sub (Resolver SUBSCRIPTION e m))) = Nothing+        | __isEmptyType (Proxy :: Proxy (sub (Resolver SUBSCRIPTION e m))) = Nothing         | otherwise = Just (channelResolver subscriptionResolver)
src/Data/Morpheus/Server/Deriving/Schema.hs view
@@ -29,29 +29,29 @@ import Data.Functor (($>), (<$>), Functor (..)) import Data.Map (Map) import Data.Maybe (Maybe (..))+import Data.Morpheus.App.Internal.Resolving+  ( Resolver,+    resultOr,+  ) import Data.Morpheus.Core (defaultConfig, validateSchema) import Data.Morpheus.Internal.Utils   ( Failure (..),   ) import Data.Morpheus.Kind-  ( ENUM,-    GQL_KIND,-    INPUT,+  ( CUSTOM,+    DerivingKind,     INTERFACE,-    OUTPUT,     SCALAR,+    TYPE,+    WRAPPER,   ) import Data.Morpheus.Server.Deriving.Schema.Internal-  ( KindedProxy (..),-    KindedType (..),+  ( KindedType (..),     TyContentM,     UpdateDef (..),     asObjectType,     builder,     fromSchema,-    inputType,-    outputType,-    setProxyType,     unpackMs,     updateByContent,     withObject,@@ -59,21 +59,25 @@ import Data.Morpheus.Server.Deriving.Utils   ( TypeConstraint (..),     TypeRep (..),-    genericTo,+    toRep,   ) import Data.Morpheus.Server.Types.GQLType   ( GQLType (..),     TypeData (..),+    __typeData,   ) import Data.Morpheus.Server.Types.SchemaT   ( SchemaT,     toSchema,+    withInput,   ) import Data.Morpheus.Server.Types.Types-  ( MapKind,-    Pair,+  ( Pair,   )-import Data.Morpheus.Types.GQLScalar (GQLScalar (..))+import Data.Morpheus.Types.GQLScalar+  ( DecodeScalar (..),+    scalarValidator,+  ) import Data.Morpheus.Types.Internal.AST   ( ArgumentsDefinition,     CONST,@@ -96,13 +100,15 @@     TypeName,     fieldsToArguments,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Resolver,-    SubscriptionField (..),-    resultOr,+import Data.Morpheus.Utils.Kinded+  ( CategoryValue (..),+    KindedProxy (..),+    inputType,+    kinded,+    outputType,+    setKind,   ) import Data.Proxy (Proxy (..))-import Data.Set (Set) import GHC.Generics (Generic, Rep) import Language.Haskell.TH (Exp, Q) import Prelude@@ -112,11 +118,18 @@   )  type SchemaConstraints event (m :: * -> *) query mutation subscription =-  ( DeriveTypeConstraint OUT (query (Resolver QUERY event m)),-    DeriveTypeConstraint OUT (mutation (Resolver MUTATION event m)),-    DeriveTypeConstraint OUT (subscription (Resolver SUBSCRIPTION event m))+  ( DeriveTypeConstraintOpt OUT (query (Resolver QUERY event m)),+    DeriveTypeConstraintOpt OUT (mutation (Resolver MUTATION event m)),+    DeriveTypeConstraintOpt OUT (subscription (Resolver SUBSCRIPTION event m))   ) +type DeriveTypeConstraintOpt kind a =+  ( Generic a,+    GQLType a,+    TypeRep (DeriveType kind) (TyContentM kind) (Rep a),+    TypeRep (DeriveType kind) (SchemaT kind ()) (Rep a)+  )+ -- | normal morpheus server validates schema at runtime (after the schema derivation). --   this method allows you to validate it at compile time. compileTimeSchemaValidation ::@@ -147,6 +160,7 @@     schema = toSchema schemaT     schemaT ::       SchemaT+        OUT         ( TypeDefinition OBJECT CONST,           TypeDefinition OBJECT CONST,           TypeDefinition OBJECT CONST@@ -157,122 +171,101 @@         <*> deriveObjectType (Proxy @(mut (Resolver MUTATION e m)))         <*> deriveObjectType (Proxy @(subs (Resolver SUBSCRIPTION e m))) -instance {-# OVERLAPPABLE #-} (GQLType a, DeriveKindedType (KIND a) a) => DeriveType cat a where-  deriveType _ = deriveKindedType (KindedProxy :: KindedProxy (KIND a) a)- -- |  Generates internal GraphQL Schema for query validation and introspection rendering class DeriveType (kind :: TypeCategory) (a :: *) where-  deriveType :: f kind a -> SchemaT ()+  deriveType :: f a -> SchemaT kind ()+  deriveContent :: f a -> SchemaT kind (Maybe (FieldContent TRUE kind CONST)) -  deriveContent :: f kind a -> SchemaT (Maybe (FieldContent TRUE kind CONST))-  deriveContent _ = pure Nothing+instance (GQLType a, DeriveKindedType cat (KIND a) a) => DeriveType cat a where+  deriveType _ = deriveKindedType (KindedProxy :: KindedProxy (KIND a) a)+  deriveContent _ = deriveKindedContent (KindedProxy :: KindedProxy (KIND a) a) -deriveTypeWith :: DeriveType cat a => f a -> kinded cat b -> SchemaT ()-deriveTypeWith x = deriveType . setProxyType x+-- | DeriveType With specific Kind: 'kind': object, scalar, enum ...+class DeriveKindedType (cat :: TypeCategory) (kind :: DerivingKind) a where+  deriveKindedType :: kinded kind a -> SchemaT cat ()+  deriveKindedContent :: kinded kind a -> SchemaT cat (Maybe (FieldContent TRUE cat CONST))+  deriveKindedContent _ = pure Nothing --- Maybe-instance DeriveType cat a => DeriveType cat (Maybe a) where-  deriveType = deriveTypeWith (Proxy @a)+type DeriveTypeConstraint kind a =+  ( DeriveTypeConstraintOpt kind a,+    CategoryValue kind+  ) --- List-instance DeriveType cat a => DeriveType cat [a] where-  deriveType = deriveTypeWith (Proxy @a)+-- SCALAR+instance (GQLType a, DeriveType cat a) => DeriveKindedType cat WRAPPER (f a) where+  deriveKindedType _ = deriveType (KindedProxy :: KindedProxy cat a) --- Tuple-instance DeriveType cat (Pair k v) => DeriveType cat (k, v) where-  deriveType = deriveTypeWith (Proxy @(Pair k v))+instance (GQLType a, DecodeScalar a) => DeriveKindedType cat SCALAR a where+  deriveKindedType = updateByContent deriveScalarContent . setKind (Proxy @LEAF) --- Set-instance DeriveType cat [a] => DeriveType cat (Set a) where-  deriveType = deriveTypeWith (Proxy @[a])+instance DeriveTypeConstraint OUT a => DeriveKindedType OUT INTERFACE a where+  deriveKindedType = updateByContent deriveInterfaceContent . setKind (Proxy @OUT) +instance DeriveTypeConstraint OUT a => DeriveKindedType OUT TYPE a where+  deriveKindedType = deriveOutputType++instance DeriveTypeConstraint IN a => DeriveKindedType IN TYPE a where+  deriveKindedType = deriveInputType++instance DeriveType cat a => DeriveKindedType cat CUSTOM (Resolver o e m a) where+  deriveKindedType _ = deriveType (Proxy @a)++-- Tuple+instance DeriveType cat (Pair k v) => DeriveKindedType cat CUSTOM (k, v) where+  deriveKindedType _ = deriveType (Proxy @(Pair k v))+ -- Map-instance DeriveType cat (MapKind k v Maybe) => DeriveType cat (Map k v) where-  deriveType = deriveTypeWith (Proxy @(MapKind k v Maybe))+instance DeriveType cat [Pair k v] => DeriveKindedType cat CUSTOM (Map k v) where+  deriveKindedType _ = deriveType (Proxy @[Pair k v]) --- Resolver : a -> Resolver b instance   ( GQLType b,     DeriveType OUT b,     DeriveTypeConstraint IN a   ) =>-  DeriveType OUT (a -> m b)+  DeriveKindedType OUT CUSTOM (a -> m b)   where-  deriveContent _ = Just . FieldArgs <$> deriveArgumentDefinition (Proxy @a)-  deriveType _ = deriveType (outputType $ Proxy @b)--instance (DeriveType OUT a) => DeriveType OUT (SubscriptionField a) where-  deriveType _ = deriveType (KindedProxy :: KindedProxy OUT a)----  GQL Resolver b, MUTATION, SUBSCRIPTION, QUERY-instance (DeriveType cat b) => DeriveType cat (Resolver fo e m b) where-  deriveType = deriveTypeWith (Proxy @b)---- | DeriveType With specific Kind: 'kind': object, scalar, enum ...-class DeriveKindedType (kind :: GQL_KIND) a where-  deriveKindedType :: proxy kind a -> SchemaT ()---- SCALAR-instance (GQLType a, GQLScalar a) => DeriveKindedType SCALAR a where-  deriveKindedType = updateByContent deriveScalarContent---- ENUM-instance DeriveTypeConstraint IN a => DeriveKindedType ENUM a where-  deriveKindedType = deriveInputType--instance DeriveTypeConstraint IN a => DeriveKindedType INPUT a where-  deriveKindedType = deriveInputType--instance DeriveTypeConstraint OUT a => DeriveKindedType OUTPUT a where-  deriveKindedType = deriveOutputType--type DeriveTypeConstraint kind a =-  ( Generic a,-    GQLType a,-    TypeRep (DeriveType kind) (TyContentM kind) (Rep a),-    TypeRep (DeriveType kind) (SchemaT ()) (Rep a)-  )--instance DeriveTypeConstraint OUT a => DeriveKindedType INTERFACE a where-  deriveKindedType = updateByContent deriveInterfaceContent+  deriveKindedContent _ = Just . FieldArgs <$> deriveArgumentDefinition (Proxy @a)+  deriveKindedType _ = deriveType (outputType $ Proxy @b) -deriveScalarContent :: (GQLScalar a) => f a -> SchemaT (TypeContent TRUE LEAF CONST)+deriveScalarContent :: (DecodeScalar a) => f k a -> SchemaT cat (TypeContent TRUE LEAF CONST) deriveScalarContent = pure . DataScalar . scalarValidator -deriveInterfaceContent :: DeriveTypeConstraint OUT a => f a -> SchemaT (TypeContent TRUE OUT CONST)+deriveInterfaceContent :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeContent TRUE OUT CONST) deriveInterfaceContent = fmap DataInterface . deriveFields . outputType -deriveArgumentDefinition :: DeriveTypeConstraint IN a => f a -> SchemaT (ArgumentsDefinition CONST)-deriveArgumentDefinition = fmap fieldsToArguments . deriveFields . inputType+deriveArgumentDefinition :: DeriveTypeConstraint IN a => f a -> SchemaT OUT (ArgumentsDefinition CONST)+deriveArgumentDefinition = withInput . fmap fieldsToArguments . deriveFields . inputType -deriveFields :: DeriveTypeConstraint kind a => KindedType kind a -> SchemaT (FieldsDefinition kind CONST)+deriveFields :: DeriveTypeConstraint kind a => KindedType kind a -> SchemaT kind (FieldsDefinition kind CONST) deriveFields kindedType = deriveTypeContent kindedType >>= withObject kindedType -deriveInputType :: DeriveTypeConstraint IN a => f a -> SchemaT ()+deriveInputType :: DeriveTypeConstraint IN a => f a -> SchemaT IN () deriveInputType = updateByContent deriveTypeContent . inputType -deriveOutputType :: DeriveTypeConstraint OUT a => f a -> SchemaT ()+deriveOutputType :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT () deriveOutputType = updateByContent deriveTypeContent . outputType -deriveObjectType :: DeriveTypeConstraint OUT a => f a -> SchemaT (TypeDefinition OBJECT CONST)+deriveObjectType :: DeriveTypeConstraint OUT a => f a -> SchemaT OUT (TypeDefinition OBJECT CONST) deriveObjectType = asObjectType (deriveFields . outputType) -deriveImplementsInterface :: (GQLType a, DeriveType OUT a) => f a -> SchemaT TypeName-deriveImplementsInterface x = deriveType (outputType x) $> gqlTypeName (__type x)+deriveImplementsInterface :: (GQLType a, DeriveType OUT a) => f a -> SchemaT OUT TypeName+deriveImplementsInterface x = deriveType (outputType x) $> gqlTypeName (__typeData (kinded (Proxy @OUT) x))  fieldContentConstraint :: f kind a -> TypeConstraint (DeriveType kind) (TyContentM kind) Proxy fieldContentConstraint _ = TypeConstraint deriveFieldContent  deriveFieldContent :: forall f kind a. (DeriveType kind a) => f a -> TyContentM kind-deriveFieldContent _ = deriveType kinded *> deriveContent kinded+deriveFieldContent _ = deriveType kindedProxy *> deriveContent kindedProxy   where-    kinded :: KindedProxy kind a-    kinded = KindedProxy+    kindedProxy :: KindedProxy kind a+    kindedProxy = KindedProxy  deriveTypeContent ::+  forall kind a.   DeriveTypeConstraint kind a =>   KindedType kind a ->-  SchemaT (TypeContent TRUE kind CONST)-deriveTypeContent kinded =-  unpackMs (genericTo (fieldContentConstraint kinded) kinded)-    >>= fmap (updateDef kinded) . builder kinded+  SchemaT kind (TypeContent TRUE kind CONST)+deriveTypeContent kindedProxy =+  unpackMs (toRep (fieldContentConstraint kindedProxy) kindedProxy)+    >>= fmap (updateDef kindedProxy) . builder kindedProxy
src/Data/Morpheus/Server/Deriving/Schema/Internal.hs view
@@ -7,9 +7,9 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PolyKinds #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}@@ -19,12 +19,8 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Server.Deriving.Schema.Internal-  ( KindedProxy (..),-    KindedType (..),+  ( KindedType (..),     builder,-    inputType,-    outputType,-    setProxyType,     unpackMs,     UpdateDef (..),     withObject,@@ -36,14 +32,12 @@ where  -- MORPHEUS--import Control.Applicative (Applicative (..))-import Control.Monad.Fail (fail)-import Data.Foldable (concatMap, traverse_)-import Data.Functor (($>), (<$>), Functor (..)) import Data.List (partition) import qualified Data.Map as M-import Data.Maybe (Maybe (..), fromMaybe)+import Data.Morpheus.App.Internal.Resolving+  ( Eventless,+    Result (..),+  ) import Data.Morpheus.Error (globalErrorMessage) import Data.Morpheus.Internal.Utils   ( Failure (..),@@ -60,11 +54,13 @@ import Data.Morpheus.Server.Types.GQLType   ( GQLType (..),     TypeData (..),+    __typeData,   ) import Data.Morpheus.Server.Types.SchemaT   ( SchemaT,     insertType,     updateSchema,+    withInterface,   ) import Data.Morpheus.Types.Internal.AST   ( CONST,@@ -83,7 +79,7 @@     Schema (..),     TRUE,     Token,-    TypeCategory,+    TypeCategory (..),     TypeContent (..),     TypeDefinition (..),     TypeName (..),@@ -91,109 +87,75 @@     VALID,     mkEnumContent,     mkField,-    mkInputValue,+    mkNullaryMember,     mkType,+    mkTypeRef,     mkUnionMember,     msg,+    unitFieldName,+    unitTypeName,     unsafeFromFields,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Eventless,-    Result (..),+import Data.Morpheus.Utils.Kinded+  ( CategoryValue (..),+    KindedType (..),+    outputType,   )-import Data.Semigroup ((<>))-import Data.Traversable (traverse) import Language.Haskell.TH (Exp, Q)-import Prelude-  ( ($),-    (.),-    Bool (..),-    Show (..),-    map,-    null,-    otherwise,-    sequence,-  )---- | context , like Proxy with multiple parameters--- * 'kind': object, scalar, enum ...--- * 'a': actual gql type-data KindedProxy k a-  = KindedProxy--data KindedType (cat :: TypeCategory) a where-  InputType :: KindedType IN a-  OutputType :: KindedType OUT a---- converts:---   f a -> KindedType IN a--- or---  f k a -> KindedType IN a-inputType :: f a -> KindedType IN a-inputType _ = InputType--outputType :: f a -> KindedType OUT a-outputType _ = OutputType--deriving instance Show (KindedType cat a)--setProxyType :: f b -> kinded k a -> KindedProxy k b-setProxyType _ _ = KindedProxy+import Relude  fromSchema :: Eventless (Schema VALID) -> Q Exp fromSchema Success {} = [|()|] fromSchema Failure {errors} = fail (show errors) -withObject :: (GQLType a) => KindedType c a -> TypeContent TRUE any s -> SchemaT (FieldsDefinition c s)+withObject :: (GQLType a, CategoryValue c) => KindedType c a -> TypeContent TRUE any s -> SchemaT c (FieldsDefinition c s) withObject InputType DataInputObject {inputObjectFields} = pure inputObjectFields withObject OutputType DataObject {objectFields} = pure objectFields withObject x _ = failureOnlyObject x  asObjectType ::-  GQLType a =>-  (f2 a -> SchemaT (FieldsDefinition OUT CONST)) ->+  (GQLType a) =>+  (f2 a -> SchemaT c (FieldsDefinition OUT CONST)) ->   f2 a ->-  SchemaT (TypeDefinition OBJECT CONST)-asObjectType f proxy = (`mkObjectType` gqlTypeName (__type proxy)) <$> f proxy+  SchemaT c (TypeDefinition OBJECT CONST)+asObjectType f proxy = (`mkObjectType` gqlTypeName (__typeData (outputType proxy))) <$> f proxy  mkObjectType :: FieldsDefinition OUT CONST -> TypeName -> TypeDefinition OBJECT CONST mkObjectType fields typeName = mkType typeName (DataObject [] fields) -failureOnlyObject :: forall c a b. (GQLType a) => KindedType c a -> SchemaT b+failureOnlyObject :: forall (c :: TypeCategory) a b. (GQLType a, CategoryValue c) => KindedType c a -> SchemaT c b failureOnlyObject proxy =   failure     $ globalErrorMessage-    $ msg (gqlTypeName $ __type proxy) <> " should have only one nonempty constructor"+    $ msg (gqlTypeName $ __typeData proxy) <> " should have only one nonempty constructor" -type TyContentM kind = (SchemaT (Maybe (FieldContent TRUE kind CONST)))+type TyContentM kind = (SchemaT kind (Maybe (FieldContent TRUE kind CONST)))  type TyContent kind = Maybe (FieldContent TRUE kind CONST) -unpackM :: FieldRep (TyContentM k) -> SchemaT (FieldRep (TyContent k))+unpackM :: FieldRep (TyContentM k) -> SchemaT k (FieldRep (TyContent k)) unpackM FieldRep {..} =   FieldRep fieldSelector fieldTypeRef fieldIsObject     <$> fieldValue -unpackCons :: ConsRep (TyContentM k) -> SchemaT (ConsRep (TyContent k))+unpackCons :: ConsRep (TyContentM k) -> SchemaT k (ConsRep (TyContent k)) unpackCons ConsRep {..} = ConsRep consName <$> traverse unpackM consFields -unpackMs :: [ConsRep (TyContentM k)] -> SchemaT [ConsRep (TyContent k)]+unpackMs :: [ConsRep (TyContentM k)] -> SchemaT k [ConsRep (TyContent k)] unpackMs = traverse unpackCons  builder ::-  GQLType a =>+  (GQLType a, CategoryValue kind) =>   KindedType kind a ->   [ConsRep (TyContent kind)] ->-  SchemaT (TypeContent TRUE kind CONST)-builder scope [ConsRep {consFields}] = buildObj <$> sequence (implements scope)+  SchemaT cat (TypeContent TRUE kind CONST)+builder scope [ConsRep {consFields}] = buildObj <$> withInterface (sequence (implements scope))   where     buildObj interfaces = wrapFields interfaces scope (mkFieldsDefinition consFields) builder scope cons = genericUnion cons   where-    typeData = __type scope-    genericUnion =-      mkUnionType scope typeData-        . analyseRep (gqlTypeName typeData)+    typeData = __typeData scope+    genericUnion = mkUnionType scope . analyseRep (gqlTypeName typeData)  class UpdateDef value where   updateDef :: GQLType a => f a -> value -> value@@ -248,13 +210,13 @@       _ -> args  updateByContent ::-  GQLType a =>-  (f kind a -> SchemaT (TypeContent TRUE cat CONST)) ->+  (GQLType a, CategoryValue kind) =>+  (f kind a -> SchemaT c (TypeContent TRUE kind CONST)) ->   f kind a ->-  SchemaT ()+  SchemaT c () updateByContent f proxy =   updateSchema-    (gqlFingerprint $ __type proxy)+    (gqlFingerprint $ __typeData proxy)     deriveD     proxy   where@@ -262,41 +224,46 @@       fmap         ( TypeDefinition             (description proxy)-            (gqlTypeName (__type proxy))+            (gqlTypeName (__typeData proxy))             []         )         . f  analyseRep :: TypeName -> [ConsRep (Maybe (FieldContent TRUE kind CONST))] -> ResRep (Maybe (FieldContent TRUE kind CONST))-analyseRep baseName cons =-  ResRep-    { enumCons = fmap consName enumRep,-      unionRef = fieldTypeName <$> concatMap consFields unionRefRep,-      unionRecordRep-    }+analyseRep baseName cons+  | all isEmptyConstraint cons = EnumRep {enumCons = consName <$> cons}+  | otherwise =+    ResRep+      { unionRef = fieldTypeName <$> concatMap consFields unionRefRep,+        unionCons+      }   where-    (enumRep, left1) = partition isEmptyConstraint cons-    (unionRefRep, unionRecordRep) = partition (isUnionRef baseName) left1+    (unionRefRep, unionCons) = partition (isUnionRef baseName) cons  mkUnionType ::+  forall kind c a.   KindedType kind a ->-  TypeData ->   ResRep (Maybe (FieldContent TRUE kind CONST)) ->-  SchemaT (TypeContent TRUE kind CONST)-mkUnionType InputType _ ResRep {unionRef = [], unionRecordRep = [], enumCons} = pure $ mkEnumContent enumCons-mkUnionType OutputType _ ResRep {unionRef = [], unionRecordRep = [], enumCons} = pure $ mkEnumContent enumCons-mkUnionType InputType _ ResRep {unionRef, unionRecordRep, enumCons} = DataInputUnion <$> typeMembers+  SchemaT c (TypeContent TRUE kind CONST)+mkUnionType InputType EnumRep {enumCons} = pure $ mkEnumContent enumCons+mkUnionType OutputType EnumRep {enumCons} = pure $ mkEnumContent enumCons+mkUnionType InputType ResRep {unionRef, unionCons} = DataInputUnion <$> typeMembers   where-    typeMembers :: SchemaT [UnionMember IN CONST]-    typeMembers = withMembers <$> buildUnions unionRecordRep+    (nullaries, cons) = partition isEmptyConstraint unionCons+    nullaryMembers :: [UnionMember IN CONST]+    nullaryMembers = mkNullaryMember . consName <$> nullaries+    defineEnumEmpty+      | null nullaries = pure ()+      | otherwise = defineEnumNull+    typeMembers :: SchemaT c [UnionMember IN CONST]+    typeMembers =+      (<> nullaryMembers) . withRefs+        <$> ( defineEnumEmpty *> buildUnions cons+            )       where-        withMembers unionMembers = fmap mkUnionMember (unionRef <> unionMembers) <> fmap (`UnionMember` False) enumCons-mkUnionType OutputType typeData ResRep {unionRef, unionRecordRep, enumCons} = DataUnion . map mkUnionMember <$> typeMembers-  where-    typeMembers = do-      enums <- buildUnionEnum typeData enumCons-      unions <- buildUnions unionRecordRep-      pure (unionRef <> enums <> unions)+        withRefs = fmap mkUnionMember . (unionRef <>)+mkUnionType OutputType ResRep {unionRef, unionCons} =+  DataUnion . map mkUnionMember . (unionRef <>) <$> buildUnions unionCons  wrapFields :: [TypeName] -> KindedType kind a -> FieldsDefinition kind CONST -> TypeContent TRUE kind CONST wrapFields _ InputType = DataInputObject@@ -312,19 +279,32 @@ buildUnions ::   PackObject kind =>   [ConsRep (Maybe (FieldContent TRUE kind CONST))] ->-  SchemaT [TypeName]+  SchemaT c [TypeName] buildUnions cons =   traverse_ buildURecType cons $> fmap consName cons   where-    buildURecType = insertType . buildUnionRecord+    buildURecType = buildUnionRecord >=> insertType  buildUnionRecord ::   PackObject kind =>   ConsRep (Maybe (FieldContent TRUE kind CONST)) ->-  TypeDefinition kind CONST-buildUnionRecord ConsRep {consName, consFields} =-  mkType consName (packObject $ mkFieldsDefinition consFields)+  SchemaT cat (TypeDefinition kind CONST)+buildUnionRecord ConsRep {consName, consFields} = mkType consName . packObject <$> fields+  where+    fields+      | null consFields = defineEnumNull $> singleton mkNullField+      | otherwise = pure $ mkFieldsDefinition consFields +defineEnumNull :: SchemaT cat ()+defineEnumNull =+  insertType+    ( mkType unitTypeName (mkEnumContent [unitTypeName]) ::+        TypeDefinition LEAF CONST+    )++mkNullField :: FieldDefinition cat s+mkNullField = mkField Nothing unitFieldName (mkTypeRef unitTypeName)+ class PackObject kind where   packObject :: FieldsDefinition kind CONST -> TypeContent TRUE kind CONST @@ -333,41 +313,3 @@  instance PackObject IN where   packObject = DataInputObject--buildUnionEnum ::-  TypeData ->-  [TypeName] ->-  SchemaT [TypeName]-buildUnionEnum TypeData {gqlTypeName} enums = updates $> members-  where-    members-      | null enums = []-      | otherwise = [enumTypeWrapperName]-    enumTypeName = gqlTypeName <> "Enum"-    enumTypeWrapperName = enumTypeName <> "Object"-    --------------------------    updates :: SchemaT ()-    updates-      | null enums = pure ()-      | otherwise =-        buildEnumObject enumTypeWrapperName enumTypeName-          *> buildEnum enumTypeName enums--buildEnum :: TypeName -> [TypeName] -> SchemaT ()-buildEnum typeName tags =-  insertType-    ( mkType typeName (mkEnumContent tags) ::-        TypeDefinition LEAF CONST-    )--buildEnumObject :: TypeName -> TypeName -> SchemaT ()-buildEnumObject typeName enumTypeName =-  insertType-    ( mkType-        typeName-        ( DataObject []-            $ singleton-            $ mkInputValue "enum" [] enumTypeName-        ) ::-        TypeDefinition OBJECT CONST-    )
src/Data/Morpheus/Server/Deriving/Utils.hs view
@@ -24,10 +24,9 @@     TypeConstraint (..),     FieldRep (..),     isEmptyConstraint,-    genericTo,     DataType (..),-    deriveFieldRep,     ConRep (..),+    toRep,     toValue,     isUnionRef,     fieldTypeName,@@ -40,13 +39,21 @@   ( GQLType (..),     GQLTypeOptions (..),     TypeData (..),+    __isObjectKind,+    __typeData,+    defaultTypeOptions,   ) import Data.Morpheus.Types.Internal.AST   ( FieldName (..),+    TypeCategory,     TypeName (..),     TypeRef (..),     convertToJSONName,   )+import Data.Morpheus.Utils.Kinded+  ( CategoryValue (..),+    kinded,+  ) import Data.Proxy (Proxy (..)) import Data.Semigroup (Semigroup (..)) import Data.Text@@ -73,13 +80,12 @@     datatypeName,     selName,   )-import Prelude+import Relude   ( ($),     (.),     Bool (..),     Eq (..),     Int,-    Maybe (..),     otherwise,     show,     undefined,@@ -90,12 +96,12 @@ datatypeNameProxy _ = TypeName $ pack $ datatypeName (undefined :: (M1 D d f a))  conNameProxy :: forall f (c :: Meta). Constructor c => GQLTypeOptions -> f c -> TypeName-conNameProxy GQLTypeOptions {constructorTagModifier} _ =-  TypeName $ pack $ constructorTagModifier $ conName (undefined :: M1 C c U1 a)+conNameProxy options _ =+  TypeName $ pack $ constructorTagModifier options $ conName (undefined :: M1 C c U1 a)  selNameProxy :: forall f (s :: Meta). Selector s => GQLTypeOptions -> f s -> FieldName-selNameProxy GQLTypeOptions {fieldLabelModifier} _ =-  convertToJSONName $ FieldName $ pack $ fieldLabelModifier $ selName (undefined :: M1 S s f a)+selNameProxy options _ =+  convertToJSONName $ FieldName $ pack $ fieldLabelModifier options $ selName (undefined :: M1 S s f a)  isRecordProxy :: forall f (c :: Meta). Constructor c => f c -> Bool isRecordProxy _ = conIsRecord (undefined :: (M1 C c f a))@@ -104,26 +110,27 @@   { typeConstraint :: forall a. c a => f a -> v   } -genericTo ::-  forall f constraint value (a :: *).-  (GQLType a, TypeRep constraint value (Rep a)) =>+toRep ::+  forall kinded constraint value (a :: *) (kind :: TypeCategory).+  (GQLType a, CategoryValue kind, TypeRep constraint value (Rep a)) =>   TypeConstraint constraint value Proxy ->-  f a ->+  kinded kind a ->   [ConsRep value]-genericTo f proxy = typeRep (typeOptions proxy, f) (Proxy @(Rep a))+toRep f proxy = typeRep (typeOptions proxy defaultTypeOptions, Proxy @kind, f) (Proxy @(Rep a))  toValue ::-  forall constraint value (a :: *).-  (GQLType a, Generic a, TypeRep constraint value (Rep a)) =>+  forall proxy (kind :: TypeCategory) constraint value (a :: *).+  (GQLType a, CategoryValue kind, Generic a, TypeRep constraint value (Rep a)) =>   TypeConstraint constraint value Identity ->+  proxy kind ->   a ->   DataType value-toValue f = toTypeRep (typeOptions (Proxy @a), f) . from+toValue f proxy = toTypeRep (typeOptions (Proxy @a) defaultTypeOptions, proxy, f) . from  --  GENERIC UNION class TypeRep (c :: * -> Constraint) (v :: *) f where-  typeRep :: (GQLTypeOptions, TypeConstraint c v Proxy) -> proxy f -> [ConsRep v]-  toTypeRep :: (GQLTypeOptions, TypeConstraint c v Identity) -> f a -> DataType v+  typeRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Proxy) -> proxy f -> [ConsRep v]+  toTypeRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Identity) -> f a -> DataType v  instance (Datatype d, TypeRep c v f) => TypeRep c v (M1 D d f) where   typeRep fun _ = typeRep fun (Proxy @f)@@ -136,8 +143,8 @@   toTypeRep f (R1 x) = (toTypeRep f x) {tyIsUnion = True}  instance (ConRep con v f, Constructor c) => TypeRep con v (M1 C c f) where-  typeRep f@(opt, _) _ = [deriveConsRep opt (Proxy @c) (conRep f (Proxy @f))]-  toTypeRep f@(opt, _) (M1 src) =+  typeRep f@(opt, _, _) _ = [deriveConsRep opt (Proxy @c) (conRep f (Proxy @f))]+  toTypeRep f@(opt, _, _) (M1 src) =     DataType       { tyName = "",         tyIsUnion = False,@@ -161,8 +168,8 @@       | otherwise = enumerate fields  class ConRep (c :: * -> Constraint) (v :: *) f where-  conRep :: (GQLTypeOptions, TypeConstraint c v Proxy) -> proxy f -> [FieldRep v]-  toFieldRep :: (GQLTypeOptions, TypeConstraint c v Identity) -> f a -> [FieldRep v]+  conRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Proxy) -> proxy f -> [FieldRep v]+  toFieldRep :: CategoryValue kind => (GQLTypeOptions, kinProxy (kind :: TypeCategory), TypeConstraint c v Identity) -> f a -> [FieldRep v]  -- | recursion for Object types, both of them : 'UNION' and 'INPUT_UNION' instance (ConRep c v a, ConRep c v b) => ConRep c v (a :*: b) where@@ -170,31 +177,39 @@   toFieldRep fun (a :*: b) = toFieldRep fun a <> toFieldRep fun b  instance (Selector s, GQLType a, c a) => ConRep c v (M1 S s (Rec0 a)) where-  conRep (opt, TypeConstraint f) _ = [deriveFieldRep opt (Proxy @s) (Proxy @a) (f $ Proxy @a)]-  toFieldRep (opt, TypeConstraint f) (M1 (K1 src)) = [deriveFieldRep opt (Proxy @s) (Proxy @a) (f (Identity src))]+  conRep (opt, kind, TypeConstraint f) _ = [deriveFieldRep opt (Proxy @s) (kinded kind (Proxy @a)) (f $ Proxy @a)]+  toFieldRep (opt, kind, TypeConstraint f) (M1 (K1 src)) = [deriveFieldRep opt (Proxy @s) (kinded kind (Proxy @a)) (f (Identity src))]  deriveFieldRep ::-  forall f (s :: Meta) g a v.-  (Selector s, GQLType a) =>+  forall+    proxy+    (selector :: Meta)+    (kindedProxy :: TypeCategory -> * -> *)+    a+    v+    (kind :: TypeCategory).+  ( Selector selector,+    GQLType a,+    CategoryValue kind+  ) =>   GQLTypeOptions ->-  f s ->-  g a ->+  proxy selector ->+  kindedProxy kind a ->   v ->   FieldRep v-deriveFieldRep opt pSel proxy v =+deriveFieldRep opt pSel kindedProxy v =   FieldRep     { fieldSelector = selNameProxy opt pSel,       fieldTypeRef =         TypeRef           { typeConName = gqlTypeName,-            typeWrappers = gqlWrappers,-            typeArgs = Nothing+            typeWrappers = gqlWrappers           },-      fieldIsObject = isObjectKind proxy,+      fieldIsObject = __isObjectKind kindedProxy,       fieldValue = v     }   where-    TypeData {gqlTypeName, gqlWrappers} = __type proxy+    TypeData {gqlTypeName, gqlWrappers} = __typeData kindedProxy  instance ConRep c v U1 where   conRep _ _ = []@@ -219,11 +234,12 @@   }   deriving (Functor) -data ResRep (a :: *) = ResRep-  { enumCons :: [TypeName],-    unionRef :: [TypeName],-    unionRecordRep :: [ConsRep a]-  }+data ResRep (a :: *)+  = ResRep+      { unionRef :: [TypeName],+        unionCons :: [ConsRep a]+      }+  | EnumRep {enumCons :: [TypeName]}  isEmptyConstraint :: ConsRep a -> Bool isEmptyConstraint ConsRep {consFields = []} = True
src/Data/Morpheus/Server/Internal/TH/Decode.hs view
@@ -6,27 +6,19 @@  module Data.Morpheus.Server.Internal.TH.Decode   ( withInputObject,-    withMaybe,-    withList,-    withRefinedList,     withEnum,     withInputUnion,     decodeFieldWith,     withScalar,+    handleEither,   ) where --- MORPHEUS--import Control.Applicative (Applicative (..))-import Control.Monad (Monad ((>>=)))-import Data.Either (Either (..))-import Data.Functor ((<$>))-import Data.Maybe (Maybe (..))+import Data.Morpheus.App.Internal.Resolving+  ( Failure (..),+  ) import Data.Morpheus.Internal.Utils-  ( empty,-    selectBy,-    selectOr,+  ( selectOr,   ) import Data.Morpheus.Types.GQLScalar   ( toScalar,@@ -43,16 +35,11 @@     ValidObject,     ValidValue,     Value (..),+    getInputUnionValue,     msg,     msgInternal,-    toFieldName,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Failure (..),-  )-import Data.Semigroup ((<>))-import Data.Traversable (traverse)-import Prelude ((.))+import Relude hiding (empty)  withInputObject ::   Failure InternalError m =>@@ -60,34 +47,9 @@   ValidValue ->   m a withInputObject f (Object object) = f object-withInputObject _ isType = failure (typeMismatch "Object" isType)--withMaybe :: Monad m => (ValidValue -> m a) -> ValidValue -> m (Maybe a)-withMaybe _ Null = pure Nothing-withMaybe decode x = Just <$> decode x--withList ::-  (Failure InternalError m, Monad m) =>-  (ValidValue -> m a) ->-  ValidValue ->-  m [a]-withList decode (List li) = traverse decode li-withList _ isType = failure (typeMismatch "List" isType)+withInputObject _ isType = failure (typeMismatch "InputObject" isType)  -- | Useful for more restrictive instances of lists (non empty, size indexed etc)-withRefinedList ::-  (Failure InternalError m, Monad m) =>-  ([a] -> Either Message (rList a)) ->-  (ValidValue -> m a) ->-  ValidValue ->-  m (rList a)-withRefinedList refiner decode (List li) = do-  listRes <- traverse decode li-  case refiner listRes of-    Left err -> failure (typeMismatch err (List li))-    Right value -> pure value-withRefinedList _ _ isType = failure (typeMismatch "List" isType)- withEnum :: Failure InternalError m => (TypeName -> m a) -> Value VALID -> m a withEnum decode (Enum value) = decode value withEnum _ isType = failure (typeMismatch "Enum" isType)@@ -98,17 +60,10 @@   ValidObject ->   m a withInputUnion decoder unions =-  selectBy-    ("__typename not found on Input Union" :: InternalError)-    ("__typename" :: FieldName)-    unions-    >>= providesValueFor . entryValue+  either onFail onSucc (getInputUnionValue unions)   where-    providesValueFor (Enum key) = selectOr notFound onFound (toFieldName key) unions-      where-        notFound = withInputObject (decoder key unions) (Object empty)-        onFound = withInputObject (decoder key unions) . entryValue-    providesValueFor _ = failure ("__typename must be Enum" :: InternalError)+    onSucc (name, value) = withInputObject (decoder name unions) value+    onFail = failure . msgInternal  withScalar ::   (Applicative m, Failure InternalError m) =>@@ -116,7 +71,7 @@   (ScalarValue -> Either Token a) ->   Value VALID ->   m a-withScalar typename parseValue value = case toScalar value >>= parseValue of+withScalar typename decodeScalar value = case toScalar value >>= decodeScalar of   Right scalar -> pure scalar   Left message ->     failure@@ -127,6 +82,9 @@  decodeFieldWith :: (Value VALID -> m a) -> FieldName -> ValidObject -> m a decodeFieldWith decoder = selectOr (decoder Null) (decoder . entryValue)++handleEither :: Failure InternalError m => Either Message a -> m a+handleEither = either (failure . msgInternal) pure  -- if value is already validated but value has different type typeMismatch :: Message -> Value s -> InternalError
src/Data/Morpheus/Server/Internal/TH/Types.hs view
@@ -4,29 +4,40 @@   ( ServerTypeDefinition (..),     ServerDec,     ServerDecContext (..),+    ServerConsD,+    ServerFieldDefinition (..),+    toServerField,   ) where -import Control.Monad.Reader (Reader) import Data.Morpheus.Types.Internal.AST   ( ANY,     ConsD (..),+    FieldDefinition,     IN,     TypeDefinition,     TypeKind,     TypeName,   )-import Prelude-  ( Bool,-    Maybe,-    Show,-  )+import Relude +data ServerFieldDefinition cat s = ServerFieldDefinition+  { isParametrized :: Bool,+    argumentsTypeName :: Maybe TypeName,+    originalField :: FieldDefinition cat s+  }+  deriving (Show)++toServerField :: FieldDefinition c s -> ServerFieldDefinition c s+toServerField = ServerFieldDefinition False Nothing++type ServerConsD cat s = ConsD (ServerFieldDefinition cat s)+ --- Core data ServerTypeDefinition cat s = ServerTypeDefinition   { tName :: TypeName,     typeArgD :: [ServerTypeDefinition IN s],-    tCons :: [ConsD cat s],+    tCons :: [ServerConsD cat s],     tKind :: TypeKind,     typeOriginal :: Maybe (TypeDefinition ANY s)   }
src/Data/Morpheus/Server/Internal/TH/Utils.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE GADTs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}@@ -8,53 +9,93 @@     constraintTypeable,     typeNameStringE,     withPure,-    o',-    e',     mkTypeableConstraints,+    m',+    m_,+    tyConArgs,+    funDProxy,+    isParametrizedResolverType,+    isSubscription,   ) where  import Data.Morpheus.Internal.TH-  ( apply,+  ( _',+    apply,+    funDSimple,     toName,     vars,   ) import Data.Morpheus.Kind-  ( ENUM,-    INPUT,-    INTERFACE,-    OUTPUT,+  ( INTERFACE,     SCALAR,+    TYPE,     WRAPPER,   ) import Data.Morpheus.Types.Internal.AST-  ( TypeKind (..),+  ( ANY,+    OperationType (..),+    TypeDefinition (..),+    TypeKind (..),     TypeName (..),+    isResolverType,+    lookupWith,   ) import Data.Text (unpack)-import Data.Typeable (Typeable) import Language.Haskell.TH   ( CxtQ,+    Dec (..),+    DecQ,     Exp (..),+    ExpQ,+    Info (..),     Lit (..),     Name,+    Q,+    TyVarBndr,     Type (..),     cxt,-  )-import Prelude-  ( ($),-    (.),-    String,-    map,-    pure,+    mkName,+    reify,   )+import Relude hiding (Type) -o' :: Type-o' = VarT $ toName ("operation" :: TypeName)+m_ :: String+m_ = "m" -e' :: Type-e' = VarT $ toName ("encodeEvent" :: TypeName)+m' :: Type+m' = VarT (mkName m_) +isParametrizedResolverType :: TypeName -> [TypeDefinition ANY s] -> Q Bool+isParametrizedResolverType "__TypeKind" _ = pure False+isParametrizedResolverType "Boolean" _ = pure False+isParametrizedResolverType "String" _ = pure False+isParametrizedResolverType "Int" _ = pure False+isParametrizedResolverType "Float" _ = pure False+isParametrizedResolverType key lib = case lookupWith typeName key lib of+  Just x -> pure (isResolverType x)+  Nothing -> isParametrizedType <$> reify (toName key)++isParametrizedType :: Info -> Bool+isParametrizedType (TyConI x) = not $ null $ getTypeVariables x+isParametrizedType _ = False++getTypeVariables :: Dec -> [TyVarBndr]+getTypeVariables (DataD _ _ args _ _ _) = args+getTypeVariables (NewtypeD _ _ args _ _ _) = args+getTypeVariables (TySynD _ args _) = args+getTypeVariables _ = []++funDProxy :: [(Name, ExpQ)] -> [DecQ]+funDProxy = map fun+  where+    fun (name, body) = funDSimple name [_'] body++tyConArgs :: TypeKind -> [String]+tyConArgs kind+  | isResolverType kind = [m_]+  | otherwise = []+ withPure :: Exp -> Exp withPure = AppE (VarE 'pure) @@ -68,12 +109,12 @@ mkTypeableConstraints args = cxt $ map (pure . constraintTypeable) (vars args)  kindName :: TypeKind -> Name-kindName KindObject {} = ''OUTPUT kindName KindScalar = ''SCALAR-kindName KindEnum = ''ENUM-kindName KindUnion = ''OUTPUT-kindName KindInputObject = ''INPUT kindName KindList = ''WRAPPER kindName KindNonNull = ''WRAPPER-kindName KindInputUnion = ''INPUT kindName KindInterface = ''INTERFACE+kindName _ = ''TYPE++isSubscription :: TypeKind -> Bool+isSubscription (KindObject (Just Subscription)) = True+isSubscription _ = False
src/Data/Morpheus/Server/TH/Compile.hs view
@@ -15,6 +15,9 @@ import qualified Data.ByteString.Lazy.Char8 as LB   ( pack,   )+import Data.Morpheus.App.Internal.Resolving+  ( Result (..),+  ) import Data.Morpheus.Core   ( parseTypeDefinitions,   )@@ -30,9 +33,6 @@   ) import Data.Morpheus.Server.TH.Transform   ( toTHDefinitions,-  )-import Data.Morpheus.Types.Internal.Resolving-  ( Result (..),   ) import Language.Haskell.TH (Dec, Q) import Language.Haskell.TH.Quote (QuasiQuoter (..))
src/Data/Morpheus/Server/TH/Declare/GQLType.hs view
@@ -25,9 +25,7 @@ import Data.Morpheus.Internal.TH   ( apply,     applyVars,-    funDProxy,     toName,-    tyConArgs,     typeInstanceDec,   ) import Data.Morpheus.Internal.Utils@@ -40,13 +38,14 @@     ServerTypeDefinition (..),   ) import Data.Morpheus.Server.Internal.TH.Utils-  ( kindName,+  ( funDProxy,+    kindName,     mkTypeableConstraints,+    tyConArgs,   ) import Data.Morpheus.Server.Types.GQLType   ( GQLType (..),     GQLTypeOptions (..),-    defaultTypeOptions,   ) import Data.Morpheus.Types (Resolver, interface) import Data.Morpheus.Types.Internal.AST@@ -74,10 +73,9 @@ import Language.Haskell.TH import Prelude   ( ($),-    (&&),     (.),-    Eq (..),     concatMap,+    id,     null,     otherwise,   )@@ -88,6 +86,10 @@ introspectInterface :: TypeName -> ExpQ introspectInterface = interfaceF . toName +dropNamespaceOptions :: TypeKind -> TypeName -> GQLTypeOptions -> GQLTypeOptions+dropNamespaceOptions KindEnum tName opt = opt {constructorTagModifier = stripConstructorNamespace tName}+dropNamespaceOptions _ tName opt = opt {fieldLabelModifier = stripFieldNamespace tName}+ deriveGQLType :: ServerDecContext -> ServerTypeDefinition cat s -> Q [Dec] deriveGQLType   ServerDecContext {namespace}@@ -107,9 +109,8 @@           tDescription = typeOriginal >>= typeDescription           implementsFunc = listE $ fmap introspectInterface (interfacesFrom typeOriginal)           typeOptionsFunc-            | namespace && tKind == KindEnum = [|GQLTypeOptions id (stripConstructorNamespace tName)|]-            | namespace = [|GQLTypeOptions (stripFieldNamespace tName) id|]-            | otherwise = [|defaultTypeOptions|]+            | namespace = [|dropNamespaceOptions tKind tName|]+            | otherwise = varE 'id           fieldDescriptionsFunc = [|value|]             where               value = getDesc typeOriginal
src/Data/Morpheus/Server/TH/Declare/Type.hs view
@@ -9,34 +9,36 @@   ) where +import Data.Morpheus.App.Internal.Resolving+  ( SubscriptionField,+  ) import Data.Morpheus.Internal.TH-  ( declareTypeRef,-    m',+  ( apply,+    declareTypeRef,     nameSpaceField,     nameSpaceType,+    toCon,     toName,-    tyConArgs,   ) import Data.Morpheus.Server.Internal.TH.Types-  ( ServerDec,+  ( ServerConsD,+    ServerDec,     ServerDecContext (..),+    ServerFieldDefinition (..),     ServerTypeDefinition (..),   )+import Data.Morpheus.Server.Internal.TH.Utils+  ( isSubscription,+    m',+    tyConArgs,+  ) import Data.Morpheus.Types.Internal.AST-  ( ArgumentsDefinition (..),-    ConsD (..),-    FieldContent (..),+  ( ConsD (..),     FieldDefinition (..),     FieldName (..),-    TRUE,     TypeKind (..),     TypeName (..),-    isOutput,-    isOutputObject,-    isSubscription,-  )-import Data.Morpheus.Types.Internal.Resolving-  ( SubscriptionField,+    isResolverType,   ) import Language.Haskell.TH import Relude hiding (Type)@@ -66,7 +68,7 @@ derive tKind = [deriveClasses (''Generic : derivingList)]   where     derivingList-      | isOutput tKind = []+      | isResolverType tKind = []       | otherwise = [''Show]  deriveClasses :: [Name] -> DerivClause@@ -75,7 +77,7 @@ declareCons ::   TypeKind ->   TypeName ->-  [ConsD cat s] ->+  [ServerConsD cat s] ->   ServerDec [Con] declareCons tKind tName = traverse consR   where@@ -95,22 +97,33 @@ declareField ::   TypeKind ->   TypeName ->-  FieldDefinition cat s ->+  ServerFieldDefinition cat s ->   ServerDec (Name, Bang, Type)-declareField tKind tName field@FieldDefinition {fieldName} = do+declareField tKind tName field = do   namespace' <- asks namespace   pure-    ( fieldTypeName namespace' tName fieldName,+    ( fieldTypeName namespace' tName (fieldName $ originalField field),       Bang NoSourceUnpackedness NoSourceStrictness,       renderFieldType tKind field     )  renderFieldType ::   TypeKind ->-  FieldDefinition cat s ->+  ServerFieldDefinition cat s ->   Type-renderFieldType tKind FieldDefinition {fieldContent, fieldType} =-  withFieldWrappers tKind fieldContent (declareTypeRef fieldType)+renderFieldType+  tKind+  ServerFieldDefinition+    { isParametrized,+      originalField = FieldDefinition {fieldType},+      argumentsTypeName+    } =+    withFieldWrappers tKind argumentsTypeName (declareTypeRef renderTypeName fieldType)+    where+      renderTypeName :: TypeName -> Type+      renderTypeName+        | isParametrized = (`apply` [m'])+        | otherwise = toCon  fieldTypeName :: Bool -> TypeName -> FieldName -> Name fieldTypeName namespace tName fieldName@@ -139,15 +152,15 @@ ------------------------------------------------ withFieldWrappers ::   TypeKind ->-  Maybe (FieldContent TRUE cat s) ->+  Maybe TypeName ->   Type ->   Type-withFieldWrappers kind (Just (FieldArgs ArgumentsDefinition {argumentsTypename = Just argsTypename})) =+withFieldWrappers kind (Just argsTypename) =   withArgs argsTypename     . withSubscriptionField kind     . withMonad withFieldWrappers kind _-  | isOutputObject kind =+  | isResolverType kind && (KindUnion /= kind) =     withSubscriptionField kind       . withMonad   | otherwise = id
src/Data/Morpheus/Server/TH/Transform.hs view
@@ -12,27 +12,23 @@   ) where --- MORPHEUS--import Control.Applicative (pure)-import Control.Monad ((>>=))-import Control.Monad.Fail (fail)-import Data.Functor ((<$>), fmap)-import Data.Morpheus.Internal.TH-  ( infoTyVars,-    toName,-  ) import Data.Morpheus.Internal.Utils   ( capitalTypeName,     elems,     empty,     singleton,   )-import Data.Morpheus.Server.Internal.TH.Types (ServerTypeDefinition (..))+import Data.Morpheus.Server.Internal.TH.Types+  ( ServerConsD,+    ServerFieldDefinition (..),+    ServerTypeDefinition (..),+    toServerField,+  )+import Data.Morpheus.Server.Internal.TH.Utils (isParametrizedResolverType) import Data.Morpheus.Types.Internal.AST   ( ANY,-    ArgumentsDefinition (..),-    ConsD,+    ArgumentDefinition (..),+    ConsD (..),     FieldContent (..),     FieldDefinition (..),     FieldName,@@ -48,48 +44,11 @@     UnionMember (..),     hsTypeName,     kindOf,-    lookupWith,-    mkCons,     mkConsEnum,     toFieldName,   )-import Data.Semigroup ((<>)) import Language.Haskell.TH-import Prelude-  ( ($),-    Bool (..),-    Maybe (..),-    String,-    concat,-    not,-    null,-    otherwise,-    traverse,-  )--m_ :: String-m_ = "m"--getTypeArgs :: TypeName -> [TypeDefinition ANY s] -> Q (Maybe String)-getTypeArgs "__TypeKind" _ = pure Nothing-getTypeArgs "Boolean" _ = pure Nothing-getTypeArgs "String" _ = pure Nothing-getTypeArgs "Int" _ = pure Nothing-getTypeArgs "Float" _ = pure Nothing-getTypeArgs key lib = case typeContent <$> lookupWith typeName key lib of-  Just x -> pure (kindToTyArgs x)-  Nothing -> getTyArgs <$> reify (toName key)--getTyArgs :: Info -> Maybe String-getTyArgs x-  | null (infoTyVars x) = Nothing-  | otherwise = Just m_--kindToTyArgs :: TypeContent TRUE ANY s -> Maybe String-kindToTyArgs DataObject {} = Just m_-kindToTyArgs DataUnion {} = Just m_-kindToTyArgs DataInterface {} = Just m_-kindToTyArgs _ = Nothing+import Relude hiding (empty)  data TypeDec s = InputType (ServerTypeDefinition IN s) | OutputType (ServerTypeDefinition OUT s) @@ -130,7 +89,23 @@                   ..                 } -mkObjectCons :: TypeName -> FieldsDefinition cat s -> [ConsD cat s]+toHSTypeRef :: TypeRef -> TypeRef+toHSTypeRef tyRef@TypeRef {typeConName} = tyRef {typeConName = hsTypeName typeConName}++toHSFieldDefinition :: FieldDefinition cat s -> FieldDefinition cat s+toHSFieldDefinition field = field {fieldType = toHSTypeRef (fieldType field)}++toHSServerFieldDefinition :: ServerFieldDefinition cat s -> ServerFieldDefinition cat s+toHSServerFieldDefinition field = field {originalField = toHSFieldDefinition (originalField field)}++mkCons :: TypeName -> [ServerFieldDefinition cat s] -> ServerConsD cat s+mkCons typename fields =+  ConsD+    { cName = hsTypeName typename,+      cFields = fmap toHSServerFieldDefinition fields+    }++mkObjectCons :: TypeName -> [ServerFieldDefinition cat s] -> [ServerConsD cat s] mkObjectCons typeName fields = [mkCons typeName fields]  mkArgsTypeName :: Bool -> TypeName -> FieldName -> TypeName@@ -144,31 +119,30 @@   [TypeDefinition ANY s] ->   (FieldName -> TypeName) ->   FieldDefinition OUT s ->-  Q (FieldDefinition OUT s)-mkObjectField schema genArgsTypeName FieldDefinition {fieldName, fieldContent = cont, fieldType = typeRef@TypeRef {typeConName}, ..} =-  do-    typeArgs <- getTypeArgs typeConName schema+  Q (ServerFieldDefinition OUT s)+mkObjectField+  schema+  genArgsTypeName+  originalField@FieldDefinition+    { fieldName,+      fieldContent,+      fieldType = TypeRef {typeConName}+    } = do+    isParametrized <- isParametrizedResolverType typeConName schema     pure-      FieldDefinition-        { fieldName,-          fieldType = typeRef {typeConName = hsTypeName typeConName, typeArgs},-          fieldContent = cont >>= fieldCont,+      ServerFieldDefinition+        { argumentsTypeName = fieldContent >>= fieldCont,           ..         }-  where-    fieldCont :: FieldContent TRUE OUT s -> Maybe (FieldContent TRUE OUT s)-    fieldCont (FieldArgs ArgumentsDefinition {arguments})-      | not (null arguments) =-        Just $ FieldArgs $-          ArgumentsDefinition-            { argumentsTypename = Just $ genArgsTypeName fieldName,-              arguments = arguments-            }-    fieldCont _ = Nothing+    where+      fieldCont :: FieldContent TRUE OUT s -> Maybe TypeName+      fieldCont (FieldArgs arguments)+        | not (null arguments) = Just $ genArgsTypeName fieldName+      fieldCont _ = Nothing  data BuildPlan s-  = ConsIN [ConsD IN s]-  | ConsOUT [ServerTypeDefinition IN s] [ConsD OUT s]+  = ConsIN [ServerConsD IN s]+  | ConsOUT [ServerTypeDefinition IN s] [ServerConsD OUT s]  genTypeContent ::   [TypeDefinition ANY s] ->@@ -179,17 +153,17 @@ genTypeContent _ _ _ DataScalar {} = pure (ConsIN []) genTypeContent _ _ _ (DataEnum tags) = pure $ ConsIN (fmap mkConsEnum tags) genTypeContent _ _ typeName (DataInputObject fields) =-  pure $ ConsIN (mkObjectCons typeName fields)+  pure $ ConsIN (mkObjectCons typeName $ map toServerField $ elems fields) genTypeContent _ _ _ DataInputUnion {} = fail "Input Unions not Supported" genTypeContent schema toArgsTyName typeName DataInterface {interfaceFields} = do   typeArgD <- genArgumentTypes toArgsTyName interfaceFields-  objCons <- mkObjectCons typeName <$> traverse (mkObjectField schema toArgsTyName) interfaceFields+  objCons <- mkObjectCons typeName <$> traverse (mkObjectField schema toArgsTyName) (elems interfaceFields)   pure $ ConsOUT typeArgD objCons genTypeContent schema toArgsTyName typeName DataObject {objectFields} = do   typeArgD <- genArgumentTypes toArgsTyName objectFields   objCons <-     mkObjectCons typeName-      <$> traverse (mkObjectField schema toArgsTyName) objectFields+      <$> traverse (mkObjectField schema toArgsTyName) (elems objectFields)   pure $ ConsOUT typeArgD objCons genTypeContent _ _ typeName (DataUnion members) =   pure $ ConsOUT [] (fmap unionCon members)@@ -197,20 +171,23 @@     unionCon UnionMember {memberName} =       mkCons         cName-        ( singleton-            FieldDefinition-              { fieldName = "un" <> toFieldName cName,-                fieldType =-                  TypeRef-                    { typeConName = utName,-                      typeArgs = Just m_,-                      typeWrappers = []-                    },-                fieldDescription = Nothing,-                fieldDirectives = empty,-                fieldContent = Nothing-              }-        )+        $ singleton+          ServerFieldDefinition+            { isParametrized = True,+              argumentsTypeName = Nothing,+              originalField =+                FieldDefinition+                  { fieldName = "un" <> toFieldName cName,+                    fieldType =+                      TypeRef+                        { typeConName = utName,+                          typeWrappers = []+                        },+                    fieldDescription = Nothing,+                    fieldDirectives = empty,+                    fieldContent = Nothing+                  }+            }       where         cName = hsTypeName typeName <> utName         utName = hsTypeName memberName@@ -220,12 +197,12 @@   concat <$> traverse (genArgumentType genArgsTypeName) (elems fields)  genArgumentType :: (FieldName -> TypeName) -> FieldDefinition OUT s -> Q [ServerTypeDefinition IN s]-genArgumentType namespaceWith FieldDefinition {fieldName, fieldContent = Just (FieldArgs ArgumentsDefinition {arguments})}+genArgumentType namespaceWith FieldDefinition {fieldName, fieldContent = Just (FieldArgs arguments)}   | not (null arguments) =     pure       [ ServerTypeDefinition           { tName,-            tCons = [mkCons tName arguments],+            tCons = [mkCons tName $ map (toServerField . argument) $ elems arguments],             tKind = KindInputObject,             typeArgD = [],             typeOriginal = Nothing
src/Data/Morpheus/Server/Types/GQLType.hs view
@@ -2,6 +2,7 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecordWildCards #-}@@ -11,23 +12,50 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Data.Morpheus.Server.Types.GQLType-  ( GQLType (..),-    GQLTypeOptions (..),+  ( GQLType+      ( KIND,+        implements,+        description,+        getDescriptions,+        typeOptions,+        getDirectives,+        getFieldContents+      ),+    GQLTypeOptions+      ( fieldLabelModifier,+        constructorTagModifier,+        typeNameModifier+      ),     defaultTypeOptions,     TypeData (..),+    __isObjectKind,+    __isEmptyType,+    __typeData,   ) where  -- MORPHEUS-import Data.Map (Map)++import Data.Morpheus.App.Internal.Resolving+  ( Resolver,+    SubscriptionField,+  ) import Data.Morpheus.Kind+  ( CUSTOM,+    DerivingKind,+    SCALAR,+    TYPE,+    ToValue,+    WRAPPER,+    isObject,+    toValue,+  ) import Data.Morpheus.Server.Types.SchemaT   ( SchemaT,     TypeFingerprint (..),   ) import Data.Morpheus.Server.Types.Types-  ( MapKind,-    Pair,+  ( Pair,     Undefined (..),   ) import Data.Morpheus.Types.ID (ID)@@ -37,47 +65,30 @@     Description,     Directives,     FieldName,+    OUT,     QUERY,+    TypeCategory (..),     TypeName (..),     TypeWrapper (..),     Value,     toNullable,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Resolver,-    SubscriptionField,-  )-import Data.Proxy (Proxy (..))-import Data.Set (Set)+import Data.Morpheus.Utils.Kinded (CategoryValue (..)) import Data.Text-  ( Text,-    intercalate,+  ( intercalate,     pack,+    unpack,   ) import Data.Typeable   ( TyCon,     TypeRep,-    Typeable,     splitTyConApp,     tyConFingerprint,     tyConName,     typeRep,     typeRepTyCon,   )-import Prelude-  ( ($),-    (.),-    Bool (..),-    Eq (..),-    Float,-    Int,-    Maybe (..),-    String,-    concatMap,-    fmap,-    id,-    mempty,-  )+import Relude hiding (Undefined, intercalate)  data TypeData = TypeData   { gqlTypeName :: TypeName,@@ -87,36 +98,52 @@  data GQLTypeOptions = GQLTypeOptions   { fieldLabelModifier :: String -> String,-    constructorTagModifier :: String -> String+    constructorTagModifier :: String -> String,+    -- Construct a new type name depending on whether it is an input,+    -- and being given the original type name+    typeNameModifier :: Bool -> String -> String   }  defaultTypeOptions :: GQLTypeOptions defaultTypeOptions =   GQLTypeOptions     { fieldLabelModifier = id,-      constructorTagModifier = id+      constructorTagModifier = id,+      -- default is just a pass through for the original type name+      typeNameModifier = const id     } +__typeData ::+  forall kinded (kind :: TypeCategory) (a :: *).+  (GQLType a, CategoryValue kind) =>+  kinded kind a ->+  TypeData+__typeData proxy = __type proxy (categoryValue (Proxy @kind))+ getTypename :: Typeable a => f a -> TypeName-getTypename = TypeName . intercalate "_" . getName-  where-    getName = fmap (fmap (pack . tyConName)) (fmap replacePairCon . ignoreResolver . splitTyConApp . typeRep)+getTypename = TypeName . intercalate "" . getTypeConstructorNames -getFingerprint :: Typeable a => f a -> TypeFingerprint-getFingerprint = TypeableFingerprint . conFingerprints-  where-    conFingerprints = fmap (fmap tyConFingerprint) (ignoreResolver . splitTyConApp . typeRep)+getTypeConstructorNames :: Typeable a => f a -> [Text]+getTypeConstructorNames = fmap (pack . tyConName . replacePairCon) . getTypeConstructors -deriveTypeData :: Typeable a => f a -> TypeData-deriveTypeData proxy =+getTypeConstructors :: Typeable a => f a -> [TyCon]+getTypeConstructors = ignoreResolver . splitTyConApp . typeRep++deriveTypeData :: Typeable a => f a -> (Bool -> String -> String) -> TypeCategory -> TypeData+deriveTypeData proxy typeNameModifier cat =   TypeData-    { gqlTypeName = getTypename proxy,+    { gqlTypeName = TypeName . pack $ typeNameModifier (cat == IN) originalTypeName,       gqlWrappers = [],-      gqlFingerprint = getFingerprint proxy+      gqlFingerprint = getFingerprint cat proxy     }+  where+    originalTypeName = unpack . readTypeName $ getTypename proxy -mkTypeData :: TypeName -> TypeData-mkTypeData name =+getFingerprint :: Typeable a => TypeCategory -> f a -> TypeFingerprint+getFingerprint category = TypeableFingerprint category . fmap tyConFingerprint . getTypeConstructors++mkTypeData :: TypeName -> a -> TypeData+mkTypeData name _ =   TypeData     { gqlTypeName = name,       gqlFingerprint = InternalFingerprint name,@@ -146,6 +173,9 @@ ignoreResolver (con, args) =   con : concatMap (ignoreResolver . splitTyConApp) args +__isObjectKind :: forall f a. GQLType a => f a -> Bool+__isObjectKind _ = isObject $ toValue (Proxy @(KIND a))+ -- | GraphQL type, every graphQL type should have an instance of 'GHC.Generics.Generic' and 'GQLType'. -- --  @@@ -161,23 +191,20 @@ --       description = const "your description ..." --  @ class ToValue (KIND a) => GQLType a where-  type KIND a :: GQL_KIND-  type KIND a = OUTPUT+  type KIND a :: DerivingKind+  type KIND a = TYPE -  implements :: f a -> [SchemaT TypeName]+  implements :: f a -> [SchemaT OUT TypeName]   implements _ = [] -  isObjectKind :: f a -> Bool-  isObjectKind _ = isObject $ toValue (Proxy @(KIND a))-   description :: f a -> Maybe Text   description _ = Nothing    getDescriptions :: f a -> Map Text Description   getDescriptions _ = mempty -  typeOptions :: f a -> GQLTypeOptions-  typeOptions _ = defaultTypeOptions+  typeOptions :: f a -> GQLTypeOptions -> GQLTypeOptions+  typeOptions _ = id    getDirectives :: f a -> Map Text (Directives CONST)   getDirectives _ = mempty@@ -191,20 +218,26 @@       )   getFieldContents _ = mempty -  isEmptyType :: f a -> Bool-  isEmptyType _ = False+  __isEmptyType :: f a -> Bool+  __isEmptyType _ = False -  __type :: f a -> TypeData-  default __type :: Typeable a => f a -> TypeData-  __type _ = deriveTypeData (Proxy @a)+  __type :: f a -> TypeCategory -> TypeData+  default __type :: Typeable a => f a -> TypeCategory -> TypeData+  __type proxy = deriveTypeData proxy typeNameModifier+    where+      GQLTypeOptions {typeNameModifier} = typeOptions proxy defaultTypeOptions  instance GQLType Int where   type KIND Int = SCALAR   __type _ = mkTypeData "Int" +instance GQLType Double where+  type KIND Double = SCALAR+  __type _ = mkTypeData "Float"+ instance GQLType Float where   type KIND Float = SCALAR-  __type _ = mkTypeData "Float"+  __type _ = mkTypeData "Float32"  instance GQLType Text where   type KIND Text = SCALAR@@ -223,40 +256,39 @@  instance Typeable m => GQLType (Undefined m) where   type KIND (Undefined m) = WRAPPER-  isEmptyType _ = True+  __isEmptyType _ = True  instance GQLType a => GQLType (Maybe a) where   type KIND (Maybe a) = WRAPPER-  __type _ = wrapper toNullable $ __type $ Proxy @a+  __type _ = wrapper toNullable . __type (Proxy @a)  instance GQLType a => GQLType [a] where   type KIND [a] = WRAPPER-  __type _ = wrapper list $ __type $ Proxy @a--instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where-  type KIND (a, b) = WRAPPER-  __type _ = __type $ Proxy @(Pair a b)+  __type _ = wrapper list . __type (Proxy @a)  instance GQLType a => GQLType (Set a) where   type KIND (Set a) = WRAPPER   __type _ = __type $ Proxy @[a] -instance (Typeable k, Typeable v) => GQLType (Map k v) where-  type KIND (Map k v) = WRAPPER--instance GQLType a => GQLType (Resolver o e m a) where-  type KIND (Resolver o e m a) = WRAPPER-  __type _ = __type $ Proxy @a- instance GQLType a => GQLType (SubscriptionField a) where   type KIND (SubscriptionField a) = WRAPPER   __type _ = __type $ Proxy @a +instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b)++-- Manual instance GQLType b => GQLType (a -> b) where-  type KIND (a -> b) = WRAPPER+  type KIND (a -> b) = CUSTOM   __type _ = __type $ Proxy @b -instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (Pair a b)+instance (GQLType k, GQLType v, Typeable k, Typeable v) => GQLType (Map k v) where+  type KIND (Map k v) = CUSTOM+  __type _ = __type $ Proxy @[Pair k v] -instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (MapKind a b m) where-  __type _ = __type $ Proxy @(Map a b)+instance GQLType a => GQLType (Resolver o e m a) where+  type KIND (Resolver o e m a) = CUSTOM+  __type _ = __type $ Proxy @a++instance (Typeable a, Typeable b, GQLType a, GQLType b) => GQLType (a, b) where+  type KIND (a, b) = CUSTOM+  __type _ = __type $ Proxy @(Pair a b)
src/Data/Morpheus/Server/Types/SchemaT.hs view
@@ -1,10 +1,13 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-}+{-# LANGUAGE KindSignatures #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE NoImplicitPrelude #-}@@ -15,55 +18,39 @@     insertType,     TypeFingerprint (..),     toSchema,+    withInput,+    withInterface,   ) where -import Control.Applicative (Applicative (..))-import Control.Monad (Monad (..), foldM)-import Data.Function ((&))-import Data.Functor ((<$>), Functor (..))-import Data.Map-  ( Map,-    elems,-    empty,-    insert,-    member,+import qualified Data.Map as Map+import Data.Morpheus.App.Internal.Resolving+  ( Eventless,   )+import Data.Morpheus.Error (globalErrorMessage) import Data.Morpheus.Internal.Utils   ( Failure (..),   ) import Data.Morpheus.Types.Internal.AST   ( ANY,     CONST,-    CONST,+    IN,     OBJECT,+    OUT,     Schema (..),+    TypeCategory (..),     TypeContent (..),     TypeDefinition (..),-    TypeName,+    TypeName (..),     defineSchemaWith,+    msg,     toAny,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Eventless,-  )-import Data.Semigroup (Semigroup (..)) import GHC.Fingerprint.Type (Fingerprint)-import GHC.Generics (Generic)-import Prelude-  ( ($),-    (.),-    Eq (..),-    Maybe (..),-    Ord,-    Show,-    const,-    null,-    otherwise,-  )+import Relude hiding (empty)  data TypeFingerprint-  = TypeableFingerprint [Fingerprint]+  = TypeableFingerprint TypeCategory [Fingerprint]   | InternalFingerprint TypeName   | CustomFingerprint TypeName   deriving@@ -76,7 +63,7 @@ type MyMap = Map TypeFingerprint (TypeDefinition ANY CONST)  -- Helper Functions-newtype SchemaT a = SchemaT+newtype SchemaT (cat :: TypeCategory) a = SchemaT   { runSchemaT ::       Eventless         ( a,@@ -87,18 +74,18 @@  instance   Failure err Eventless =>-  Failure err SchemaT+  Failure err (SchemaT c)   where   failure = SchemaT . failure -instance Applicative SchemaT where+instance Applicative (SchemaT c) where   pure = SchemaT . pure . (,[])   (SchemaT v1) <*> (SchemaT v2) = SchemaT $ do     (f, u1) <- v1     (a, u2) <- v2     pure (f a, u1 <> u2) -instance Monad SchemaT where+instance Monad (SchemaT c) where   return = pure   (SchemaT v1) >>= f =     SchemaT $ do@@ -108,6 +95,7 @@  toSchema ::   SchemaT+    c     ( TypeDefinition OBJECT CONST,       TypeDefinition OBJECT CONST,       TypeDefinition OBJECT CONST@@ -115,32 +103,69 @@   Eventless (Schema CONST) toSchema (SchemaT v) = do   ((q, m, s), typeDefs) <- v-  types <- elems <$> execUpdates empty typeDefs+  types <-+    execUpdates Map.empty typeDefs+      >>= checkTypeCollisions . Map.toList   defineSchemaWith types (optionalType q, optionalType m, optionalType s) +withInput :: SchemaT IN a -> SchemaT OUT a+withInput (SchemaT x) = SchemaT x++withInterface :: SchemaT OUT a -> SchemaT ct a+withInterface (SchemaT x) = SchemaT x++checkTypeCollisions :: [(TypeFingerprint, TypeDefinition k a)] -> Eventless [TypeDefinition k a]+checkTypeCollisions = fmap Map.elems . foldlM collectTypes Map.empty+  where+    collectTypes :: Map (TypeName, TypeFingerprint) (TypeDefinition k a) -> (TypeFingerprint, TypeDefinition k a) -> Eventless (Map (TypeName, TypeFingerprint) (TypeDefinition k a))+    collectTypes accum (fp, typ) = maybe addType (handleCollision typ) (key `Map.lookup` accum)+      where+        addType = pure $ Map.insert key typ accum+        key = (typeName typ, withSameCategory fp)+        handleCollision t1@TypeDefinition {typeContent = DataEnum {}} t2 | t1 == t2 = pure accum+        handleCollision TypeDefinition {typeContent = DataScalar {}} TypeDefinition {typeContent = DataScalar {}} = pure accum+        handleCollision TypeDefinition {typeName = name1} _ = failureRequirePrefix name1++failureRequirePrefix :: TypeName -> Eventless b+failureRequirePrefix typename =+  failure+    $ globalErrorMessage+    $ "It appears that the Haskell type "+      <> msg typename+      <> " was used as both input and output type, which is not allowed by GraphQL specifications."+      <> "\n\n "+      <> "If you supply \"typeNameModifier\" in \"GQLType.typeOptions\", "+      <> "you can override the default type names for "+      <> msg typename+      <> " to solve this problem."++withSameCategory :: TypeFingerprint -> TypeFingerprint+withSameCategory (TypeableFingerprint _ xs) = TypeableFingerprint OUT xs+withSameCategory x = x+ optionalType :: TypeDefinition OBJECT CONST -> Maybe (TypeDefinition OBJECT CONST) optionalType td@TypeDefinition {typeContent = DataObject {objectFields}}   | null objectFields = Nothing   | otherwise = Just td  execUpdates :: Monad m => a -> [a -> m a] -> m a-execUpdates = foldM (&)+execUpdates = foldlM (&) -insertType :: TypeDefinition cat CONST -> SchemaT ()+insertType :: TypeDefinition cat CONST -> SchemaT cat' () insertType dt = updateSchema (CustomFingerprint (typeName dt)) (const $ pure dt) ()  updateSchema ::   TypeFingerprint ->-  (a -> SchemaT (TypeDefinition cat CONST)) ->+  (a -> SchemaT cat' (TypeDefinition cat CONST)) ->   a ->-  SchemaT ()+  SchemaT cat' () updateSchema InternalFingerprint {} _ _ = SchemaT $ pure ((), []) updateSchema fingerprint f x =   SchemaT $ pure ((), [upLib])   where     upLib :: MyMap -> Eventless MyMap     upLib lib-      | member fingerprint lib = pure lib+      | Map.member fingerprint lib = pure lib       | otherwise = do         (type', updates) <- runSchemaT (f x)-        execUpdates lib ((pure . insert fingerprint (toAny type')) : updates)+        execUpdates lib ((pure . Map.insert fingerprint (toAny type')) : updates)
src/Data/Morpheus/Server/Types/Types.hs view
@@ -5,21 +5,16 @@ module Data.Morpheus.Server.Types.Types   ( Undefined (..),     Pair (..),-    MapKind (..),-    mapKindFromList,+    -- MapKind (..),+    -- mapKindFromList,   ) where -import Data.Functor (fmap) import GHC.Generics   ( Generic,   ) import Prelude-  ( Applicative (..),-    Int,-    Show,-    length,-    uncurry,+  ( Show,   )  data Undefined (m :: * -> *) = Undefined deriving (Show, Generic)@@ -29,18 +24,3 @@     value :: v   }   deriving (Generic)--data MapKind k v m = MapKind-  { size :: Int,-    pairs :: m [Pair k v]-  }-  deriving (Generic)--mapKindFromList :: (Applicative m) => [(k, v)] -> MapKind k v m-mapKindFromList inputPairs =-  MapKind-    { size = length inputPairs,-      pairs = resolvePairs-    }-  where-    resolvePairs = pure (fmap (uncurry Pair) inputPairs)
src/Data/Morpheus/Types.hs view
@@ -11,7 +11,10 @@ -- | GQL Types module Data.Morpheus.Types   ( GQLType (KIND, description, implements, getDescriptions, typeOptions, getDirectives),-    GQLScalar (parseValue, serialize),+    EncodeScalar (..),+    EncodeWrapper (..),+    DecodeScalar (..),+    DecodeWrapper (..),     GQLRequest (..),     GQLResponse (..),     ID (..),@@ -65,9 +68,23 @@   ( Either (..),     either,   )-import Data.Morpheus.Core+import Data.Morpheus.App   ( App,-    RenderGQL,+  )+import Data.Morpheus.App.Internal.Resolving+  ( Failure,+    PushEvents (..),+    Resolver,+    ResolverContext (..),+    SubscriptionField,+    WithOperation,+    failure,+    pushEvents,+    subscribe,+    unsafeInternalContext,+  )+import Data.Morpheus.Core+  ( RenderGQL,     render,   ) import Data.Morpheus.Server.Deriving.Schema@@ -81,11 +98,13 @@   ) import Data.Morpheus.Server.Types.Types (Undefined (..)) import Data.Morpheus.Types.GQLScalar-  ( GQLScalar-      ( parseValue,-        serialize-      ),+  ( DecodeScalar (..),+    EncodeScalar (..),   )+import Data.Morpheus.Types.GQLWrapper+  ( DecodeWrapper (..),+    EncodeWrapper (..),+  ) import Data.Morpheus.Types.ID (ID (..)) import Data.Morpheus.Types.IO   ( GQLRequest (..),@@ -101,18 +120,6 @@     TypeName,     msg,   )-import Data.Morpheus.Types.Internal.Resolving-  ( Failure,-    PushEvents (..),-    Resolver,-    ResolverContext (..),-    SubscriptionField,-    WithOperation,-    failure,-    pushEvents,-    subscribe,-    unsafeInternalContext,-  ) import Data.Proxy   ( Proxy (..),   )@@ -220,5 +227,5 @@     subscriptionResolver :: sub (Resolver SUBSCRIPTION event m)   } -interface :: (GQLType a, DeriveType OUT a) => Proxy a -> SchemaT TypeName+interface :: (GQLType a, DeriveType OUT a) => Proxy a -> SchemaT OUT TypeName interface = deriveImplementsInterface
+ src/Data/Morpheus/Utils/Kinded.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Data.Morpheus.Utils.Kinded+  ( KindedProxy (..),+    setType,+    setKind,+    kinded,+    KindedType (..),+    inputType,+    outputType,+    CategoryValue (..),+  )+where++import Data.Morpheus.Types.Internal.AST+  ( IN,+    LEAF,+    OUT,+    TypeCategory (..),+  )+import Prelude (Show)++class CategoryValue (c :: TypeCategory) where+  categoryValue :: f c -> TypeCategory++instance CategoryValue OUT where+  categoryValue _ = OUT++instance CategoryValue IN where+  categoryValue _ = IN++instance CategoryValue LEAF where+  categoryValue _ = LEAF++-- | context , like Proxy with multiple parameters+-- * 'kind': object, scalar, enum ...+-- * 'a': actual gql type+data KindedProxy k a+  = KindedProxy++setType :: f a -> kinded (k :: t) a' -> KindedProxy k a+setType _ _ = KindedProxy++setKind :: f k -> kinded (k' :: t) a -> KindedProxy k a+setKind _ _ = KindedProxy++kinded :: f k -> f' a -> KindedProxy k a+kinded _ _ = KindedProxy++data KindedType (cat :: TypeCategory) a where+  InputType :: KindedType IN a+  OutputType :: KindedType OUT a++deriving instance Show (KindedType cat a)++-- converts:+--   f a -> KindedType IN a+-- or+--  f k a -> KindedType IN a+inputType :: f a -> KindedType IN a+inputType _ = InputType++outputType :: f a -> KindedType OUT a+outputType _ = OutputType
test/Feature/Holistic/API.hs view
@@ -25,9 +25,10 @@ import Data.Morpheus.Kind (SCALAR) import Data.Morpheus.Subscriptions (Event) import Data.Morpheus.Types-  ( GQLRequest,+  ( DecodeScalar (..),+    EncodeScalar (..),+    GQLRequest,     GQLResponse,-    GQLScalar (..),     GQLType (..),     ID (..),     RootResolver (..),@@ -54,7 +55,6 @@     Show (..),     String,     const,-    id,   )  data TestScalar@@ -66,9 +66,11 @@ instance GQLType TestScalar where   type KIND TestScalar = SCALAR -instance GQLScalar TestScalar where-  parseValue _ = pure (TestScalar 1 0)-  serialize (TestScalar x y) = Int (x * 100 + y)+instance DecodeScalar TestScalar where+  decodeScalar _ = pure (TestScalar 1 0)++instance EncodeScalar TestScalar where+  encodeScalar (TestScalar x y) = Int (x * 100 + y)  data Channel   = Channel
test/Feature/Input/Enum/API.hs view
@@ -9,20 +9,19 @@ where  import Data.Morpheus (interpreter)-import Data.Morpheus.Kind (ENUM) import Data.Morpheus.Types (GQLRequest, GQLResponse, GQLType (..), RootResolver (..), Undefined (..)) import GHC.Generics (Generic)  data TwoCon   = LA   | LB-  deriving (Show, Generic)+  deriving (Show, Generic, GQLType)  data ThreeCon   = T1   | T2   | T3-  deriving (Show, Generic)+  deriving (Show, Generic, GQLType)  data Level   = L0@@ -32,22 +31,13 @@   | L4   | L5   | L6-  deriving (Show, Generic)+  deriving (Show, Generic, GQLType)  -- types & args newtype TestArgs a = TestArgs   { level :: a   }   deriving (Generic, Show, GQLType)--instance GQLType Level where-  type KIND Level = ENUM--instance GQLType TwoCon where-  type KIND TwoCon = ENUM--instance GQLType ThreeCon where-  type KIND ThreeCon = ENUM  -- query testRes :: Applicative m => TestArgs a -> m a
test/Feature/Input/Object/API.hs view
@@ -9,7 +9,6 @@ where  import Data.Morpheus (interpreter)-import Data.Morpheus.Kind (INPUT) import Data.Morpheus.Types   ( GQLRequest,     GQLResponse,@@ -28,10 +27,7 @@     nullableField :: Maybe Int,     recursive :: Maybe InputObject   }-  deriving (Generic, Show)--instance GQLType InputObject where-  type KIND InputObject = INPUT+  deriving (Generic, Show, GQLType)  -- types & args newtype Arg a = Arg
test/Feature/Input/Scalar/API.hs view
@@ -31,7 +31,7 @@  -- resolver data Query m = Query-  { testFloat :: Arg Float -> m Float,+  { testFloat :: Arg Double -> m Double,     testInt :: Arg Int -> m Int,     testString :: Arg Text -> m Text   }
+ test/Feature/TypeCategoryCollision/Fail/API.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module Feature.TypeCategoryCollision.Fail.API+  ( api,+  )+where++import Data.Morpheus (interpreter)+import Data.Morpheus.Types+  ( GQLRequest,+    GQLResponse,+    GQLType (..),+    RootResolver (..),+    Undefined (..),+  )+import Data.Text+  ( Text,+  )+import GHC.Generics (Generic)++data Deity = Deity+  { name :: Text,+    age :: Int+  }+  deriving (Show, Generic, GQLType)++newtype DeityArgs = DeityArgs+  { input :: Deity+  }+  deriving (Show, Generic, GQLType)++newtype Query (m :: * -> *) = Query+  { deity :: DeityArgs -> m Deity+  }+  deriving (Generic, GQLType)++rootResolver :: RootResolver IO () Query Undefined Undefined+rootResolver =+  RootResolver+    { queryResolver =+        Query+          { deity =+              const $+                pure+                  Deity+                    { name =+                        "Morpheus",+                      age = 1000+                    }+          },+      mutationResolver = Undefined,+      subscriptionResolver = Undefined+    }++api :: GQLRequest -> IO GQLResponse+api = interpreter rootResolver
+ test/Feature/TypeCategoryCollision/Fail/cases.json view
@@ -0,0 +1,6 @@+[+  {+    "path": "failOnColision",+    "description": "fail if type was used as input and output type without prefixes"+  }+]
+ test/Feature/TypeCategoryCollision/Fail/failOnColision/query.gql view
@@ -0,0 +1,76 @@+query Get__Type {+  __type(name: "Deity") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeCategoryCollision/Fail/failOnColision/response.json view
@@ -0,0 +1,8 @@+{+  "errors": [+    {+      "message": "It appears that the Haskell type \"Deity\" was used as both input and output type, which is not allowed by GraphQL specifications.\n\n If you supply \"typeNameModifier\" in \"GQLType.typeOptions\", you can override the default type names for \"Deity\" to solve this problem.",+      "locations": []+    }+  ]+}
+ test/Feature/TypeCategoryCollision/Success/API.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TypeFamilies #-}++module Feature.TypeCategoryCollision.Success.API+  ( api,+  )+where++import Data.Morpheus (interpreter)+import Data.Morpheus.Types+  ( GQLRequest,+    GQLResponse,+    GQLType (..),+    GQLTypeOptions (..),+    RootResolver (..),+    Undefined (..),+  )+import Data.Text+  ( Text,+  )+import GHC.Generics (Generic)++data Deity = Deity+  { name :: Text,+    age :: Int+  }+  deriving (Show, Generic)++nonClashingTypeNameModifier :: Bool -> String -> String+nonClashingTypeNameModifier True original = "Input" ++ original+nonClashingTypeNameModifier False original = original++instance GQLType Deity where+  typeOptions _ opt = opt {typeNameModifier = nonClashingTypeNameModifier}++newtype DeityArgs = DeityArgs+  { input :: Deity+  }+  deriving (Show, Generic, GQLType)++newtype Query (m :: * -> *) = Query+  { deity :: DeityArgs -> m Deity+  }+  deriving (Generic, GQLType)++rootResolver :: RootResolver IO () Query Undefined Undefined+rootResolver =+  RootResolver+    { queryResolver =+        Query+          { deity =+              const $+                pure+                  Deity+                    { name =+                        "Morpheus",+                      age = 1000+                    }+          },+      mutationResolver = Undefined,+      subscriptionResolver = Undefined+    }++api :: GQLRequest -> IO GQLResponse+api = interpreter rootResolver
+ test/Feature/TypeCategoryCollision/Success/cases.json view
@@ -0,0 +1,6 @@+[+  {+    "path": "prefixed",+    "description": "prefixed type used as input and output does not fails"+  }+]
+ test/Feature/TypeCategoryCollision/Success/prefixed/query.gql view
@@ -0,0 +1,82 @@+query Get__Type {+  type: __type(name: "Deity") {+    ...FullType+  }+  input: __type(name: "InputDeity") {+    ...FullType+  }+  query: __type(name: "Query") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeCategoryCollision/Success/prefixed/response.json view
@@ -0,0 +1,119 @@+{+  "data": {+    "type": {+      "kind": "OBJECT",+      "name": "Deity",+      "fields": [+        {+          "name": "name",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "SCALAR",+              "name": "String",+              "ofType": null+            }+          },+          "isDeprecated": false,+          "deprecationReason": null+        },+        {+          "name": "age",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "SCALAR",+              "name": "Int",+              "ofType": null+            }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "input": {+      "kind": "INPUT_OBJECT",+      "name": "InputDeity",+      "fields": null,+      "inputFields": [+        {+          "name": "name",+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "SCALAR",+              "name": "String",+              "ofType": null+            }+          },+          "defaultValue": null+        },+        {+          "name": "age",+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "SCALAR",+              "name": "Int",+              "ofType": null+            }+          },+          "defaultValue": null+        }+      ],+      "interfaces": null,+      "enumValues": null,+      "possibleTypes": null+    },+    "query": {+      "kind": "OBJECT",+      "name": "Query",+      "fields": [+        {+          "name": "deity",+          "args": [+            {+              "name": "input",+              "type": {+                "kind": "NON_NULL",+                "name": null,+                "ofType": {+                  "kind": "INPUT_OBJECT",+                  "name": "InputDeity",+                  "ofType": null+                }+              },+              "defaultValue": null+            }+          ],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "OBJECT",+              "name": "Deity",+              "ofType": null+            }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    }+  }+}
test/Feature/TypeInference/API.hs view
@@ -11,7 +11,6 @@ where  import Data.Morpheus (interpreter)-import Data.Morpheus.Kind (INPUT) import Data.Morpheus.Types   ( GQLRequest,     GQLResponse,@@ -25,7 +24,10 @@   ) import GHC.Generics (Generic) -data Power = Thunderbolts | Shapeshift | Hurricanes+data Power+  = Thunderbolts+  | Shapeshift+  | Hurricanes   deriving (Generic, GQLType)  data Deity (m :: * -> *) = Deity@@ -41,36 +43,39 @@   { name :: Text,     age :: Int   }-  deriving (Show, Generic)--instance GQLType Hydra where-  type KIND Hydra = INPUT+  deriving (Show, Generic, GQLType)  data Monster   = MonsterHydra Hydra   | Cerberus {name :: Text}   | UnidentifiedMonster-  deriving (Show, Generic)--instance GQLType Monster where-  type KIND Monster = INPUT+  deriving (Show, Generic, GQLType)  data Character (m :: * -> *)   = CharacterDeity (Deity m) -- Only <tycon name><type ref name> should generate direct link-        -- RECORDS   | Creature {creatureName :: Text, creatureAge :: Int}   | BoxedDeity {boxedDeity :: Deity m}   | ScalarRecord {scalarText :: Text}-  | --- Types-    CharacterInt Int -- all scalars mus be boxed-      -- Types+  | CharacterInt Int   | SomeDeity (Deity m)   | SomeMutli Int Text-  | --- ENUMS-    Zeus+  | Zeus   | Cronus   deriving (Generic, GQLType) +resolveCharacter :: [Character m]+resolveCharacter =+  [ CharacterDeity deityRes,+    Creature {creatureName = "Lamia", creatureAge = 205},+    BoxedDeity {boxedDeity = deityRes},+    ScalarRecord {scalarText = "Some Text"},+    SomeDeity deityRes,+    CharacterInt 12,+    SomeMutli 21 "some text",+    Zeus,+    Cronus+  ]+ newtype MonsterArgs = MonsterArgs   { monster :: Monster   }@@ -86,25 +91,17 @@ rootResolver :: RootResolver IO () Query Undefined Undefined rootResolver =   RootResolver-    { queryResolver = Query {deity = deityRes, character, showMonster},+    { queryResolver =+        Query+          { deity = deityRes,+            character = resolveCharacter,+            showMonster+          },       mutationResolver = Undefined,       subscriptionResolver = Undefined     }   where     showMonster MonsterArgs {monster} = pure (pack $ show monster)-    character :: [Character m]-    character =-      [ CharacterDeity deityRes,-        Creature {creatureName = "Lamia", creatureAge = 205},-        BoxedDeity {boxedDeity = deityRes},-        ScalarRecord {scalarText = "Some Text"},-        ----        SomeDeity deityRes,-        CharacterInt 12,-        SomeMutli 21 "some text",-        Zeus,-        Cronus-      ]  api :: GQLRequest -> IO GQLResponse api = interpreter rootResolver
test/Feature/TypeInference/cases.json view
@@ -8,23 +8,23 @@     "description": "derive as gql enum, if type has only empty constructors"   },   {-    "path": "introspection/complexUnion",+    "path": "introspection/union/union",     "description": "derive complex union"   },   {-    "path": "introspection/complexUnionEnum",-    "description": "complex union enum contains, actual enums with empty constructors and enum object wrapper"+    "path": "introspection/union/nullary-constructors",+    "description": "empty constructors receive single field with empty type"   },   {-    "path": "introspection/complexUnionRecord",+    "path": "introspection/union/named-products",     "description": "creates object type for every union records"   },   {-    "path": "introspection/complexUnionScalar",+    "path": "introspection/union/scalars",     "description": "all scalar unions must be boxed"   },   {-    "path": "introspection/complexUnionIndexedTypes",+    "path": "introspection/union/positional-products",     "description": "all types without record syntax(indexed types), will be converted to gql object with fields _0,_1...."   },   {@@ -32,10 +32,14 @@     "description": "introspect input object"   },   {-    "path": "introspection/complexInput",+    "path": "introspection/input-union/input-union",     "description": "introspect complex input"   },   {+    "path": "introspection/input-union/empty",+    "description": "schema provides type empty on imput union"+  },+  {     "path": "resolving/object",     "description": "resolve regular object"   },@@ -44,7 +48,11 @@     "description": "resolve regular object"   },   {-    "path": "resolving/input",-    "description": "resolve input"+    "path": "resolving/input/success",+    "description": "resolve input values"+  },+  {+    "path": "resolving/input/fail",+    "description": "reject invalid input values"   } ]
− test/Feature/TypeInference/introspection/complexInput/query.gql 
@@ -1,79 +0,0 @@-query Get__Type {-  __type(name: "Monster") {-    ...FullType-  }-  tags: __type(name: "MonsterTags") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexInput/response.json 
@@ -1,70 +0,0 @@-{-  "data": {-    "__type": {-      "kind": "INPUT_OBJECT",-      "name": "Monster",-      "fields": null,-      "inputFields": [-        {-          "name": "inputname",-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": {-              "kind": "ENUM",-              "name": "MonsterTags",-              "ofType": null-            }-          },-          "defaultValue": null-        },-        {-          "name": "Hydra",-          "type": {-            "kind": "INPUT_OBJECT",-            "name": "Hydra",-            "ofType": null-          },-          "defaultValue": null-        },-        {-          "name": "Cerberus",-          "type": {-            "kind": "INPUT_OBJECT",-            "name": "Cerberus",-            "ofType": null-          },-          "defaultValue": null-        }-      ],-      "interfaces": null,-      "enumValues": null,-      "possibleTypes": null-    },-    "tags": {-      "kind": "ENUM",-      "name": "MonsterTags",-      "fields": null,-      "inputFields": null,-      "interfaces": null,-      "enumValues": [-        {-          "name": "Hydra",-          "isDeprecated": false,-          "deprecationReason": null-        },-        {-          "name": "Cerberus",-          "isDeprecated": false,-          "deprecationReason": null-        },-        {-          "name": "UnidentifiedMonster",-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "possibleTypes": null-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnion/query.gql 
@@ -1,76 +0,0 @@-query Get__Type {-  __type(name: "Character") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnion/response.json 
@@ -1,22 +0,0 @@-{-  "data": {-    "__type": {-      "kind": "UNION",-      "name": "Character",-      "fields": null,-      "inputFields": null,-      "interfaces": null,-      "enumValues": null,-      "possibleTypes": [-        { "kind": "OBJECT", "name": "Deity", "ofType": null },-        { "kind": "OBJECT", "name": "CharacterEnumObject", "ofType": null },-        { "kind": "OBJECT", "name": "Creature", "ofType": null },-        { "kind": "OBJECT", "name": "BoxedDeity", "ofType": null },-        { "kind": "OBJECT", "name": "ScalarRecord", "ofType": null },-        { "kind": "OBJECT", "name": "CharacterInt", "ofType": null },-        { "kind": "OBJECT", "name": "SomeDeity", "ofType": null },-        { "kind": "OBJECT", "name": "SomeMutli", "ofType": null }-      ]-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionEnum/query.gql 
@@ -1,79 +0,0 @@-query Get__Type {-  enumObject: __type(name: "CharacterEnumObject") {-    ...FullType-  }-  enum: __type(name: "CharacterEnum") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionEnum/response.json 
@@ -1,41 +0,0 @@-{-  "data": {-    "enumObject": {-      "kind": "OBJECT",-      "name": "CharacterEnumObject",-      "fields": [-        {-          "name": "enum",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": {-              "kind": "ENUM",-              "name": "CharacterEnum",-              "ofType": null-            }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    },-    "enum": {-      "kind": "ENUM",-      "name": "CharacterEnum",-      "fields": null,-      "inputFields": null,-      "interfaces": null,-      "enumValues": [-        { "name": "Zeus", "isDeprecated": false, "deprecationReason": null },-        { "name": "Cronus", "isDeprecated": false, "deprecationReason": null }-      ],-      "possibleTypes": null-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionIndexedTypes/query.gql 
@@ -1,79 +0,0 @@-query Get__Type {-  someDeity: __type(name: "SomeDeity") {-    ...FullType-  }-  someMutli: __type(name: "SomeMutli") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionIndexedTypes/response.json 
@@ -1,57 +0,0 @@-{-  "data": {-    "someDeity": {-      "kind": "OBJECT",-      "name": "SomeDeity",-      "fields": [-        {-          "name": "_0",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "OBJECT", "name": "Deity", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    },-    "someMutli": {-      "kind": "OBJECT",-      "name": "SomeMutli",-      "fields": [-        {-          "name": "_0",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        },-        {-          "name": "_1",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionRecord/query.gql 
@@ -1,82 +0,0 @@-query Get__Type {-  creature: __type(name: "Creature") {-    ...FullType-  }-  boxedDeity: __type(name: "BoxedDeity") {-    ...FullType-  }-  scalarRecord: __type(name: "ScalarRecord") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionRecord/response.json 
@@ -1,78 +0,0 @@-{-  "data": {-    "creature": {-      "kind": "OBJECT",-      "name": "Creature",-      "fields": [-        {-          "name": "creatureName",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        },-        {-          "name": "creatureAge",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    },-    "boxedDeity": {-      "kind": "OBJECT",-      "name": "BoxedDeity",-      "fields": [-        {-          "name": "boxedDeity",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "OBJECT", "name": "Deity", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    },-    "scalarRecord": {-      "kind": "OBJECT",-      "name": "ScalarRecord",-      "fields": [-        {-          "name": "scalarText",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionScalar/query.gql 
@@ -1,76 +0,0 @@-query Get__Type {-  __type(name: "CharacterInt") {-    ...FullType-  }-}--fragment FullType on __Type {-  kind-  name-  fields(includeDeprecated: true) {-    name-    args {-      ...InputValue-    }-    type {-      ...TypeRef-    }-    isDeprecated-    deprecationReason-  }-  inputFields {-    ...InputValue-  }-  interfaces {-    ...TypeRef-  }-  enumValues(includeDeprecated: true) {-    name-    isDeprecated-    deprecationReason-  }-  possibleTypes {-    ...TypeRef-  }-}--fragment InputValue on __InputValue {-  name-  type {-    ...TypeRef-  }-  defaultValue-}--fragment TypeRef on __Type {-  kind-  name-  ofType {-    kind-    name-    ofType {-      kind-      name-      ofType {-        kind-        name-        ofType {-          kind-          name-          ofType {-            kind-            name-            ofType {-              kind-              name-              ofType {-                kind-                name-              }-            }-          }-        }-      }-    }-  }-}
− test/Feature/TypeInference/introspection/complexUnionScalar/response.json 
@@ -1,25 +0,0 @@-{-  "data": {-    "__type": {-      "kind": "OBJECT",-      "name": "CharacterInt",-      "fields": [-        {-          "name": "_0",-          "args": [],-          "type": {-            "kind": "NON_NULL",-            "name": null,-            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }-          },-          "isDeprecated": false,-          "deprecationReason": null-        }-      ],-      "inputFields": null,-      "interfaces": [],-      "enumValues": null,-      "possibleTypes": null-    }-  }-}
+ test/Feature/TypeInference/introspection/input-union/empty/query.gql view
@@ -0,0 +1,76 @@+query Get__Type {+  __type(name: "Unit") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/input-union/empty/response.json view
@@ -0,0 +1,19 @@+{+  "data": {+    "__type": {+      "kind": "ENUM",+      "name": "Unit",+      "fields": null,+      "inputFields": null,+      "interfaces": null,+      "enumValues": [+        {+          "name": "Unit",+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/input-union/input-union/query.gql view
@@ -0,0 +1,76 @@+query Get__Type {+  __type(name: "Monster") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/input-union/input-union/response.json view
@@ -0,0 +1,41 @@+{+  "data": {+    "__type": {+      "kind": "INPUT_OBJECT",+      "name": "Monster",+      "fields": null,+      "inputFields": [+        {+          "name": "Hydra",+          "type": {+            "kind": "INPUT_OBJECT",+            "name": "Hydra",+            "ofType": null+          },+          "defaultValue": null+        },+        {+          "name": "Cerberus",+          "type": {+            "kind": "INPUT_OBJECT",+            "name": "Cerberus",+            "ofType": null+          },+          "defaultValue": null+        },+        {+          "name": "UnidentifiedMonster",+          "type": {+            "kind": "ENUM",+            "name": "Unit",+            "ofType": null+          },+          "defaultValue": null+        }+      ],+      "interfaces": null,+      "enumValues": null,+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/union/named-products/query.gql view
@@ -0,0 +1,82 @@+query Get__Type {+  creature: __type(name: "Creature") {+    ...FullType+  }+  boxedDeity: __type(name: "BoxedDeity") {+    ...FullType+  }+  scalarRecord: __type(name: "ScalarRecord") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/union/named-products/response.json view
@@ -0,0 +1,78 @@+{+  "data": {+    "creature": {+      "kind": "OBJECT",+      "name": "Creature",+      "fields": [+        {+          "name": "creatureName",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        },+        {+          "name": "creatureAge",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "boxedDeity": {+      "kind": "OBJECT",+      "name": "BoxedDeity",+      "fields": [+        {+          "name": "boxedDeity",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "OBJECT", "name": "Deity", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "scalarRecord": {+      "kind": "OBJECT",+      "name": "ScalarRecord",+      "fields": [+        {+          "name": "scalarText",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/union/nullary-constructors/query.gql view
@@ -0,0 +1,82 @@+query Get__Type {+  zeus: __type(name: "Zeus") {+    ...FullType+  }+  cronus: __type(name: "Cronus") {+    ...FullType+  }+  empty: __type(name: "Unit") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/union/nullary-constructors/response.json view
@@ -0,0 +1,69 @@+{+  "data": {+    "zeus": {+      "kind": "OBJECT",+      "name": "Zeus",+      "fields": [+        {+          "name": "_",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "ENUM",+              "name": "Unit",+              "ofType": null+            }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "cronus": {+      "kind": "OBJECT",+      "name": "Cronus",+      "fields": [+        {+          "name": "_",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": {+              "kind": "ENUM",+              "name": "Unit",+              "ofType": null+            }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "empty": {+      "kind": "ENUM",+      "name": "Unit",+      "fields": null,+      "inputFields": null,+      "interfaces": null,+      "enumValues": [+        {+          "name": "Unit",+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/union/positional-products/query.gql view
@@ -0,0 +1,79 @@+query Get__Type {+  someDeity: __type(name: "SomeDeity") {+    ...FullType+  }+  someMutli: __type(name: "SomeMutli") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/union/positional-products/response.json view
@@ -0,0 +1,57 @@+{+  "data": {+    "someDeity": {+      "kind": "OBJECT",+      "name": "SomeDeity",+      "fields": [+        {+          "name": "_0",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "OBJECT", "name": "Deity", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    },+    "someMutli": {+      "kind": "OBJECT",+      "name": "SomeMutli",+      "fields": [+        {+          "name": "_0",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        },+        {+          "name": "_1",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "String", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/union/scalars/query.gql view
@@ -0,0 +1,76 @@+query Get__Type {+  __type(name: "CharacterInt") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/union/scalars/response.json view
@@ -0,0 +1,25 @@+{+  "data": {+    "__type": {+      "kind": "OBJECT",+      "name": "CharacterInt",+      "fields": [+        {+          "name": "_0",+          "args": [],+          "type": {+            "kind": "NON_NULL",+            "name": null,+            "ofType": { "kind": "SCALAR", "name": "Int", "ofType": null }+          },+          "isDeprecated": false,+          "deprecationReason": null+        }+      ],+      "inputFields": null,+      "interfaces": [],+      "enumValues": null,+      "possibleTypes": null+    }+  }+}
+ test/Feature/TypeInference/introspection/union/union/query.gql view
@@ -0,0 +1,76 @@+query Get__Type {+  __type(name: "Character") {+    ...FullType+  }+}++fragment FullType on __Type {+  kind+  name+  fields(includeDeprecated: true) {+    name+    args {+      ...InputValue+    }+    type {+      ...TypeRef+    }+    isDeprecated+    deprecationReason+  }+  inputFields {+    ...InputValue+  }+  interfaces {+    ...TypeRef+  }+  enumValues(includeDeprecated: true) {+    name+    isDeprecated+    deprecationReason+  }+  possibleTypes {+    ...TypeRef+  }+}++fragment InputValue on __InputValue {+  name+  type {+    ...TypeRef+  }+  defaultValue+}++fragment TypeRef on __Type {+  kind+  name+  ofType {+    kind+    name+    ofType {+      kind+      name+      ofType {+        kind+        name+        ofType {+          kind+          name+          ofType {+            kind+            name+            ofType {+              kind+              name+              ofType {+                kind+                name+              }+            }+          }+        }+      }+    }+  }+}
+ test/Feature/TypeInference/introspection/union/union/response.json view
@@ -0,0 +1,23 @@+{+  "data": {+    "__type": {+      "kind": "UNION",+      "name": "Character",+      "fields": null,+      "inputFields": null,+      "interfaces": null,+      "enumValues": null,+      "possibleTypes": [+        { "kind": "OBJECT", "name": "Deity", "ofType": null },+        { "kind": "OBJECT", "name": "Creature", "ofType": null },+        { "kind": "OBJECT", "name": "BoxedDeity", "ofType": null },+        { "kind": "OBJECT", "name": "ScalarRecord", "ofType": null },+        { "kind": "OBJECT", "name": "CharacterInt", "ofType": null },+        { "kind": "OBJECT", "name": "SomeDeity", "ofType": null },+        { "kind": "OBJECT", "name": "SomeMutli", "ofType": null },+        { "kind": "OBJECT", "name": "Zeus", "ofType": null },+        { "kind": "OBJECT", "name": "Cronus", "ofType": null }+      ]+    }+  }+}
test/Feature/TypeInference/resolving/complexUnion/query.gql view
@@ -6,11 +6,6 @@       name     } -    ## union Enums-    ... on CharacterEnumObject {-      enum-    }-     ... on Creature {       creatureName       creatureAge@@ -40,6 +35,10 @@     ... on SomeMutli {       _0       _1+    }++    ... on Zeus {+      _     }   } }
test/Feature/TypeInference/resolving/complexUnion/response.json view
@@ -12,9 +12,7 @@       },       {         "__typename": "BoxedDeity",-        "boxedDeity": {-          "power": "Shapeshift"-        }+        "boxedDeity": { "power": "Shapeshift" }       },       {         "__typename": "ScalarRecord",@@ -22,10 +20,7 @@       },       {         "__typename": "SomeDeity",-        "_0": {-          "name": "Morpheus",-          "power": "Shapeshift"-        }+        "_0": { "name": "Morpheus", "power": "Shapeshift" }       },       {         "__typename": "CharacterInt",@@ -37,12 +32,11 @@         "_1": "some text"       },       {-        "__typename": "CharacterEnumObject",-        "enum": "Zeus"+        "__typename": "Zeus",+        "_": "Unit"       },       {-        "__typename": "CharacterEnumObject",-        "enum": "Cronus"+        "__typename": "Cronus"       }     ]   }
+ test/Feature/TypeInference/resolving/input/fail/query.gql view
@@ -0,0 +1,6 @@+{+  empty: showMonster(monster: {})+  multiple: showMonster(+    monster: { Hydra: { name: "someName", age: 12 }, UnidentifiedMonster: Unit }+  )+}
+ test/Feature/TypeInference/resolving/input/fail/response.json view
@@ -0,0 +1,12 @@+{+  "errors": [+    {+      "message": "Argument \"monster\" got invalid value. Expected type \"Monster!\" found {}. Exclusive input objects must provide a value for at least one field.",+      "locations": [{ "line": 2, "column": 22 }]+    },+    {+      "message": "Argument \"monster\" got invalid value. Expected type \"Monster!\" found { Hydra: { name: \"someName\", age: 12 }, UnidentifiedMonster: Unit }. Exclusive input objects are not allowed to provide values for multiple fields.",+      "locations": [{ "line": 4, "column": 5 }]+    }+  ]+}
− test/Feature/TypeInference/resolving/input/query.gql 
@@ -1,9 +0,0 @@-{-  object: showMonster(-    monster: { inputname: Hydra, Hydra: { name: "someName", age: 12 } }-  )-  record: showMonster(-    monster: { inputname: Cerberus, Cerberus: { name: "someName" } }-  )-  enum: showMonster(monster: { inputname: UnidentifiedMonster })-}
− test/Feature/TypeInference/resolving/input/response.json 
@@ -1,7 +0,0 @@-{-  "data": {-    "object": "MonsterHydra (Hydra {name = \"someName\", age = 12})",-    "record": "Cerberus {name = \"someName\"}",-    "enum": "UnidentifiedMonster"-  }-}
+ test/Feature/TypeInference/resolving/input/success/query.gql view
@@ -0,0 +1,5 @@+{+  object: showMonster(monster: { Hydra: { name: "someName", age: 12 } })+  record: showMonster(monster: { Cerberus: { name: "someName" } })+  enum: showMonster(monster: { UnidentifiedMonster: Unit })+}
+ test/Feature/TypeInference/resolving/input/success/response.json view
@@ -0,0 +1,7 @@+{+  "data": {+    "object": "MonsterHydra (Hydra {name = \"someName\", age = 12})",+    "record": "Cerberus {name = \"someName\"}",+    "enum": "UnidentifiedMonster"+  }+}
test/Feature/WrappedTypeName/ignoreMutationResolver/response.json view
@@ -20,7 +20,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Int_Int",+            "name": "WrappedIntInt",             "ofType": null           },           "isDeprecated": false,@@ -31,7 +31,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Wrapped_Text_Int_Text",+            "name": "WrappedWrappedTextIntText",             "ofType": null           },           "isDeprecated": false,
test/Feature/WrappedTypeName/ignoreQueryResolver/response.json view
@@ -24,7 +24,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Int_Int",+            "name": "WrappedIntInt",             "ofType": null           },           "isDeprecated": false,@@ -35,7 +35,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Wrapped_Text_Int_Text",+            "name": "WrappedWrappedTextIntText",             "ofType": null           },           "isDeprecated": false,
test/Feature/WrappedTypeName/ignoreSubscriptionResolver/response.json view
@@ -20,7 +20,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Int_Int",+            "name": "WrappedIntInt",             "ofType": null           },           "isDeprecated": false,@@ -31,7 +31,7 @@           "args": [],           "type": {             "kind": "OBJECT",-            "name": "Wrapped_Wrapped_Text_Int_Text",+            "name": "WrappedWrappedTextIntText",             "ofType": null           },           "isDeprecated": false,
test/Rendering/Schema.hs view
@@ -18,10 +18,9 @@  import Data.Morpheus.Document (importGQLDocumentWithNamespace) import Data.Morpheus.Types-  ( GQLScalar (..),+  ( DecodeScalar (..),     ID (..),     RootResolver (..),-    ScalarValue (..),     Undefined (..),   ) import Data.Proxy (Proxy (..))@@ -32,9 +31,8 @@   = TestScalar   deriving (Show, Generic) -instance GQLScalar TestScalar where-  parseValue _ = pure TestScalar-  serialize TestScalar = Int 0+instance DecodeScalar TestScalar where+  decodeScalar _ = pure TestScalar  importGQLDocumentWithNamespace "test/Rendering/schema.gql"
test/Spec.hs view
@@ -26,6 +26,8 @@ import qualified Feature.Schema.API as Schema   ( api,   )+import qualified Feature.TypeCategoryCollision.Fail.API as TypeCategoryCollisionFail+import qualified Feature.TypeCategoryCollision.Success.API as TypeCategoryCollisionSuccess import qualified Feature.TypeInference.API as Inference   ( api,   )@@ -56,6 +58,8 @@   defaultValue <- testFeature DefaultValue.api "Feature/Input/DefaultValue"   inference <- testFeature Inference.api "Feature/TypeInference"   subscription <- testSubsriptions+  typecatColisionFail <- testFeature TypeCategoryCollisionFail.api "Feature/TypeCategoryCollision/Fail"+  typecatColisionSuccess <- testFeature TypeCategoryCollisionSuccess.api "Feature/TypeCategoryCollision/Success"   defaultMain     ( testGroup         "Morpheus Graphql Tests"@@ -70,6 +74,8 @@           testSchemaRendering,           inference,           subscription,-          defaultValue+          defaultValue,+          typecatColisionFail,+          typecatColisionSuccess         ]     )