summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authornalchevanidze <>2019-10-08 23:36:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-10-08 23:36:00 (GMT)
commite751aabbf0dd9a51a36fe004d381a5aa478954c7 (patch)
tree8124447efe1280c6eca6a076ce9dc63a2da789ea
parent55f4a3b875bafc2858ee3e0e2f84b5f80284d03c (diff)
version 0.4.0HEAD0.4.0master
-rw-r--r--README.md69
-rw-r--r--assets/simple.gql8
-rw-r--r--changelog.md96
-rw-r--r--examples/Client/Client.hs41
-rw-r--r--examples/Sophisticated/api.gql3
-rw-r--r--morpheus-graphql.cabal30
-rw-r--r--src/Data/Morpheus/Execution/Client/Aeson.hs69
-rw-r--r--src/Data/Morpheus/Execution/Client/Build.hs71
-rw-r--r--src/Data/Morpheus/Execution/Client/Compile.hs4
-rw-r--r--src/Data/Morpheus/Execution/Client/Selection.hs308
-rw-r--r--src/Data/Morpheus/Execution/Document/Convert.hs24
-rw-r--r--src/Data/Morpheus/Execution/Document/Declare.hs6
-rw-r--r--src/Data/Morpheus/Execution/Document/Encode.hs4
-rw-r--r--src/Data/Morpheus/Execution/Document/GQLType.hs10
-rw-r--r--src/Data/Morpheus/Execution/Internal/Declare.hs17
-rw-r--r--src/Data/Morpheus/Execution/Internal/GraphScanner.hs14
-rw-r--r--src/Data/Morpheus/Execution/Internal/Utils.hs10
-rw-r--r--src/Data/Morpheus/Execution/Server/Introspect.hs17
-rw-r--r--src/Data/Morpheus/Execution/Server/Resolve.hs18
-rw-r--r--src/Data/Morpheus/Parsing/Client/ParseMeta.hs22
-rw-r--r--src/Data/Morpheus/Parsing/Client/Parser.hs28
-rw-r--r--src/Data/Morpheus/Parsing/Document/DataType.hs3
-rw-r--r--src/Data/Morpheus/Parsing/Internal/Create.hs3
-rw-r--r--src/Data/Morpheus/Parsing/Internal/Terms.hs4
-rw-r--r--src/Data/Morpheus/Parsing/Internal/Value.hs (renamed from src/Data/Morpheus/Parsing/Request/Value.hs)14
-rw-r--r--src/Data/Morpheus/Parsing/Request/Arguments.hs2
-rw-r--r--src/Data/Morpheus/Parsing/Request/Operation.hs8
-rw-r--r--src/Data/Morpheus/Rendering/RenderGQL.hs30
-rw-r--r--src/Data/Morpheus/Rendering/RenderIntrospection.hs4
-rw-r--r--src/Data/Morpheus/Schema/Schema.hs15
-rw-r--r--src/Data/Morpheus/Schema/SchemaAPI.hs23
-rw-r--r--src/Data/Morpheus/Schema/TypeKind.hs3
-rw-r--r--src/Data/Morpheus/Types/GQLType.hs6
-rw-r--r--src/Data/Morpheus/Types/ID.hs3
-rw-r--r--src/Data/Morpheus/Types/Internal/AST/Operation.hs7
-rw-r--r--src/Data/Morpheus/Types/Internal/Data.hs22
-rw-r--r--src/Data/Morpheus/Types/Internal/DataD.hs17
-rw-r--r--src/Data/Morpheus/Types/Internal/TH.hs4
-rw-r--r--src/Data/Morpheus/Types/Internal/Validation.hs3
-rw-r--r--src/Data/Morpheus/Validation/Internal/Value.hs (renamed from src/Data/Morpheus/Validation/Query/Input/Object.hs)37
-rw-r--r--src/Data/Morpheus/Validation/Query/Arguments.hs2
-rw-r--r--src/Data/Morpheus/Validation/Query/Input/Enum.hs16
-rw-r--r--src/Data/Morpheus/Validation/Query/Variable.hs44
-rw-r--r--test/Feature/Holistic/API.hs1
-rw-r--r--test/Feature/Holistic/introspection/schemaTypes/__DirectiveLocation/response.json5
-rw-r--r--test/Feature/InputType/cases.json14
-rw-r--r--test/Feature/InputType/variables/invalidValue/invalidDefaultValue/query.gql5
-rw-r--r--test/Feature/InputType/variables/invalidValue/invalidDefaultValue/response.json13
-rw-r--r--test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/query.gql5
-rw-r--r--test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/response.json13
-rw-r--r--test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/variables.json3
-rw-r--r--test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql5
-rw-r--r--test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json7
-rw-r--r--test/Feature/InputType/variables/valueNotProvided/nullableVariable/query.gql (renamed from test/Feature/InputType/variables/nullableVariable/query.gql)0
-rw-r--r--test/Feature/InputType/variables/valueNotProvided/nullableVariable/response.json (renamed from test/Feature/InputType/variables/nullableVariable/response.json)0
-rw-r--r--test/Rendering/Schema.hs39
-rw-r--r--test/Rendering/TestSchemaRendering.hs19
-rw-r--r--test/Rendering/schema.gql27
-rw-r--r--test/Spec.hs22
59 files changed, 863 insertions, 454 deletions
diff --git a/README.md b/README.md
index c050aa2..fe630c3 100644
--- a/README.md
+++ b/README.md
@@ -29,13 +29,14 @@ _stack.yml_
resolver: lts-13.30
extra-deps:
+ - morpheus-graphql-0.4.0
- aeson-1.4.4.0
- time-compat-1.9.2.2
```
As Morpheus is quite new, make sure stack can find morpheus-graphql by running `stack update`
-### Building your first GrqphQL API
+### Building your first GraphQL API
### with GraphQL syntax
@@ -350,49 +351,85 @@ rootResolver =
## Morpheus `GraphQL Client` with Template haskell QuasiQuotes
-```haskell
+```hs
defineByDocumentFile
"./schema.gql"
[gql|
- query GetHero ($byRealm: Realm)
+ query GetHero ($character: Character)
{
- deity (realm:$byRealm) {
+ deity (fatherOf:$character) {
+ name
power
- fullName
+ worships {
+ deity2Name: name
+ }
}
}
|]
```
+with schema:
+
+```gql
+input Character {
+ name: String!
+}
+
+type Deity {
+ name: String!
+ worships: Deity
+}
+```
+
will validate query and Generate:
-- response type `GetHero`, `Deity` with `Lens` Instances
-- input types: `GetHeroArgs` , `Realm`
+- namespaced response and variable types
- instance for `Fetch` typeClass
-so that
+```hs
+data GetHero = GetHero {
+ deity: DeityDeity
+}
+
+-- from: {user
+data DeityDeity = DeityDeity {
+ name: Text,
+ worships: Maybe DeityWorshipsDeity
+}
+
+-- from: {deity{worships
+data DeityWorshipsDeity = DeityWorshipsDeity {
+ name: Text,
+}
+
+data GetHeroArgs = GetHeroArgs {
+ getHeroArgsCharacter: Character
+}
+
+data Character = Character {
+ characterName: Person
+}
+```
+
+as you see, response type field name collision can be handled with GraphQL `alias`.
+
+with `fetch` you can fetch well typed response `GetHero`.
```haskell
fetchHero :: Args GetHero -> m (Either String GetHero)
fetchHero = fetch jsonRes args
where
- args = GetHeroArgs {byRealm = Just Realm {owner = "Zeus", surface = Just 10}}
+ args = GetHeroArgs {getHeroArgsCharacter = Person {characterName = "Zeus"}}
jsonRes :: ByteString -> m ByteString
jsonRes = <GraphQL APi>
```
-resolves well typed response `GetHero`.
-
-except: `defineByDocumentFile` you can use:
+types can be generatet from `introspection` too:
```haskell
defineByIntrospectionFile "./introspection.json"
```
-or
-
-`defineByIntrospection` where you can directly connect it to server
-
## Morpheus CLI for Code Generating
Generating dummy Morpheus Api from `schema.gql`
diff --git a/assets/simple.gql b/assets/simple.gql
index 42a3fdd..5a284fc 100644
--- a/assets/simple.gql
+++ b/assets/simple.gql
@@ -9,8 +9,8 @@ interface MyInterface {
}
type Mutation {
- createDeity (deityName: [[[[[String!]]!]]], deityMythology: String): Deity!
- createCharacter (charRealm: Realm! , charMutID: String! ): Character!
+ createDeity (name: [[[[[String!]]!]]], mythology: String): Deity!
+ createCharacter (realm: Realm! , id: String! ): Character!
}
union Character = Creature | Deity | Human
@@ -39,7 +39,9 @@ enum Profession {
input Realm {
owner: String!
- surface: Int
+ age: Int
+ realm: Realm
+ profession: Profession
}
enum City {
diff --git a/changelog.md b/changelog.md
index e9b248f..583503c 100644
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,99 @@
+## [0.4.0] - 09.10.2019
+
+## Changed
+
+- support of Default Value:
+
+ - on query: Parsing Validating and resolving
+ - on Document: only Parsing
+
+- 'lens' is removed from Library, client field collision can be handled with GraphQL `alias`:
+ ```gql
+ {
+ user {
+ name
+ friend {
+ friendName: name
+ }
+ }
+ }
+ ```
+
+### Fixed:
+
+- `Data.Morpheus.Document.toGraphQLDocument` generates only my user defined types. #259
+- Morpheus Client Namespaces Input Type Fields, they don't collide anymore:
+ example:
+ schema:
+
+ ```gql
+ input Person {
+ name: String!
+ }
+ ```
+
+ query:
+
+ ```gql
+ query GetUser (parent: Person!) {
+ ....
+ }
+ ```
+
+ wil generate:
+
+ ```hs
+ data GetUserArgs = GetUserArgs {
+ getUserArgsParent: Person
+ } deriving ...
+
+ data Person = Person {
+ personName: Person
+ } deriving ...
+ ```
+
+- Morpheus Client Generated Output Object And Union Types don't collide:
+
+ ```gql
+ type Person {
+ name: String!
+ parent: Person!
+ friend: Person!
+ }
+ ```
+
+ And we select
+
+ ```gql
+ {
+ user {
+ name
+ friend {
+ name
+ }
+ parent {
+ name
+ }
+ bestFriend: friend {
+ name
+ parent {
+ name
+ }
+ }
+ }
+ }
+ ```
+
+ client will Generate:
+
+ - `UserPerson` from `{user`
+ - `UserFriendPerson`: from `{user{freind`
+ - `UserParentPerson`: from `{user{parent`
+ - `UserBestFriendPerson`: from `{user{bestFrend`
+ - `UserBestFriendParentPerson`: from `{user{bestFrend{parent`
+
+- GraphQL Client Defines enums and Input Types only once per query and they don't collide
+
## [0.3.1] - 05.10.2019
### Changed
diff --git a/examples/Client/Client.hs b/examples/Client/Client.hs
index e70f3a0..29275a3 100644
--- a/examples/Client/Client.hs
+++ b/examples/Client/Client.hs
@@ -21,14 +21,20 @@ defineByIntrospectionFile
"./assets/introspection.json"
[gql|
# Query Hero with Compile time Validation
- query GetUser ($userCoordinates: Coordinates!)
+ query GetUser ($coordinates: Coordinates!)
{
myUser: user {
boo3: name
- email
- address (coordinates: $userCoordinates ){
- city
+ myUserEmail: email
+ address (coordinates: $coordinates ){
+ city
}
+ customAdress: address (coordinates: $coordinates ){
+ customCity: city
+ }
+ }
+ user {
+ email
}
}
|]
@@ -37,13 +43,13 @@ defineByDocumentFile
"./assets/simple.gql"
[gql|
# Query Hero with Compile time Validation
- query GetHero ($god: Realm, $charID: String!)
+ query GetHero ($god: Realm, $id: String!)
{
deity (mythology:$god) {
power
fullName
}
- character(characterID: $charID ) {
+ character(characterID: $id ) {
...on Creature {
creatureName
}
@@ -52,6 +58,15 @@ defineByDocumentFile
profession
}
}
+ char2: character(characterID: $id ) {
+ ...on Creature {
+ cName: creatureName
+ }
+ ...on Human {
+ lTime: lifetime
+ prof: profession
+ }
+ }
}
|]
@@ -59,13 +74,21 @@ ioRes :: ByteString -> IO ByteString
ioRes req = do
print req
return
- "{\"data\":{\"deity\":{ \"fullName\": \"name\" }, \"character\":{ \"__typename\":\"Human\", \"lifetime\": \"Lifetime\", \"profession\": \"Artist\" } }}"
+ "{\"data\":{\"deity\":{ \"fullName\": \"name\" }, \"character\":{ \"__typename\":\"Human\", \"lifetime\": \"Lifetime\", \"profession\": \"Artist\" } , \"char2\":{ \"__typename\":\"Human\", \"lTime\": \"time\", \"prof\": \"Artist\" } }}"
fetchHero :: IO (Either String GetHero)
-fetchHero = fetch ioRes GetHeroArgs {god = Just Realm {owner = "Zeus", surface = Just 10}, charID = "Hercules"}
+fetchHero =
+ fetch
+ ioRes
+ GetHeroArgs
+ { getHeroArgsGod =
+ Just Realm {realmOwner = "Zeus", realmAge = Just 10, realmRealm = Nothing, realmProfession = Just Artist}
+ , getHeroArgsId = "Hercules"
+ }
fetUser :: (ByteString -> IO ByteString) -> IO (Either String GetUser)
fetUser api = fetch api userArgs
where
userArgs :: Args GetUser
- userArgs = GetUserArgs {userCoordinates = Coordinates {longitude = [], latitude = String "1"}}
+ userArgs =
+ GetUserArgs {getUserArgsCoordinates = Coordinates {coordinatesLongitude = [], coordinatesLatitude = String "1"}}
diff --git a/examples/Sophisticated/api.gql b/examples/Sophisticated/api.gql
index d4233ca..c4dee5c 100644
--- a/examples/Sophisticated/api.gql
+++ b/examples/Sophisticated/api.gql
@@ -26,6 +26,7 @@ input Coordinates {
}
input UniqueID {
+ type: String,
id: String!
}
@@ -49,7 +50,7 @@ union MyUnion = User | Address
type Query {
user: User!
animal(animal: Animal): String!
- wrapped1: AIntText!
+ wrapped1(type: UniqueID): AIntText!
wrapped2: AText!
set: SetInt!
map: MapTextInt!
diff --git a/morpheus-graphql.cabal b/morpheus-graphql.cabal
index 3b8adb8..e099dec 100644
--- a/morpheus-graphql.cabal
+++ b/morpheus-graphql.cabal
@@ -2,10 +2,10 @@
--
-- see: https://github.com/sol/hpack
--
--- hash: 67b09c4ab9487b3b733622bc074185fee7c90c8828efc81188d85dd4b7507df8
+-- hash: 7a85b066c745ff71fcf1c0be19c670fc75e393b6919cecc737943b70b5451977
name: morpheus-graphql
-version: 0.3.1
+version: 0.4.0
synopsis: Morpheus GraphQL
description: Build GraphQL APIs with your favourite functional language!
category: web, graphql
@@ -158,6 +158,11 @@ data-files:
test/Feature/InputType/variables/incompatibleType/weakerType3/query.gql
test/Feature/InputType/variables/incompatibleType/weakerType3/response.json
test/Feature/InputType/variables/incompatibleType/weakerType3/variables.json
+ test/Feature/InputType/variables/invalidValue/invalidDefaultValue/query.gql
+ test/Feature/InputType/variables/invalidValue/invalidDefaultValue/response.json
+ test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/query.gql
+ test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/response.json
+ test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/variables.json
test/Feature/InputType/variables/invalidValue/invalidListVariable/query.gql
test/Feature/InputType/variables/invalidValue/invalidListVariable/response.json
test/Feature/InputType/variables/invalidValue/invalidListVariable/variables.json
@@ -167,8 +172,6 @@ data-files:
test/Feature/InputType/variables/nestedListNullableListReceivedNull/query.gql
test/Feature/InputType/variables/nestedListNullableListReceivedNull/response.json
test/Feature/InputType/variables/nestedListNullableListReceivedNull/variables.json
- test/Feature/InputType/variables/nullableVariable/query.gql
- test/Feature/InputType/variables/nullableVariable/response.json
test/Feature/InputType/variables/undefinedVariable/query.gql
test/Feature/InputType/variables/undefinedVariable/response.json
test/Feature/InputType/variables/unknownType/query.gql
@@ -189,6 +192,10 @@ data-files:
test/Feature/InputType/variables/validListVariable/variables.json
test/Feature/InputType/variables/valueNotProvided/nonNullVariable/query.gql
test/Feature/InputType/variables/valueNotProvided/nonNullVariable/response.json
+ test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql
+ test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json
+ test/Feature/InputType/variables/valueNotProvided/nullableVariable/query.gql
+ test/Feature/InputType/variables/valueNotProvided/nullableVariable/response.json
test/Feature/Schema/cases.json
test/Feature/Schema/nameCollision/query.gql
test/Feature/Schema/nameCollision/response.json
@@ -214,6 +221,7 @@ data-files:
test/Feature/WrappedTypeName/ignoreSubscriptionResolver/response.json
test/Feature/WrappedTypeName/validWrappedTypes/query.gql
test/Feature/WrappedTypeName/validWrappedTypes/response.json
+ test/Rendering/schema.gql
source-repository head
type: git
@@ -254,6 +262,7 @@ library
Data.Morpheus.Execution.Document.Introspect
Data.Morpheus.Execution.Internal.Declare
Data.Morpheus.Execution.Internal.Decode
+ Data.Morpheus.Execution.Internal.GraphScanner
Data.Morpheus.Execution.Internal.Utils
Data.Morpheus.Execution.Server.Decode
Data.Morpheus.Execution.Server.Encode
@@ -263,13 +272,12 @@ library
Data.Morpheus.Execution.Server.Resolve
Data.Morpheus.Execution.Subscription.Apollo
Data.Morpheus.Execution.Subscription.ClientRegister
- Data.Morpheus.Parsing.Client.ParseMeta
- Data.Morpheus.Parsing.Client.Parser
Data.Morpheus.Parsing.Document.DataType
Data.Morpheus.Parsing.Document.Parser
Data.Morpheus.Parsing.Internal.Create
Data.Morpheus.Parsing.Internal.Internal
Data.Morpheus.Parsing.Internal.Terms
+ Data.Morpheus.Parsing.Internal.Value
Data.Morpheus.Parsing.JSONSchema.Parse
Data.Morpheus.Parsing.JSONSchema.Types
Data.Morpheus.Parsing.Request.Arguments
@@ -277,7 +285,6 @@ library
Data.Morpheus.Parsing.Request.Fragment
Data.Morpheus.Parsing.Request.Operation
Data.Morpheus.Parsing.Request.Parser
- Data.Morpheus.Parsing.Request.Value
Data.Morpheus.Rendering.Haskell.Render
Data.Morpheus.Rendering.Haskell.RenderHS
Data.Morpheus.Rendering.Haskell.Terms
@@ -308,10 +315,9 @@ library
Data.Morpheus.Types.Types
Data.Morpheus.Validation.Document.Validation
Data.Morpheus.Validation.Internal.Utils
+ Data.Morpheus.Validation.Internal.Value
Data.Morpheus.Validation.Query.Arguments
Data.Morpheus.Validation.Query.Fragment
- Data.Morpheus.Validation.Query.Input.Enum
- Data.Morpheus.Validation.Query.Input.Object
Data.Morpheus.Validation.Query.Selection
Data.Morpheus.Validation.Query.Utils.Selection
Data.Morpheus.Validation.Query.Validation
@@ -325,7 +331,6 @@ library
, base >=4.7 && <5
, bytestring >=0.10.4 && <0.11
, containers >=0.4.2.1 && <0.7
- , lens
, megaparsec >=7.0.0 && <8.0
, mtl >=2.0 && <=2.2.2
, scientific >=0.3.6.2 && <0.4
@@ -360,7 +365,6 @@ executable api
, base >=4.7 && <5
, bytestring
, containers >=0.4.2.1 && <0.7
- , lens
, megaparsec >=7.0.0 && <8.0
, morpheus-graphql
, mtl
@@ -391,7 +395,6 @@ executable morpheus
, bytestring
, containers >=0.4.2.1 && <0.7
, filepath >=1.1 && <1.5
- , lens
, megaparsec >=7.0.0 && <8.0
, morpheus-graphql
, mtl
@@ -418,6 +421,8 @@ test-suite morpheus-test
Feature.UnionType.API
Feature.WrappedTypeName.API
Lib
+ Rendering.Schema
+ Rendering.TestSchemaRendering
TestFeature
Paths_morpheus_graphql
hs-source-dirs:
@@ -428,7 +433,6 @@ test-suite morpheus-test
, base >=4.7 && <5
, bytestring >=0.10.4 && <0.11
, containers >=0.4.2.1 && <0.7
- , lens
, megaparsec >=7.0.0 && <8.0
, morpheus-graphql
, mtl >=2.0 && <=2.2.2
diff --git a/src/Data/Morpheus/Execution/Client/Aeson.hs b/src/Data/Morpheus/Execution/Client/Aeson.hs
index 4e71266..6ff1c2f 100644
--- a/src/Data/Morpheus/Execution/Client/Aeson.hs
+++ b/src/Data/Morpheus/Execution/Client/Aeson.hs
@@ -10,36 +10,47 @@
module Data.Morpheus.Execution.Client.Aeson
( deriveFromJSON
+ , deriveToJSON
, takeValueType
) where
import Data.Aeson
import Data.Aeson.Types
-import qualified Data.HashMap.Lazy as H (lookup)
-import Data.Semigroup ((<>))
-import Data.Text (unpack)
+import qualified Data.HashMap.Lazy as H (lookup)
+import Data.Semigroup ((<>))
+import Data.Text (unpack)
import Language.Haskell.TH
+import Data.Morpheus.Execution.Internal.Utils (nameSpaceTypeString)
+
--
-- MORPHEUS
-import Data.Morpheus.Types.Internal.Data (DataField (..), isFieldNullable)
-import Data.Morpheus.Types.Internal.DataD (ConsD (..), TypeD (..))
-import Data.Morpheus.Types.Internal.TH (instanceFunD, instanceHeadT)
+import Data.Morpheus.Types.Internal.Data (DataField (..), isFieldNullable)
+import Data.Morpheus.Types.Internal.DataD (ConsD (..), TypeD (..))
+import Data.Morpheus.Types.Internal.TH (destructRecord, instanceFunD, instanceHeadT)
+-- FromJSON
deriveFromJSON :: TypeD -> Q Dec
deriveFromJSON TypeD {tCons = []} = fail "Type Should Have at least one Constructor"
-deriveFromJSON TypeD {tName, tCons = [cons]} = defineFromJSON tName aesonObject cons
-deriveFromJSON typeD@TypeD {tName, tCons}
- | isEnum tCons = defineFromJSON tName aesonEnum tCons
- | otherwise = defineFromJSON tName aesonUnionObject typeD
+deriveFromJSON TypeD {tName, tNamespace, tCons = [cons]} = defineFromJSON name (aesonObject tNamespace) cons
+ where
+ name = nameSpaceTypeString tNamespace tName
+deriveFromJSON typeD@TypeD {tName, tCons, tNamespace}
+ | isEnum tCons = defineFromJSON name aesonEnum tCons
+ | otherwise = defineFromJSON name (aesonUnionObject tNamespace) typeD
+ where
+ name = nameSpaceTypeString tNamespace tName
-aesonObject :: ConsD -> ExpQ
-aesonObject con@ConsD {cName} = appE [|withObject cName|] (lamE [varP (mkName "o")] (aesonObjectBody con))
+aesonObject :: [String] -> ConsD -> ExpQ
+aesonObject tNamespace con@ConsD {cName} =
+ appE [|withObject name|] (lamE [varP (mkName "o")] ((aesonObjectBody tNamespace) con))
+ where
+ name = nameSpaceTypeString tNamespace cName
-aesonObjectBody :: ConsD -> ExpQ
-aesonObjectBody ConsD {cName, cFields} = handleFields cFields
+aesonObjectBody :: [String] -> ConsD -> ExpQ
+aesonObjectBody namespace ConsD {cName, cFields} = handleFields cFields
where
- consName = mkName cName
+ consName = mkName $ nameSpaceTypeString namespace cName
------------------------------------------
handleFields [] = fail $ "No Empty Object"
handleFields fields = startExp fields
@@ -58,13 +69,14 @@ aesonObjectBody ConsD {cName, cFields} = handleFields cFields
applyFields [x] = defField x
applyFields (x:xs) = uInfixE (defField x) (varE '(<*>)) (applyFields xs)
-aesonUnionObject :: TypeD -> ExpQ
-aesonUnionObject TypeD {tCons} = appE (varE $ 'takeValueType) (lamCaseE ((map buildMatch tCons) <> [elseCaseEXP]))
+aesonUnionObject :: [String] -> TypeD -> ExpQ
+aesonUnionObject namespace TypeD {tCons} =
+ appE (varE $ 'takeValueType) (lamCaseE ((map buildMatch tCons) <> [elseCaseEXP]))
where
buildMatch cons@ConsD {cName} = match pattern body []
where
pattern = tupP [litP (stringL cName), varP $ mkName "o"]
- body = normalB (aesonObjectBody cons)
+ body = normalB $ aesonObjectBody namespace cons
takeValueType :: ((String, Object) -> Parser a) -> Value -> Parser a
takeValueType f (Object hMap) =
@@ -105,3 +117,24 @@ elseCaseEXP = match (varP varName) body []
appE
(varE $ mkName "fail")
(uInfixE (appE (varE 'show) (varE varName)) (varE '(<>)) (stringE $ " is Not Valid Union Constructor"))
+
+-- ToJSON
+deriveToJSON :: TypeD -> Q [Dec]
+deriveToJSON TypeD {tCons = []} = fail "Type Should Have at least one Constructor"
+deriveToJSON TypeD {tName, tCons = [ConsD {cFields}]} = pure <$> instanceD (cxt []) appHead methods
+ where
+ appHead = instanceHeadT ''ToJSON tName []
+ ------------------------------------------------------------------
+ -- defines: toJSON (User field1 field2 ...)= object ["name" .= name, "age" .= age, ...]
+ methods = [funD 'toJSON [clause argsE (normalB body) []]]
+ where
+ argsE = [destructRecord tName varNames]
+ body = appE (varE 'object) (listE $ map decodeVar varNames)
+ decodeVar name = [|name .= $(varName)|]
+ where
+ varName = varE $ mkName name
+ varNames = map (unpack . fieldName) cFields
+deriveToJSON TypeD {tName, tCons}
+ | isEnum tCons = pure <$> instanceD (cxt []) (instanceHeadT ''ToJSON tName []) []
+ -- enum: uses default aeson instance derivation methods
+ | otherwise = fail "Input Unions are not yet supported"
diff --git a/src/Data/Morpheus/Execution/Client/Build.hs b/src/Data/Morpheus/Execution/Client/Build.hs
index 5b19044..2356ac3 100644
--- a/src/Data/Morpheus/Execution/Client/Build.hs
+++ b/src/Data/Morpheus/Execution/Client/Build.hs
@@ -8,52 +8,61 @@ module Data.Morpheus.Execution.Client.Build
( defineQuery
) where
-import Control.Lens (declareLenses)
-import Data.Aeson (ToJSON)
import Data.Semigroup ((<>))
import Language.Haskell.TH
--
-- MORPHEUS
import Data.Morpheus.Error.Client.Client (renderGQLErrors)
-import Data.Morpheus.Execution.Client.Aeson (deriveFromJSON)
+import Data.Morpheus.Execution.Client.Aeson (deriveFromJSON, deriveToJSON)
import Data.Morpheus.Execution.Client.Compile (validateWith)
import Data.Morpheus.Execution.Client.Fetch (deriveFetch)
import Data.Morpheus.Execution.Internal.Declare (declareType)
-import Data.Morpheus.Types.Internal.Data (DataTypeLib)
-import Data.Morpheus.Types.Internal.DataD (QueryD (..), TypeD (..))
+import Data.Morpheus.Types.Internal.Data (DataTypeKind (..), DataTypeLib, isOutputObject)
+import Data.Morpheus.Types.Internal.DataD (GQLTypeD (..), QueryD (..), TypeD (..))
import Data.Morpheus.Types.Internal.Validation (Validation)
import Data.Morpheus.Types.Types (GQLQueryRoot (..))
-queryArgumentType :: [TypeD] -> (Type, Q [Dec])
-queryArgumentType [] = (ConT $ mkName "()", pure [])
-queryArgumentType (rootType@TypeD {tName}:xs) = (ConT $ mkName tName, types)
- where
- types = pure $ map (declareType [''Show, ''ToJSON]) (rootType : xs)
-
-defineJSONType :: TypeD -> Q [Dec]
-defineJSONType datatype = do
- record <- declareLenses (pure [declareType [''Show] datatype])
- toJson <- pure <$> deriveFromJSON datatype
- pure $ record <> toJson
-
-defineOperationType :: (Type, Q [Dec]) -> String -> TypeD -> Q [Dec]
-defineOperationType (argType, argumentTypes) query datatype = do
- rootType <- defineJSONType datatype
- typeClassFetch <- deriveFetch argType (tName datatype) query
- args <- argumentTypes
- pure $ rootType <> typeClassFetch <> args
-
-defineQueryD :: QueryD -> Q [Dec]
-defineQueryD QueryD {queryTypes = rootType:subTypes, queryText, queryArgTypes} = do
- rootDecs <- defineOperationType (queryArgumentType queryArgTypes) queryText rootType
- subTypeDecs <- concat <$> mapM defineJSONType subTypes
- return $ rootDecs ++ subTypeDecs
-defineQueryD QueryD {queryTypes = []} = return []
-
defineQuery :: IO (Validation DataTypeLib) -> (GQLQueryRoot, String) -> Q [Dec]
defineQuery ioSchema queryRoot = do
schema <- runIO ioSchema
case schema >>= (`validateWith` queryRoot) of
Left errors -> fail (renderGQLErrors errors)
Right queryD -> defineQueryD queryD
+
+defineQueryD :: QueryD -> Q [Dec]
+defineQueryD QueryD {queryTypes = rootType:subTypes, queryText, queryArgsType} = do
+ rootDecs <- defineOperationType (queryArgumentType queryArgsType) queryText rootType
+ subTypeDecs <- concat <$> traverse declareT subTypes
+ return $ rootDecs ++ subTypeDecs
+ where
+ declareT GQLTypeD {typeD, typeKindD}
+ | isOutputObject typeKindD || typeKindD == KindUnion = withToJSON declareOutputType typeD
+ | typeKindD == KindEnum = withToJSON declareInputType typeD
+ | otherwise = declareInputType typeD
+defineQueryD QueryD {queryTypes = []} = return []
+
+declareOutputType :: TypeD -> Q [Dec]
+declareOutputType typeD = pure [declareType False Nothing [''Show] typeD]
+
+declareInputType :: TypeD -> Q [Dec]
+declareInputType typeD = do
+ toJSONDec <- deriveToJSON typeD
+ pure $ declareType True Nothing [''Show] typeD : toJSONDec
+
+withToJSON :: (TypeD -> Q [Dec]) -> TypeD -> Q [Dec]
+withToJSON f datatype = do
+ toJson <- deriveFromJSON datatype
+ dec <- f datatype
+ pure (toJson : dec)
+
+queryArgumentType :: Maybe TypeD -> (Type, Q [Dec])
+queryArgumentType Nothing = (ConT $ mkName "()", pure [])
+queryArgumentType (Just rootType@TypeD {tName}) = (ConT $ mkName tName, declareInputType rootType)
+
+defineOperationType :: (Type, Q [Dec]) -> String -> GQLTypeD -> Q [Dec]
+defineOperationType (argType, argumentTypes) query GQLTypeD {typeD} = do
+ rootType <- withToJSON declareOutputType typeD
+ typeClassFetch <- deriveFetch argType (tName typeD) query
+ argsT <- argumentTypes
+ pure $ rootType <> typeClassFetch <> argsT
diff --git a/src/Data/Morpheus/Execution/Client/Compile.hs b/src/Data/Morpheus/Execution/Client/Compile.hs
index 5c1a2c9..8488299 100644
--- a/src/Data/Morpheus/Execution/Client/Compile.hs
+++ b/src/Data/Morpheus/Execution/Client/Compile.hs
@@ -37,5 +37,5 @@ compileSyntax queryText =
validateWith :: DataTypeLib -> (GQLQueryRoot, String) -> Validation QueryD
validateWith schema (rawRequest@GQLQueryRoot {operation}, queryText) = do
validOperation <- validateRequest schema WITHOUT_VARIABLES rawRequest
- (queryArgTypes, queryTypes) <- operationTypes schema (O.operationArgs operation) validOperation
- return QueryD {queryText, queryTypes, queryArgTypes}
+ (queryArgsType, queryTypes) <- operationTypes schema (O.operationArgs operation) validOperation
+ return QueryD {queryText, queryTypes, queryArgsType}
diff --git a/src/Data/Morpheus/Execution/Client/Selection.hs b/src/Data/Morpheus/Execution/Client/Selection.hs
index 184a41e..e683f41 100644
--- a/src/Data/Morpheus/Execution/Client/Selection.hs
+++ b/src/Data/Morpheus/Execution/Client/Selection.hs
@@ -8,133 +8,207 @@ module Data.Morpheus.Execution.Client.Selection
( operationTypes
) where
-import Data.Semigroup ((<>))
-import Data.Text (Text, unpack)
+import Data.Semigroup ((<>))
+import Data.Text (Text, pack, unpack)
--
-- MORPHEUS
-import Data.Morpheus.Error.Utils (globalErrorMessage)
-import Data.Morpheus.Types.Internal.AST.Operation (Operation (..), ValidOperation, Variable (..),
- VariableDefinitions)
-import Data.Morpheus.Types.Internal.AST.Selection (Selection (..), SelectionRec (..))
-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataLeaf (..),
- DataTyCon (..), DataTypeLib (..), TypeAlias (..),
- allDataTypes)
-import Data.Morpheus.Types.Internal.DataD (ConsD (..), TypeD (..))
-import Data.Morpheus.Types.Internal.Validation (GQLErrors, Validation)
-import Data.Morpheus.Validation.Internal.Utils (lookupType)
+import Data.Morpheus.Error.Utils (globalErrorMessage)
+import Data.Morpheus.Execution.Internal.GraphScanner (LibUpdater, resolveUpdates)
+import Data.Morpheus.Execution.Internal.Utils (nameSpaceType)
+import Data.Morpheus.Types.Internal.AST.Operation (DefaultValue, Operation (..), ValidOperation,
+ Variable (..), VariableDefinitions)
+import Data.Morpheus.Types.Internal.AST.Selection (Selection (..), SelectionRec (..), SelectionSet)
+import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataLeaf (..),
+ DataTyCon (..), DataTypeKind (..), DataTypeLib (..),
+ Key, TypeAlias (..), allDataTypes)
+import Data.Morpheus.Types.Internal.DataD (ConsD (..), GQLTypeD (..), TypeD (..))
+import Data.Morpheus.Types.Internal.Validation (GQLErrors, Validation)
+import Data.Morpheus.Validation.Internal.Utils (lookupType)
+import Data.Set (fromList, toList)
+
+removeDuplicates :: [Text] -> [Text]
+removeDuplicates = toList . fromList
compileError :: Text -> GQLErrors
compileError x = globalErrorMessage $ "Unhandled Compile Time Error: \"" <> x <> "\" ;"
-operationTypes :: DataTypeLib -> VariableDefinitions -> ValidOperation -> Validation ([TypeD], [TypeD])
+operationTypes :: DataTypeLib -> VariableDefinitions -> ValidOperation -> Validation (Maybe TypeD, [GQLTypeD])
operationTypes lib variables = genOperation
where
- queryDataType = OutputObject $ snd $ query lib
- -----------------------------------------------------
- typeByField :: Text -> DataFullType -> Validation DataFullType
- typeByField key datatype = fst <$> lookupFieldType datatype key
- ------------------------------------------------------
- lookupFieldType :: DataFullType -> Text -> Validation (DataFullType, TypeAlias)
- lookupFieldType (OutputObject DataTyCon {typeData}) key =
- case lookup key typeData of
- Just DataField {fieldType = alias@TypeAlias {aliasTyCon}} -> trans <$> getType lib aliasTyCon
- where trans x = (x, alias {aliasTyCon = typeFrom x, aliasArgs = Nothing})
- Nothing -> Left (compileError key)
- lookupFieldType _ key = Left (compileError key)
- -----------------------------------------------------
genOperation Operation {operationName, operationSelection} = do
- argTypes <- rootArguments (operationName <> "Args")
- queryTypes <- genRecordType operationName queryDataType operationSelection
- pure (argTypes, queryTypes)
- -------------------------------------------{--}
- genInputType :: Text -> Validation [TypeD]
- genInputType name = getType lib name >>= subTypes
+ (queryTypes, enums) <- genRecordType [] operationName queryDataType operationSelection
+ inputTypeRequests <- resolveUpdates [] $ map (scanInputTypes lib . variableType . snd) variables
+ inputTypesAndEnums <- buildListedTypes (inputTypeRequests <> enums)
+ pure (rootArguments (operationName <> "Args"), queryTypes <> inputTypesAndEnums)
where
- subTypes (InputObject DataTyCon {typeName, typeData}) = do
- types <- concat <$> mapM toInputTypeD typeData
- fields <- traverse toFieldD typeData
- pure $ typeD fields : types
- where
- typeD fields = TypeD {tName = unpack typeName, tCons = [ConsD {cName = unpack typeName, cFields = fields}]}
- ---------------------------------------------------------------
- toInputTypeD :: (Text, DataField) -> Validation [TypeD]
- toInputTypeD (_, DataField {fieldType}) = genInputType $ aliasTyCon fieldType
- ----------------------------------------------------------------
- toFieldD :: (Text, DataField) -> Validation DataField
- toFieldD (_, field@DataField {fieldType}) = do
- aliasTyCon <- typeFrom <$> getType lib (aliasTyCon fieldType)
- pure $ field {fieldType = fieldType {aliasTyCon}}
- subTypes (Leaf x) = buildLeaf x
- subTypes _ = pure []
- -------------------------------------------
- rootArguments :: Text -> Validation [TypeD]
- rootArguments name = do
- types <- concat <$> mapM (genInputType . variableType . snd) variables
- pure $ typeD : types
+ queryDataType = OutputObject $ snd $ query lib
+ -------------------------------------------------------------------------
+ buildListedTypes = fmap concat . traverse (buildInputType lib) . removeDuplicates
+ -------------------------------------------------------------------------
+ -- generates argument types for Operation Head
+ rootArguments :: Text -> Maybe TypeD
+ rootArguments argsName
+ | null variables = Nothing
+ | otherwise = Just rootArgumentsType
+ ------------------------------------------
where
- typeD :: TypeD
- typeD = TypeD {tName = unpack name, tCons = [ConsD {cName = unpack name, cFields = map fieldD variables}]}
- ---------------------------------------
- fieldD :: (Text, Variable ()) -> DataField
- fieldD (key, Variable {variableType, variableTypeWrappers}) =
- DataField
- { fieldName = key
- , fieldArgs = []
- , fieldArgsType = Nothing
- , fieldType =
- TypeAlias {aliasWrappers = variableTypeWrappers, aliasTyCon = variableType, aliasArgs = Nothing}
- , fieldHidden = False
+ rootArgumentsType :: TypeD
+ rootArgumentsType =
+ TypeD
+ { tName = unpack argsName
+ , tNamespace = []
+ , tCons = [ConsD {cName = unpack argsName, cFields = map fieldD variables}]
}
- -------------------------------------------
- getCon name dataType selectionSet = do
- cFields <- genFields dataType selectionSet
- subTypes <- newFieldTypes dataType selectionSet
- pure (ConsD {cName = unpack name, cFields}, subTypes)
- ---------------------------------------------------------------------------------------------
- where
- genFields datatype = mapM typeNameFromField
where
- typeNameFromField :: (Text, Selection) -> Validation DataField
- typeNameFromField (fieldName, Selection {selectionRec = SelectionAlias {aliasFieldName}}) = do
- fieldType <- snd <$> lookupFieldType datatype aliasFieldName
- pure $ DataField {fieldName, fieldArgs = [], fieldArgsType = Nothing, fieldType, fieldHidden = False}
- typeNameFromField (fieldName, _) = do
- fieldType <- snd <$> lookupFieldType datatype fieldName
- pure $ DataField {fieldName, fieldArgs = [], fieldArgsType = Nothing, fieldType, fieldHidden = False}
- --------------------------------------------
- genRecordType name dataType selectionSet = do
- (con, subTypes) <- getCon name dataType selectionSet
- pure $ TypeD {tName = unpack name, tCons = [con]} : subTypes
- ------------------------------------------------------------------------------------------------------------
- newFieldTypes parentType = fmap concat <$> mapM validateSelection
+ fieldD :: (Text, Variable DefaultValue) -> DataField
+ fieldD (key, Variable {variableType, variableTypeWrappers}) =
+ DataField
+ { fieldName = key
+ , fieldArgs = []
+ , fieldArgsType = Nothing
+ , fieldType =
+ TypeAlias {aliasWrappers = variableTypeWrappers, aliasTyCon = variableType, aliasArgs = Nothing}
+ , fieldHidden = False
+ }
+ ---------------------------------------------------------
+ -- generates selection Object Types
+ genRecordType :: [Key] -> Key -> DataFullType -> SelectionSet -> Validation ([GQLTypeD], [Text])
+ genRecordType path name dataType recordSelSet = do
+ (con, subTypes, requests) <- genConsD (unpack name) dataType recordSelSet
+ pure
+ ( GQLTypeD
+ { typeD = TypeD {tName, tNamespace = map unpack path, tCons = [con]}
+ , typeKindD = KindObject Nothing
+ , typeArgD = []
+ } :
+ subTypes
+ , requests)
where
- validateSelection :: (Text, Selection) -> Validation [TypeD]
- validateSelection (key, Selection {selectionRec = SelectionField}) =
- key `typeByField` parentType >>= buildSelField
- where
- buildSelField (Leaf x) = buildLeaf x
- buildSelField _ = Left $ compileError "Invalid schema Expected scalar"
- validateSelection (key, Selection {selectionRec = SelectionSet selectionSet}) = do
- datatype <- key `typeByField` parentType
- genRecordType (typeFrom datatype) datatype selectionSet
- validateSelection (_, selection@Selection {selectionRec = SelectionAlias {aliasFieldName, aliasSelection}}) =
- validateSelection (aliasFieldName, selection {selectionRec = aliasSelection})
- validateSelection (key, Selection {selectionRec = UnionSelection unionSelections}) = do
- unionTypeName <- typeFrom <$> key `typeByField` parentType
- (tCons, subTypes) <- unzip <$> mapM getUnionType unionSelections
- pure $ TypeD {tName = unpack unionTypeName, tCons} : concat subTypes
+ tName = unpack name
+ genConsD :: String -> DataFullType -> SelectionSet -> Validation (ConsD, [GQLTypeD], [Text])
+ genConsD cName datatype selSet = do
+ cFields <- traverse genField selSet
+ (subTypes, requests) <- newFieldTypes datatype selSet
+ pure (ConsD {cName, cFields}, concat subTypes, concat requests)
+ ---------------------------------------------------------------------------------------------
where
- getUnionType (typeKey, selSet) = do
- conDatatype <- getType lib typeKey
- getCon typeKey conDatatype selSet
+ genField :: (Text, Selection) -> Validation DataField
+ genField (fieldName, sel) = genFieldD sel
+ where
+ fieldPath = path <> [fieldName]
+ -------------------------------
+ genFieldD Selection {selectionRec = SelectionAlias {aliasFieldName}} = do
+ fieldType <- snd <$> lookupFieldType lib fieldPath datatype aliasFieldName
+ pure $ DataField {fieldName, fieldArgs = [], fieldArgsType = Nothing, fieldType, fieldHidden = False}
+ genFieldD _ = do
+ fieldType <- snd <$> lookupFieldType lib fieldPath datatype fieldName
+ pure $ DataField {fieldName, fieldArgs = [], fieldArgsType = Nothing, fieldType, fieldHidden = False}
+ ------------------------------------------------------------------------------------------------------------
+ newFieldTypes :: DataFullType -> SelectionSet -> Validation ([[GQLTypeD]], [[Text]])
+ newFieldTypes parentType seSet = unzip <$> mapM valSelection seSet
+ where
+ valSelection selection@(selKey, _) = do
+ let (key, sel) = getSelectionFieldKey selection
+ fieldDatatype <- fst <$> lookupFieldType lib fieldPath parentType key
+ validateSelection fieldDatatype sel
+ --------------------------------------------------------------------
+ where
+ fieldPath = path <> [selKey]
+ --------------------------------------------------------------------
+ validateSelection :: DataFullType -> Selection -> Validation ([GQLTypeD], [Text])
+ validateSelection dType Selection {selectionRec = SelectionField} = do
+ lName <- withLeaf (pure . leafName) dType
+ pure ([], lName)
+ --withLeaf buildLeaf dType
+ validateSelection dType Selection {selectionRec = SelectionSet selectionSet} =
+ genRecordType fieldPath (typeFrom [] dType) dType selectionSet
+ validateSelection dType aliasSel@Selection {selectionRec = SelectionAlias {aliasSelection}} =
+ validateSelection dType aliasSel {selectionRec = aliasSelection}
+ ---- UNION
+ validateSelection dType Selection {selectionRec = UnionSelection unionSelections} = do
+ (tCons, subTypes, requests) <- unzip3 <$> mapM getUnionType unionSelections
+ pure
+ ( GQLTypeD
+ { typeD =
+ TypeD {tNamespace = map unpack fieldPath, tName = unpack $ typeFrom [] dType, tCons}
+ , typeKindD = KindUnion
+ , typeArgD = []
+ } :
+ concat subTypes
+ , concat requests)
+ where
+ getUnionType (selectedTyName, selectionVariant) = do
+ conDatatype <- getType lib selectedTyName
+ genConsD (unpack selectedTyName) conDatatype selectionVariant
-buildLeaf :: DataLeaf -> Validation [TypeD]
-buildLeaf (LeafEnum DataTyCon {typeName, typeData}) =
- pure [TypeD {tName = unpack typeName, tCons = map enumOption typeData}]
+scanInputTypes :: DataTypeLib -> Key -> LibUpdater [Key]
+scanInputTypes lib name collected
+ | name `elem` collected = pure collected
+ | otherwise = getType lib name >>= scanType
where
- enumOption name = ConsD {cName = unpack name, cFields = []}
-buildLeaf _ = pure []
+ scanType (InputObject DataTyCon {typeData}) = resolveUpdates (name : collected) (map toInputTypeD typeData)
+ where
+ toInputTypeD :: (Text, DataField) -> LibUpdater [Key]
+ toInputTypeD (_, DataField {fieldType = TypeAlias {aliasTyCon}}) = scanInputTypes lib aliasTyCon
+ scanType (Leaf leaf) = pure (collected <> leafName leaf)
+ scanType _ = pure collected
+
+buildInputType :: DataTypeLib -> Text -> Validation [GQLTypeD]
+buildInputType lib name = getType lib name >>= subTypes
+ where
+ subTypes (InputObject DataTyCon {typeName, typeData}) = do
+ fields <- traverse toFieldD typeData
+ pure
+ [ GQLTypeD
+ { typeD =
+ TypeD
+ { tName = unpack typeName
+ , tNamespace = []
+ , tCons = [ConsD {cName = unpack typeName, cFields = fields}]
+ }
+ , typeArgD = []
+ , typeKindD = KindInputObject
+ }
+ ]
+ ----------------------------------------------------------------
+ where
+ toFieldD :: (Text, DataField) -> Validation DataField
+ toFieldD (_, field@DataField {fieldType}) = do
+ aliasTyCon <- typeFrom [] <$> getType lib (aliasTyCon fieldType)
+ pure $ field {fieldType = fieldType {aliasTyCon}}
+ subTypes (Leaf (LeafEnum DataTyCon {typeName, typeData})) =
+ pure
+ [ GQLTypeD
+ { typeD = TypeD {tName = unpack typeName, tNamespace = [], tCons = map enumOption typeData}
+ , typeArgD = []
+ , typeKindD = KindEnum
+ }
+ ]
+ where
+ enumOption eName = ConsD {cName = unpack eName, cFields = []}
+ subTypes _ = pure []
+
+lookupFieldType :: DataTypeLib -> [Key] -> DataFullType -> Text -> Validation (DataFullType, TypeAlias)
+lookupFieldType lib path (OutputObject DataTyCon {typeData}) key =
+ case lookup key typeData of
+ Just DataField {fieldType = alias@TypeAlias {aliasTyCon}} -> trans <$> getType lib aliasTyCon
+ where trans x = (x, alias {aliasTyCon = typeFrom path x, aliasArgs = Nothing})
+ Nothing -> Left (compileError key)
+lookupFieldType _ _ _ key = Left (compileError key)
+
+getSelectionFieldKey :: (Key, Selection) -> (Key, Selection)
+getSelectionFieldKey (_, selection@Selection {selectionRec = SelectionAlias {aliasFieldName, aliasSelection}}) =
+ (aliasFieldName, selection {selectionRec = aliasSelection})
+getSelectionFieldKey sel = sel
+
+withLeaf :: (DataLeaf -> Validation b) -> DataFullType -> Validation b
+withLeaf f (Leaf x) = f x
+withLeaf _ _ = Left $ compileError "Invalid schema Expected scalar"
+
+leafName :: DataLeaf -> [Text]
+leafName (LeafEnum DataTyCon {typeName}) = [typeName]
+leafName _ = []
getType :: DataTypeLib -> Text -> Validation DataFullType
getType lib typename = lookupType (compileError typename) (allDataTypes lib) typename
@@ -147,13 +221,13 @@ isPrimitive "String" = True
isPrimitive "ID" = True
isPrimitive _ = False
-typeFrom :: DataFullType -> Text
-typeFrom (Leaf (BaseScalar x)) = typeName x
-typeFrom (Leaf (CustomScalar DataTyCon {typeName}))
+typeFrom :: [Key] -> DataFullType -> Text
+typeFrom _ (Leaf (BaseScalar x)) = typeName x
+typeFrom _ (Leaf (CustomScalar DataTyCon {typeName}))
| isPrimitive typeName = typeName
| otherwise = "ScalarValue"
-typeFrom (Leaf (LeafEnum x)) = typeName x
-typeFrom (InputObject x) = typeName x
-typeFrom (OutputObject x) = typeName x
-typeFrom (Union x) = typeName x
-typeFrom (InputUnion x) = typeName x
+typeFrom _ (Leaf (LeafEnum x)) = typeName x
+typeFrom _ (InputObject x) = typeName x
+typeFrom path (OutputObject x) = pack $ nameSpaceType path $ typeName x
+typeFrom path (Union x) = pack $ nameSpaceType path $ typeName x
+typeFrom _ (InputUnion x) = typeName x
diff --git a/src/Data/Morpheus/Execution/Document/Convert.hs b/src/Data/Morpheus/Execution/Document/Convert.hs
index dc9ff40..3bd2b9d 100644
--- a/src/Data/Morpheus/Execution/Document/Convert.hs
+++ b/src/Data/Morpheus/Execution/Document/Convert.hs
@@ -5,7 +5,7 @@
{-# LANGUAGE TypeOperators #-}
module Data.Morpheus.Execution.Document.Convert
- ( renderTHTypes , sysTypes
+ ( renderTHTypes
) where
import Data.Semigroup ((<>))
@@ -18,14 +18,10 @@ import Data.Morpheus.Execution.Internal.Utils (capital)
import Data.Morpheus.Types.Internal.Data (ArgsType (..), DataField (..), DataField, DataFullType (..),
DataLeaf (..), DataTyCon (..), DataTypeKind (..),
DataTypeKind (..), OperationKind (..), ResolverKind (..),
- TypeAlias (..))
+ TypeAlias (..), sysTypes)
import Data.Morpheus.Types.Internal.DataD (ConsD (..), GQLTypeD (..), TypeD (..))
import Data.Morpheus.Types.Internal.Validation (Validation)
-sysTypes :: [Text]
-sysTypes =
- ["__Schema", "__Type", "__Directive", "__TypeKind", "__Field", "__DirectiveLocation", "__InputValue", "__EnumValue"]
-
renderTHTypes :: Bool -> [(Text, DataFullType)] -> Validation [GQLTypeD]
renderTHTypes namespace lib = traverse renderTHType lib
where
@@ -40,7 +36,13 @@ renderTHTypes namespace lib = traverse renderTHType lib
genArgumentType :: (Text, DataField) -> Validation [TypeD]
genArgumentType (_, DataField {fieldArgs = []}) = pure []
genArgumentType (fieldName, DataField {fieldArgs}) =
- pure [TypeD {tName, tCons = [ConsD {cName = sysName $ pack tName, cFields = map genField fieldArgs}]}]
+ pure
+ [ TypeD
+ { tName
+ , tNamespace = []
+ , tCons = [ConsD {cName = sysName $ pack tName, cFields = map genField fieldArgs}]
+ }
+ ]
where
tName = genArgsTypeName $ sysName fieldName
-------------------------------------------
@@ -87,7 +89,7 @@ renderTHTypes namespace lib = traverse renderTHType lib
genType (Leaf (LeafEnum DataTyCon {typeName, typeData})) =
pure
GQLTypeD
- { typeD = TypeD {tName = sysName typeName, tCons = map enumOption typeData}
+ { typeD = TypeD {tName = sysName typeName, tNamespace = [], tCons = map enumOption typeData}
, typeKindD = KindEnum
, typeArgD = []
}
@@ -101,6 +103,7 @@ renderTHTypes namespace lib = traverse renderTHType lib
{ typeD =
TypeD
{ tName = sysName typeName
+ , tNamespace = []
, tCons = [ConsD {cName = sysName typeName, cFields = map genField typeData}]
}
, typeKindD = KindInputObject
@@ -113,6 +116,7 @@ renderTHTypes namespace lib = traverse renderTHType lib
{ typeD =
TypeD
{ tName = sysName typeName
+ , tNamespace = []
, tCons = [ConsD {cName = sysName typeName, cFields = map genResField typeData}]
}
, typeKindD =
@@ -123,7 +127,9 @@ renderTHTypes namespace lib = traverse renderTHType lib
}
genType (Union DataTyCon {typeName, typeData}) = do
let tCons = map unionCon typeData
- pure GQLTypeD {typeD = TypeD {tName = unpack typeName, tCons}, typeKindD = KindUnion, typeArgD = []}
+ pure
+ GQLTypeD
+ {typeD = TypeD {tName = unpack typeName, tNamespace = [], tCons}, typeKindD = KindUnion, typeArgD = []}
where
unionCon field@DataField {fieldType} =
ConsD
diff --git a/src/Data/Morpheus/Execution/Document/Declare.hs b/src/Data/Morpheus/Execution/Document/Declare.hs
index a110f10..c883240 100644
--- a/src/Data/Morpheus/Execution/Document/Declare.hs
+++ b/src/Data/Morpheus/Execution/Document/Declare.hs
@@ -15,7 +15,7 @@ import Data.Morpheus.Execution.Document.Decode (deriveDecode)
import Data.Morpheus.Execution.Document.Encode (deriveEncode)
import Data.Morpheus.Execution.Document.GQLType (deriveGQLType)
import Data.Morpheus.Execution.Document.Introspect (deriveObjectRep)
-import Data.Morpheus.Execution.Internal.Declare (declareGQLT)
+import Data.Morpheus.Execution.Internal.Declare (declareType)
import Data.Morpheus.Types.Internal.Data (isInput, isObject)
import Data.Morpheus.Types.Internal.DataD (GQLTypeD (..))
@@ -44,11 +44,11 @@ declareGQLType namespace gqlType@GQLTypeD {typeD, typeKindD, typeArgD} = do
where
deriveArgsRep args = deriveObjectRep (args, Nothing)
----------------------------------------------------
- argsTypeDecs = map (declareGQLT namespace Nothing []) typeArgD
+ argsTypeDecs = map (declareType namespace Nothing []) typeArgD
--------------------------------------------------
declareMainType = declareT
where
- declareT = pure [declareGQLT namespace (Just typeKindD) derivingClasses typeD]
+ declareT = pure [declareType namespace (Just typeKindD) derivingClasses typeD]
derivingClasses
| isInput typeKindD = [''Show]
| otherwise = []
diff --git a/src/Data/Morpheus/Execution/Document/Encode.hs b/src/Data/Morpheus/Execution/Document/Encode.hs
index 2bb9e2b..0878366 100644
--- a/src/Data/Morpheus/Execution/Document/Encode.hs
+++ b/src/Data/Morpheus/Execution/Document/Encode.hs
@@ -17,7 +17,7 @@ import Data.Morpheus.Execution.Server.Encode (Encode (..), ObjectRes
import Data.Morpheus.Types.GQLType (TRUE)
import Data.Morpheus.Types.Internal.Data (DataField (..), isSubscription)
import Data.Morpheus.Types.Internal.DataD (ConsD (..), GQLTypeD (..), TypeD (..))
-import Data.Morpheus.Types.Internal.TH (applyT, instanceHeadMultiT, typeT)
+import Data.Morpheus.Types.Internal.TH (applyT, destructRecord, instanceHeadMultiT, typeT)
import Data.Morpheus.Types.Internal.Validation (ResolveT)
import Data.Morpheus.Types.Internal.Value (Value)
import Data.Morpheus.Types.Resolver
@@ -57,7 +57,7 @@ deriveEncode GQLTypeD {typeKindD, typeD = TypeD {tName, tCons = [ConsD {cFields}
-- defines: objectResolvers <Type field1 field2 ...> = [("field1",encode field1),("field2",encode field2), ...]
methods = [funD 'objectResolvers [clause argsE (normalB body) []]]
where
- argsE = [varP (mkName "_"), conP (mkName tName) (map (varP . mkName) varNames)]
+ argsE = [varP (mkName "_"), destructRecord tName varNames]
body = listE $ map decodeVar varNames
decodeVar name = [|(name, encode $(varName))|]
where
diff --git a/src/Data/Morpheus/Execution/Document/GQLType.hs b/src/Data/Morpheus/Execution/Document/GQLType.hs
index dba5f10..155f63c 100644
--- a/src/Data/Morpheus/Execution/Document/GQLType.hs
+++ b/src/Data/Morpheus/Execution/Document/GQLType.hs
@@ -11,22 +11,20 @@ module Data.Morpheus.Execution.Document.GQLType
import Data.Text (pack)
import Language.Haskell.TH
-import Data.Morpheus.Execution.Document.Convert (sysTypes)
-
--
-- MORPHEUS
import Data.Morpheus.Execution.Internal.Declare (tyConArgs)
import Data.Morpheus.Kind (ENUM, INPUT_OBJECT, INPUT_UNION, OBJECT, SCALAR, UNION,
WRAPPER)
import Data.Morpheus.Types.GQLType (GQLType (..), TRUE)
-import Data.Morpheus.Types.Internal.Data (DataTypeKind (..), isObject)
+import Data.Morpheus.Types.Internal.Data (DataTypeKind (..), isObject, isSchemaTypeName)
import Data.Morpheus.Types.Internal.DataD (GQLTypeD (..), TypeD (..))
import Data.Morpheus.Types.Internal.TH (instanceHeadT, typeT)
import Data.Typeable (Typeable)
genTypeName :: String -> String
genTypeName ('S':name)
- | pack name `elem` sysTypes = name
+ | isSchemaTypeName (pack name) = name
genTypeName name = name
deriveGQLType :: GQLTypeD -> Q [Dec]
@@ -34,12 +32,12 @@ deriveGQLType GQLTypeD {typeD = TypeD {tName}, typeKindD} =
pure <$> instanceD (cxt constrains) iHead (def__typeName : typeFamilies)
where
def__typeName = funD '__typeName [clause argsE (normalB body) []]
- -- defines method: __typeName _ = tName
where
- argsE = map (varP . mkName) ["_"]
body = [|pack name|]
where
name = genTypeName tName
+ -- defines method: __typeName _ = tName
+ argsE = map (varP . mkName) ["_"]
typeArgs = tyConArgs typeKindD
----------------------------------------------
iHead = instanceHeadT ''GQLType tName typeArgs
diff --git a/src/Data/Morpheus/Execution/Internal/Declare.hs b/src/Data/Morpheus/Execution/Internal/Declare.hs
index f0fbd25..909f69c 100644
--- a/src/Data/Morpheus/Execution/Internal/Declare.hs
+++ b/src/Data/Morpheus/Execution/Internal/Declare.hs
@@ -9,17 +9,16 @@
module Data.Morpheus.Execution.Internal.Declare
( declareType
- , declareGQLT
, tyConArgs
) where
import Data.Maybe (maybe)
-import Data.Text (unpack)
+import Data.Text (pack, unpack)
import GHC.Generics (Generic)
import Language.Haskell.TH
-- MORPHEUS
-import Data.Morpheus.Execution.Internal.Utils (nameSpaceWith)
+import Data.Morpheus.Execution.Internal.Utils (nameSpaceType, nameSpaceWith)
import Data.Morpheus.Types.Internal.Data (ArgsType (..), DataField (..), DataTypeKind (..),
DataTypeKind (..), TypeAlias (..), WrapperD (..),
isOutputObject, isSubscription)
@@ -28,9 +27,6 @@ import Data.Morpheus.Types.Resolver (UnSubResolver)
type FUNC = (->)
-declareType :: [Name] -> TypeD -> Dec
-declareType = declareGQLT False Nothing
-
declareTypeAlias :: Bool -> TypeAlias -> Type
declareTypeAlias isSub TypeAlias {aliasTyCon, aliasWrappers, aliasArgs} = wrappedT aliasWrappers
where
@@ -52,16 +48,17 @@ tyConArgs kindD
| otherwise = []
-- declareType
-declareGQLT :: Bool -> Maybe DataTypeKind -> [Name] -> TypeD -> Dec
-declareGQLT namespace kindD derivingList TypeD {tName, tCons} =
- DataD [] (mkName tName) tVars Nothing (map cons tCons) $ map derive (''Generic : derivingList)
+declareType :: Bool -> Maybe DataTypeKind -> [Name] -> TypeD -> Dec
+declareType namespace kindD derivingList TypeD {tName, tCons, tNamespace} =
+ DataD [] (genName tName) tVars Nothing (map cons tCons) $ map derive (''Generic : derivingList)
where
+ genName = mkName . nameSpaceType (map pack tNamespace) . pack
tVars = maybe [] (declareTyVar . tyConArgs) kindD
where
declareTyVar = map (PlainTV . mkName)
defBang = Bang NoSourceUnpackedness NoSourceStrictness
derive className = DerivClause Nothing [ConT className]
- cons ConsD {cName, cFields} = RecC (mkName cName) (map declareField cFields)
+ cons ConsD {cName, cFields} = RecC (genName cName) (map declareField cFields)
where
declareField DataField {fieldName, fieldArgsType, fieldType} = (fName, defBang, fiType)
where
diff --git a/src/Data/Morpheus/Execution/Internal/GraphScanner.hs b/src/Data/Morpheus/Execution/Internal/GraphScanner.hs
new file mode 100644
index 0000000..eb2a499
--- /dev/null
+++ b/src/Data/Morpheus/Execution/Internal/GraphScanner.hs
@@ -0,0 +1,14 @@
+module Data.Morpheus.Execution.Internal.GraphScanner
+ ( LibUpdater
+ , resolveUpdates
+ ) where
+
+import Control.Monad (foldM)
+import Data.Function ((&))
+import Data.Morpheus.Types.Internal.Validation (Validation)
+
+type LibUpdater lib = lib -> Validation lib
+
+-- Helper Functions
+resolveUpdates :: lib -> [LibUpdater lib] -> Validation lib
+resolveUpdates = foldM (&)
diff --git a/src/Data/Morpheus/Execution/Internal/Utils.hs b/src/Data/Morpheus/Execution/Internal/Utils.hs
index d25d39d..5e135fe 100644
--- a/src/Data/Morpheus/Execution/Internal/Utils.hs
+++ b/src/Data/Morpheus/Execution/Internal/Utils.hs
@@ -2,10 +2,20 @@ module Data.Morpheus.Execution.Internal.Utils
( capital
, nonCapital
, nameSpaceWith
+ , nameSpaceType
+ , nameSpaceTypeString
) where
import Data.Char (toLower, toUpper)
import Data.Semigroup ((<>))
+import Data.Text (Text, unpack)
+
+
+nameSpaceTypeString :: [String] -> String -> String
+nameSpaceTypeString list name = concatMap capital (list <> [name])
+
+nameSpaceType :: [Text] -> Text -> String
+nameSpaceType list name = concatMap (capital . unpack) (list <> [name])
nameSpaceWith :: String -> String -> String
nameSpaceWith nSpace name = nonCapital nSpace <> capital name
diff --git a/src/Data/Morpheus/Execution/Server/Introspect.hs b/src/Data/Morpheus/Execution/Server/Introspect.hs
index fdfeed3..c6bd908 100644
--- a/src/Data/Morpheus/Execution/Server/Introspect.hs
+++ b/src/Data/Morpheus/Execution/Server/Introspect.hs
@@ -19,13 +19,10 @@ module Data.Morpheus.Execution.Server.Introspect
, Introspect(..)
, ObjectFields(..)
, IntroCon
- , resolveTypes
, updateLib
, buildType
) where
-import Control.Monad (foldM)
-import Data.Function ((&))
import Data.Map (Map)
import Data.Proxy (Proxy (..))
import Data.Semigroup ((<>))
@@ -35,6 +32,7 @@ import GHC.Generics
-- MORPHEUS
import Data.Morpheus.Error.Schema (nameCollisionError)
+import Data.Morpheus.Execution.Internal.GraphScanner (LibUpdater, resolveUpdates)
import Data.Morpheus.Execution.Server.Generics.EnumRep (EnumRep (..))
import Data.Morpheus.Kind (Context (..), ENUM, GQL_KIND, INPUT_OBJECT,
INPUT_UNION, OBJECT, SCALAR, UNION)
@@ -45,7 +43,6 @@ import Data.Morpheus.Types.Internal.Data (DataArguments,
DataLeaf (..), DataTyCon (..), DataTypeLib,
TypeAlias (..), defineType, isTypeDefined,
toListField, toNullableField)
-import Data.Morpheus.Types.Internal.Validation (SchemaValidation)
type IntroCon a = (GQLType a, ObjectFields (CUSTOM a) a)
@@ -89,7 +86,7 @@ instance Introspect (MapKind k v Maybe) => Introspect (Map k v) where
-- Resolver : a -> Resolver b
instance (ObjectFields 'False a, Introspect b) => Introspect (a -> m b) where
field _ name = (field (Proxy @b) name) {fieldArgs = fst $ objectFields (Proxy :: Proxy 'False) (Proxy @a)}
- introspect _ typeLib = resolveTypes typeLib (introspect (Proxy @b) : argTypes)
+ introspect _ typeLib = resolveUpdates typeLib (introspect (Proxy @b) : argTypes)
where
argTypes :: [TypeUpdater]
argTypes = snd $ objectFields (Proxy :: Proxy 'False) (Proxy @a)
@@ -152,7 +149,6 @@ instance (GQL_TYPE a, GQLRep UNION (Rep a)) => IntrospectKind INPUT_UNION a wher
{ typeName
-- has same fingerprint as object because it depends on it
, typeFingerprint = __typeFingerprint (Proxy @a)
- , typeVisibility = __typeVisibility (Proxy @a)
, typeDescription = Nothing
, typeData = map fieldName inputUnions
}
@@ -167,7 +163,7 @@ instance (GQL_TYPE a, GQLRep UNION (Rep a)) => IntrospectKind INPUT_UNION a wher
}
-- Types
-type TypeUpdater = DataTypeLib -> SchemaValidation DataTypeLib
+type TypeUpdater = LibUpdater DataTypeLib
type GQL_TYPE a = (Generic a, GQLType a)
@@ -216,10 +212,6 @@ instance GQLRep OBJECT U1 where
buildAlias :: Text -> TypeAlias
buildAlias aliasTyCon = TypeAlias {aliasTyCon, aliasWrappers = [], aliasArgs = Nothing}
--- Helper Functions
-resolveTypes :: DataTypeLib -> [TypeUpdater] -> SchemaValidation DataTypeLib
-resolveTypes = foldM (&)
-
buildField :: GQLType a => Proxy a -> DataArguments -> Text -> DataField
buildField proxy fieldArgs fieldName =
DataField
@@ -231,14 +223,13 @@ buildType typeData proxy =
{ typeName = __typeName proxy
, typeFingerprint = __typeFingerprint proxy
, typeDescription = description proxy
- , typeVisibility = __typeVisibility proxy
, typeData
}
updateLib :: GQLType a => (Proxy a -> DataFullType) -> [TypeUpdater] -> Proxy a -> TypeUpdater
updateLib typeBuilder stack proxy lib' =
case isTypeDefined (__typeName proxy) lib' of
- Nothing -> resolveTypes (defineType (__typeName proxy, typeBuilder proxy) lib') stack
+ Nothing -> resolveUpdates (defineType (__typeName proxy, typeBuilder proxy) lib') stack
Just fingerprint'
| fingerprint' == __typeFingerprint proxy -> return lib'
-- throw error if 2 different types has same name
diff --git a/src/Data/Morpheus/Execution/Server/Resolve.hs b/src/Data/Morpheus/Execution/Server/Resolve.hs
index fb3bbb3..c0aca8d 100644
--- a/src/Data/Morpheus/Execution/Server/Resolve.hs
+++ b/src/Data/Morpheus/Execution/Server/Resolve.hs
@@ -26,9 +26,10 @@ import Data.Proxy (Proxy (..)
-- MORPHEUS
import Data.Morpheus.Error.Utils (badRequestError, renderErrors)
+import Data.Morpheus.Execution.Internal.GraphScanner (resolveUpdates)
import Data.Morpheus.Execution.Server.Encode (EncodeCon, EncodeMutCon, EncodeSubCon, OBJ_RES,
encodeOperation, encodeQuery)
-import Data.Morpheus.Execution.Server.Introspect (IntroCon, ObjectFields (..), resolveTypes)
+import Data.Morpheus.Execution.Server.Introspect (IntroCon, ObjectFields (..))
import Data.Morpheus.Execution.Subscription.ClientRegister (GQLState, publishUpdates)
import Data.Morpheus.Parsing.Request.Parser (parseGQL)
import Data.Morpheus.Schema.Schema (Root)
@@ -138,15 +139,16 @@ fullSchema ::
-> Validation DataTypeLib
fullSchema _ = querySchema >>= mutationSchema >>= subscriptionSchema
where
- querySchema = resolveTypes (initTypeLib (operatorType (hiddenRootFields ++ fields) "Query")) (defaultTypes : types)
+ querySchema =
+ resolveUpdates (initTypeLib (operatorType (hiddenRootFields ++ fields) "Query")) (defaultTypes : types)
where
(fields, types) = objectFields (Proxy @(CUSTOM query)) (Proxy @query)
------------------------------
- mutationSchema lib = resolveTypes (lib {mutation = maybeOperator fields "Mutation"}) types
+ mutationSchema lib = resolveUpdates (lib {mutation = maybeOperator fields "Mutation"}) types
where
(fields, types) = objectFields (Proxy @(CUSTOM mutation)) (Proxy @mutation)
------------------------------
- subscriptionSchema lib = resolveTypes (lib {subscription = maybeOperator fields "Subscription"}) types
+ subscriptionSchema lib = resolveUpdates (lib {subscription = maybeOperator fields "Subscription"}) types
where
(fields, types) = objectFields (Proxy @(CUSTOM subscription)) (Proxy @subscription)
-- maybeOperator :: [a] -> Text -> Maybe (Text, DataTyCon[a])
@@ -155,10 +157,4 @@ fullSchema _ = querySchema >>= mutationSchema >>= subscriptionSchema
-- operatorType :: [a] -> Text -> (Text, DataTyCon[a])
operatorType typeData typeName =
( typeName
- , DataTyCon
- { typeData
- , typeVisibility = True
- , typeName
- , typeFingerprint = SystemFingerprint typeName
- , typeDescription = Nothing
- })
+ , DataTyCon {typeData, typeName, typeFingerprint = SystemFingerprint typeName, typeDescription = Nothing})
diff --git a/src/Data/Morpheus/Parsing/Client/ParseMeta.hs b/src/Data/Morpheus/Parsing/Client/ParseMeta.hs
deleted file mode 100644
index 00fb60b..0000000
--- a/src/Data/Morpheus/Parsing/Client/ParseMeta.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE TypeFamilies #-}
-
-module Data.Morpheus.Parsing.Client.ParseMeta
- ( parseMeta
- ) where
-
-import Data.Morpheus.Parsing.Internal.Internal (Parser)
-import Data.Morpheus.Parsing.Internal.Terms (parseAssignment, token)
-import Data.Text (Text)
-import Text.Megaparsec (between, label)
-import Text.Megaparsec.Char (char, space)
-
-parseMeta :: Parser (Text, Text)
-parseMeta =
- label "MetaData" $ do
- space
- _ <- char '#'
- between
- (char '{' *> space)
- (char '}' *> space)
- (parseAssignment token token)
diff --git a/src/Data/Morpheus/Parsing/Client/Parser.hs b/src/Data/Morpheus/Parsing/Client/Parser.hs
deleted file mode 100644
index 752b719..0000000
--- a/src/Data/Morpheus/Parsing/Client/Parser.hs
+++ /dev/null
@@ -1,28 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE OverloadedStrings #-}
-
-module Data.Morpheus.Parsing.Client.Parser
- ( lookupGQLConfig
- ) where
-
-import Data.Text (Text)
-import Text.Megaparsec (label, runParser)
-import Text.Megaparsec.Char (space)
-
---
--- MORPHEUS
-import Data.Morpheus.Parsing.Client.ParseMeta (parseMeta)
-import Data.Morpheus.Parsing.Internal.Internal (Parser, processErrorBundle)
-import Data.Morpheus.Types.Internal.Validation (Validation)
-
-lookupGQLConfig :: Text -> Validation (Text, Text)
-lookupGQLConfig text =
- case runParser request "<input>" text of
- Left x -> Left $ processErrorBundle x
- Right x -> Right x
- where
- request :: Parser (Text, Text)
- request =
- label "GQLConfig" $ do
- space
- parseMeta
diff --git a/src/Data/Morpheus/Parsing/Document/DataType.hs b/src/Data/Morpheus/Parsing/Document/DataType.hs
index 9b55ae7..c3e4915 100644
--- a/src/Data/Morpheus/Parsing/Document/DataType.hs
+++ b/src/Data/Morpheus/Parsing/Document/DataType.hs
@@ -11,6 +11,7 @@ import Data.Morpheus.Parsing.Internal.Internal (Parser)
import Data.Morpheus.Parsing.Internal.Terms (parseAssignment, parseMaybeTuple, parseNonNull,
parseWrappedType, pipeLiteral, qualifier, setOf,
spaceAndComments, token)
+import Data.Morpheus.Parsing.Internal.Value (parseDefaultValue)
import Data.Morpheus.Types.Internal.Data (DataArgument, DataField, DataFullType (..), Key,
RawDataType (..), toHSWrappers)
import Data.Text (Text)
@@ -22,6 +23,8 @@ dataArgument =
label "Argument" $ do
((fieldName, _), (wrappers, fieldType)) <- parseAssignment qualifier parseWrappedType
nonNull <- parseNonNull
+ -- TODO: handle default value
+ defaultValue <- parseDefaultValue
pure $ createArgument fieldName (toHSWrappers $ nonNull ++ wrappers, fieldType)
typeDef :: Text -> Parser Text
diff --git a/src/Data/Morpheus/Parsing/Internal/Create.hs b/src/Data/Morpheus/Parsing/Internal/Create.hs
index 27266a8..28cf84b 100644
--- a/src/Data/Morpheus/Parsing/Internal/Create.hs
+++ b/src/Data/Morpheus/Parsing/Internal/Create.hs
@@ -32,8 +32,7 @@ createArgument fieldName x = (fieldName, createField [] fieldName x)
createType :: Text -> a -> DataTyCon a
createType typeName typeData =
- DataTyCon
- {typeName, typeDescription = Nothing, typeFingerprint = SystemFingerprint "", typeVisibility = True, typeData}
+ DataTyCon {typeName, typeDescription = Nothing, typeFingerprint = SystemFingerprint "", typeData}
createScalarType :: Text -> (Text, DataFullType)
createScalarType typeName = (typeName, Leaf $ CustomScalar $ createType typeName (DataValidator pure))
diff --git a/src/Data/Morpheus/Parsing/Internal/Terms.hs b/src/Data/Morpheus/Parsing/Internal/Terms.hs
index dab08bc..36137b7 100644
--- a/src/Data/Morpheus/Parsing/Internal/Terms.hs
+++ b/src/Data/Morpheus/Parsing/Internal/Terms.hs
@@ -16,6 +16,7 @@ module Data.Morpheus.Parsing.Internal.Terms
, parseMaybeTuple
, parseAssignment
, parseWrappedType
+ , litEquals
) where
import Data.Functor (($>))
@@ -35,6 +36,9 @@ setLiteral = between (char '{' *> spaceAndComments) (char '}' *> spaceAndComment
pipeLiteral :: Parser ()
pipeLiteral = char '|' *> spaceAndComments
+litEquals :: Parser ()
+litEquals = char '=' *> spaceAndComments
+
-- PRIMITIVE
------------------------------------
token :: Parser Text
diff --git a/src/Data/Morpheus/Parsing/Request/Value.hs b/src/Data/Morpheus/Parsing/Internal/Value.hs
index b5820c4..7f8abf0 100644
--- a/src/Data/Morpheus/Parsing/Request/Value.hs
+++ b/src/Data/Morpheus/Parsing/Internal/Value.hs
@@ -1,23 +1,31 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
-module Data.Morpheus.Parsing.Request.Value
+module Data.Morpheus.Parsing.Internal.Value
( parseValue
, enumValue
+ , parseDefaultValue
) where
import Data.Functor (($>))
import Data.Text (pack)
-import Text.Megaparsec (anySingleBut, between, choice, label, many, sepBy, (<|>))
+import Text.Megaparsec (anySingleBut, between, choice, label, many, optional, sepBy,
+ (<|>))
import Text.Megaparsec.Char (char, string)
import Text.Megaparsec.Char.Lexer (scientific)
--
-- MORPHEUS
import Data.Morpheus.Parsing.Internal.Internal (Parser)
-import Data.Morpheus.Parsing.Internal.Terms (parseAssignment, setOf, spaceAndComments, token)
+import Data.Morpheus.Parsing.Internal.Terms (litEquals, parseAssignment, setOf, spaceAndComments, token)
import Data.Morpheus.Types.Internal.Value (ScalarValue (..), Value (..), decodeScientific)
+parseDefaultValue :: Parser (Maybe Value)
+parseDefaultValue =
+ optional $ do
+ litEquals
+ parseValue
+
parseValue :: Parser Value
parseValue =
label "value" $ do
diff --git a/src/Data/Morpheus/Parsing/Request/Arguments.hs b/src/Data/Morpheus/Parsing/Request/Arguments.hs
index 7c925f2..9f38fb1 100644
--- a/src/Data/Morpheus/Parsing/Request/Arguments.hs
+++ b/src/Data/Morpheus/Parsing/Request/Arguments.hs
@@ -6,7 +6,7 @@ module Data.Morpheus.Parsing.Request.Arguments
import Data.Morpheus.Parsing.Internal.Internal (Parser, getLocation)
import Data.Morpheus.Parsing.Internal.Terms (parseAssignment, parseMaybeTuple, token, variable)
-import Data.Morpheus.Parsing.Request.Value (enumValue, parseValue)
+import Data.Morpheus.Parsing.Internal.Value (enumValue, parseValue)
import Data.Morpheus.Types.Internal.AST.RawSelection (Argument (..), RawArgument (..), RawArguments,
Reference (..))
import Data.Morpheus.Types.Internal.AST.Selection (ArgumentOrigin (..))
diff --git a/src/Data/Morpheus/Parsing/Request/Operation.hs b/src/Data/Morpheus/Parsing/Request/Operation.hs
index df955dd..3cbb648 100644
--- a/src/Data/Morpheus/Parsing/Request/Operation.hs
+++ b/src/Data/Morpheus/Parsing/Request/Operation.hs
@@ -16,15 +16,17 @@ import Text.Megaparsec.Char (string)
import Data.Morpheus.Parsing.Internal.Internal (Parser, getLocation)
import Data.Morpheus.Parsing.Internal.Terms (parseAssignment, parseMaybeTuple, parseNonNull,
parseWrappedType, spaceAndComments1, token, variable)
+import Data.Morpheus.Parsing.Internal.Value (parseDefaultValue)
import Data.Morpheus.Parsing.Request.Body (entries)
-import Data.Morpheus.Types.Internal.AST.Operation (Operation (..), RawOperation, Variable (..))
+import Data.Morpheus.Types.Internal.AST.Operation (DefaultValue, Operation (..), RawOperation, Variable (..))
import Data.Morpheus.Types.Internal.Data (OperationKind (..), toHSWrappers)
-operationArgument :: Parser (Text, Variable ())
+operationArgument :: Parser (Text, Variable DefaultValue)
operationArgument =
label "operatorArgument" $ do
((name, variablePosition), (wrappers, variableType)) <- parseAssignment variable parseWrappedType
nonNull <- parseNonNull
+ defaultValue <- parseDefaultValue
pure
( name
, Variable
@@ -32,7 +34,7 @@ operationArgument =
, isVariableRequired = 0 < length nonNull
, variableTypeWrappers = toHSWrappers $ nonNull ++ wrappers
, variablePosition
- , variableValue = ()
+ , variableValue = defaultValue
})
parseOperation :: Parser RawOperation
diff --git a/src/Data/Morpheus/Rendering/RenderGQL.hs b/src/Data/Morpheus/Rendering/RenderGQL.hs
index e324bb2..3e839ea 100644
--- a/src/Data/Morpheus/Rendering/RenderGQL.hs
+++ b/src/Data/Morpheus/Rendering/RenderGQL.hs
@@ -9,22 +9,23 @@ module Data.Morpheus.Rendering.RenderGQL
, renderGraphQLDocument
) where
-import Data.ByteString.Lazy.Char8 (ByteString)
-import Data.Semigroup ((<>))
-import Data.Text (Text, intercalate)
-import qualified Data.Text.Lazy as LT (fromStrict)
-import Data.Text.Lazy.Encoding (encodeUtf8)
+import Data.ByteString.Lazy.Char8 (ByteString)
+import Data.Semigroup ((<>))
+import Data.Text (Text, intercalate)
+import qualified Data.Text.Lazy as LT (fromStrict)
+import Data.Text.Lazy.Encoding (encodeUtf8)
-- MORPHEUS
-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataKind (..), DataLeaf (..),
- DataTyCon (..), DataTypeLib, DataTypeWrapper (..), Key,
- TypeAlias (..), WrapperD (..), allDataTypes, isVisible,
- toGQLWrapper)
+import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataKind (..), DataLeaf (..),
+ DataTyCon (..), DataTypeLib, DataTypeWrapper (..), Key,
+ TypeAlias (..), WrapperD (..), allDataTypes, isDefaultTypeName,
+ toGQLWrapper)
+import Data.Morpheus.Types.Internal.Value (convertToJSONName)
renderGraphQLDocument :: DataTypeLib -> ByteString
renderGraphQLDocument lib = encodeUtf8 $ LT.fromStrict $ intercalate "\n\n" $ map render visibleTypes
where
- visibleTypes = filter (isVisible . snd) (allDataTypes lib)
+ visibleTypes = filter (not . isDefaultTypeName . fst) (allDataTypes lib)
class RenderGQL a where
render :: a -> Key
@@ -58,12 +59,16 @@ instance RenderGQL (Key, DataFullType) where
render (name, InputUnion DataTyCon {typeData}) = "input " <> name <> render (mapKeys typeData)
render (name, OutputObject DataTyCon {typeData}) = "type " <> name <> render typeData
+mapKeys :: [DataField] -> [(Text, DataField)]
+mapKeys = map (\x -> (fieldName x, x))
+
-- OBJECT
instance RenderGQL [(Text, DataField)] where
render = renderObject renderField . ignoreHidden
where
renderField :: (Text, DataField) -> Text
- renderField (key, DataField {fieldType, fieldArgs}) = key <> renderArgs fieldArgs <> ": " <> render fieldType
+ renderField (key, DataField {fieldType, fieldArgs}) =
+ convertToJSONName key <> renderArgs fieldArgs <> ": " <> render fieldType
where
renderArgs [] = ""
renderArgs list = "(" <> intercalate ", " (map renderField list) <> ")"
@@ -74,8 +79,5 @@ instance RenderGQL [(Text, DataField)] where
renderIndent :: Text
renderIndent = " "
-mapKeys :: [DataField] -> [(Text, DataField)]
-mapKeys = map (\x -> (fieldName x, x))
-
renderObject :: (a -> Text) -> [a] -> Text
renderObject f list = " { \n " <> intercalate ("\n" <> renderIndent) (map f list) <> "\n}"
diff --git a/src/Data/Morpheus/Rendering/RenderIntrospection.hs b/src/Data/Morpheus/Rendering/RenderIntrospection.hs
index 4c2d7d4..b9fe307 100644
--- a/src/Data/Morpheus/Rendering/RenderIntrospection.hs
+++ b/src/Data/Morpheus/Rendering/RenderIntrospection.hs
@@ -182,7 +182,7 @@ wrapAs kind contentType =
createFieldWith :: Monad m => Text -> S__Type m -> [S__InputValue m] -> S__Field m
createFieldWith _name fieldType fieldArgs =
S__Field
- { s__FieldName = constRes $ convertToJSONName _name
+ { s__FieldName = constRes (convertToJSONName _name)
, s__FieldDescription = constRes Nothing
, s__FieldArgs = constRes fieldArgs
, s__FieldType' = constRes fieldType
@@ -193,7 +193,7 @@ createFieldWith _name fieldType fieldArgs =
createInputValueWith :: Monad m => Text -> S__Type m -> S__InputValue m
createInputValueWith name ivType =
S__InputValue
- { s__InputValueName = constRes name
+ { s__InputValueName = constRes (convertToJSONName name)
, s__InputValueDescription = constRes Nothing
, s__InputValueType' = constRes ivType
, s__InputValueDefaultValue = constRes Nothing
diff --git a/src/Data/Morpheus/Schema/Schema.hs b/src/Data/Morpheus/Schema/Schema.hs
index 21c143a..664c2a8 100644
--- a/src/Data/Morpheus/Schema/Schema.hs
+++ b/src/Data/Morpheus/Schema/Schema.hs
@@ -29,6 +29,7 @@ import Data.Morpheus.Schema.TypeKind (TypeKind)
type S__TypeKind = TypeKind
[gqlDocumentNamespace|
+
type __Schema {
types: [__Type!]!
queryType: __Type!
@@ -43,7 +44,7 @@ type __Type {
description: String
# OBJECT and INTERFACE only
- fields(includeDeprecated: Boolean ): [__Field!]
+ fields(includeDeprecated: Boolean = false): [__Field!]
# OBJECT only
interfaces: [__Type!]
@@ -52,7 +53,7 @@ type __Type {
possibleTypes: [__Type!]
# ENUM only
- enumValues(includeDeprecated: Boolean): [__EnumValue!]
+ enumValues(includeDeprecated: Boolean = false): [__EnumValue!]
# INPUT_OBJECT only
inputFields: [__InputValue!]
@@ -99,7 +100,6 @@ enum __DirectiveLocation {
FRAGMENT_DEFINITION
FRAGMENT_SPREAD
INLINE_FRAGMENT
- VARIABLE_DEFINITION
SCHEMA
SCALAR
OBJECT
@@ -113,8 +113,9 @@ enum __DirectiveLocation {
INPUT_FIELD_DEFINITION
}
- type Root {
- __type(name: String!): __Type
- __schema : __Schema!
- }
+type Root {
+ __type(name: String!): __Type
+ __schema : __Schema!
+}
+
|]
diff --git a/src/Data/Morpheus/Schema/SchemaAPI.hs b/src/Data/Morpheus/Schema/SchemaAPI.hs
index 1ce0814..b8b1a6a 100644
--- a/src/Data/Morpheus/Schema/SchemaAPI.hs
+++ b/src/Data/Morpheus/Schema/SchemaAPI.hs
@@ -11,18 +11,19 @@ module Data.Morpheus.Schema.SchemaAPI
) where
import Data.Proxy
-import Data.Text (Text)
+import Data.Text (Text)
-- MORPHEUS
-import Data.Morpheus.Execution.Server.Introspect (ObjectFields (..), TypeUpdater, introspect, resolveTypes)
-import Data.Morpheus.Rendering.RenderIntrospection (createObjectType, render)
-import Data.Morpheus.Schema.Schema (Root (..), Root__typeArgs (..), S__Schema (..), S__Type)
-import Data.Morpheus.Types (constRes)
-import Data.Morpheus.Types.GQLType (CUSTOM)
-import Data.Morpheus.Types.ID (ID)
-import Data.Morpheus.Types.Internal.Data (DataField (..), DataObject, DataTypeLib (..),
- allDataTypes)
-import Data.Morpheus.Types.Resolver (GQLFail (..), ResolveT, Resolver)
+import Data.Morpheus.Execution.Internal.GraphScanner (resolveUpdates)
+import Data.Morpheus.Execution.Server.Introspect (ObjectFields (..), TypeUpdater, introspect)
+import Data.Morpheus.Rendering.RenderIntrospection (createObjectType, render)
+import Data.Morpheus.Schema.Schema (Root (..), Root__typeArgs (..), S__Schema (..), S__Type)
+import Data.Morpheus.Types (constRes)
+import Data.Morpheus.Types.GQLType (CUSTOM)
+import Data.Morpheus.Types.ID (ID)
+import Data.Morpheus.Types.Internal.Data (DataField (..), DataObject, DataTypeLib (..),
+ allDataTypes)
+import Data.Morpheus.Types.Resolver (GQLFail (..), ResolveT, Resolver)
convertTypes :: Monad m => DataTypeLib -> (Resolver m) [S__Type (Resolver m)]
convertTypes lib = traverse (`render` lib) (allDataTypes lib)
@@ -58,7 +59,7 @@ hiddenRootFields = map hideFields $ fst $ objectFields (Proxy :: Proxy (CUSTOM (
defaultTypes :: TypeUpdater
defaultTypes =
flip
- resolveTypes
+ resolveUpdates
[ introspect (Proxy @Bool)
, introspect (Proxy @Int)
, introspect (Proxy @Float)
diff --git a/src/Data/Morpheus/Schema/TypeKind.hs b/src/Data/Morpheus/Schema/TypeKind.hs
index a3af6d4..00cd73e 100644
--- a/src/Data/Morpheus/Schema/TypeKind.hs
+++ b/src/Data/Morpheus/Schema/TypeKind.hs
@@ -9,13 +9,12 @@ module Data.Morpheus.Schema.TypeKind
import Data.Aeson (FromJSON (..))
import Data.Morpheus.Kind (ENUM)
-import Data.Morpheus.Types.GQLType (GQLType (KIND, __typeName, __typeVisibility))
+import Data.Morpheus.Types.GQLType (GQLType (KIND, __typeName))
import GHC.Generics
instance GQLType TypeKind where
type KIND TypeKind = ENUM
__typeName = const "__TypeKind"
- __typeVisibility = const False
data TypeKind
= SCALAR
diff --git a/src/Data/Morpheus/Types/GQLType.hs b/src/Data/Morpheus/Types/GQLType.hs
index b8f67dd..3b27095 100644
--- a/src/Data/Morpheus/Types/GQLType.hs
+++ b/src/Data/Morpheus/Types/GQLType.hs
@@ -75,8 +75,6 @@ class GQLType a where
type CUSTOM a = FALSE
description :: Proxy a -> Maybe Text
description _ = Nothing
- __typeVisibility :: Proxy a -> Bool
- __typeVisibility = const True
__typeName :: Proxy a -> Text
default __typeName :: (Typeable a) =>
Proxy a -> Text
@@ -96,21 +94,17 @@ instance GQLType () where
instance GQLType Int where
type KIND Int = SCALAR
- __typeVisibility = const False
instance GQLType Float where
type KIND Float = SCALAR
- __typeVisibility = const False
instance GQLType Text where
type KIND Text = SCALAR
__typeName = const "String"
- __typeVisibility = const False
instance GQLType Bool where
type KIND Bool = SCALAR
__typeName = const "Boolean"
- __typeVisibility = const False
instance GQLType a => GQLType (Maybe a) where
type KIND (Maybe a) = WRAPPER
diff --git a/src/Data/Morpheus/Types/ID.hs b/src/Data/Morpheus/Types/ID.hs
index 4c983a4..09779e8 100644
--- a/src/Data/Morpheus/Types/ID.hs
+++ b/src/Data/Morpheus/Types/ID.hs
@@ -8,7 +8,7 @@ module Data.Morpheus.Types.ID
import Data.Morpheus.Kind (SCALAR)
import Data.Morpheus.Types.GQLScalar (GQLScalar (..))
-import Data.Morpheus.Types.GQLType (GQLType (KIND, __typeVisibility))
+import Data.Morpheus.Types.GQLType (GQLType (KIND))
import Data.Morpheus.Types.Internal.Value (ScalarValue (..))
import Data.Text (Text, pack)
import GHC.Generics (Generic)
@@ -22,7 +22,6 @@ newtype ID = ID
instance GQLType ID where
type KIND ID = SCALAR
- __typeVisibility _ = False
instance GQLScalar ID where
parseValue (Int x) = return (ID $ pack $ show x)
diff --git a/src/Data/Morpheus/Types/Internal/AST/Operation.hs b/src/Data/Morpheus/Types/Internal/AST/Operation.hs
index 4987d66..3f7b658 100644
--- a/src/Data/Morpheus/Types/Internal/AST/Operation.hs
+++ b/src/Data/Morpheus/Types/Internal/AST/Operation.hs
@@ -9,6 +9,7 @@ module Data.Morpheus.Types.Internal.AST.Operation
, RawOperation
, VariableDefinitions
, ValidVariables
+ , DefaultValue
) where
import Data.Morpheus.Types.Internal.AST.RawSelection (RawSelectionSet)
@@ -19,7 +20,9 @@ import Data.Morpheus.Types.Internal.TH (apply, liftText,
import Data.Morpheus.Types.Internal.Value (Value)
import Language.Haskell.TH.Syntax (Lift (..))
-type VariableDefinitions = Collection (Variable ())
+type DefaultValue = Maybe Value
+
+type VariableDefinitions = Collection (Variable DefaultValue)
type ValidVariables = Collection (Variable Value)
@@ -47,5 +50,5 @@ data Variable a = Variable
, variableValue :: a
} deriving (Show)
-instance Lift (Variable ()) where
+instance Lift a => Lift (Variable a) where
lift (Variable t ir w p v) = apply 'Variable [liftText t, lift ir, lift w, lift p, lift v]
diff --git a/src/Data/Morpheus/Types/Internal/Data.hs b/src/Data/Morpheus/Types/Internal/Data.hs
index a53ce63..b656d21 100644
--- a/src/Data/Morpheus/Types/Internal/Data.hs
+++ b/src/Data/Morpheus/Types/Internal/Data.hs
@@ -49,9 +49,12 @@ module Data.Morpheus.Types.Internal.Data
, isNullable
, toGQLWrapper
, isWeaker
- , isVisible
, isSubscription
, isOutputObject
+ , sysTypes
+ , isDefaultTypeName
+ , isSchemaTypeName
+ , isPrimitiveTypeName
, OperationKind(..)
) where
@@ -65,6 +68,19 @@ import Data.Morpheus.Types.Internal.Base (Key)
import Data.Morpheus.Types.Internal.TH (apply, liftText, liftTextMap)
import Data.Morpheus.Types.Internal.Value (Value (..))
+isDefaultTypeName :: Key -> Bool
+isDefaultTypeName x = isSchemaTypeName x || isPrimitiveTypeName x
+
+isSchemaTypeName :: Key -> Bool
+isSchemaTypeName = (`elem` sysTypes)
+
+isPrimitiveTypeName :: Key -> Bool
+isPrimitiveTypeName = (`elem` ["String", "Float", "Int", "Boolean", "ID"])
+
+sysTypes :: [Key]
+sysTypes =
+ ["__Schema", "__Type", "__Directive", "__TypeKind", "__Field", "__DirectiveLocation", "__InputValue", "__EnumValue"]
+
data OperationKind
= Query
| Subscription
@@ -203,7 +219,6 @@ data DataTyCon a = DataTyCon
{ typeName :: Key
, typeFingerprint :: DataFingerprint
, typeDescription :: Maybe Key
- , typeVisibility :: Bool
, typeData :: a
} deriving (Show)
@@ -295,9 +310,6 @@ fromDataType f (InputObject dt) = f dt {typeData = ()}
fromDataType f (InputUnion dt) = f dt {typeData = ()}
fromDataType f (OutputObject dt) = f dt {typeData = ()}
-isVisible :: DataFullType -> Bool
-isVisible = fromDataType typeVisibility
-
isTypeDefined :: Key -> DataTypeLib -> Maybe DataFingerprint
isTypeDefined name lib = fromDataType typeFingerprint <$> lookupDataType name lib
diff --git a/src/Data/Morpheus/Types/Internal/DataD.hs b/src/Data/Morpheus/Types/Internal/DataD.hs
index 35536bb..1dafa5a 100644
--- a/src/Data/Morpheus/Types/Internal/DataD.hs
+++ b/src/Data/Morpheus/Types/Internal/DataD.hs
@@ -13,21 +13,22 @@ import Language.Haskell.TH.Syntax (Lift (..))
-- MORPHEUS
import Data.Morpheus.Types.Internal.Data (DataField, DataTypeKind)
+data QueryD = QueryD
+ { queryText :: String
+ , queryTypes :: [GQLTypeD]
+ , queryArgsType :: Maybe TypeD
+ } deriving (Show, Lift)
+
data GQLTypeD = GQLTypeD
{ typeD :: TypeD
, typeKindD :: DataTypeKind
, typeArgD :: [TypeD]
} deriving (Show, Lift)
-data QueryD = QueryD
- { queryText :: String
- , queryTypes :: [TypeD]
- , queryArgTypes :: [TypeD]
- } deriving (Show, Lift)
-
data TypeD = TypeD
- { tName :: String
- , tCons :: [ConsD]
+ { tName :: String
+ , tNamespace :: [String]
+ , tCons :: [ConsD]
} deriving (Show, Lift)
data ConsD = ConsD
diff --git a/src/Data/Morpheus/Types/Internal/TH.hs b/src/Data/Morpheus/Types/Internal/TH.hs
index 1f7f998..b3f4fa1 100644
--- a/src/Data/Morpheus/Types/Internal/TH.hs
+++ b/src/Data/Morpheus/Types/Internal/TH.hs
@@ -32,3 +32,7 @@ instanceFunD name args body = funD name [clause (map (varP . mkName) args) (norm
instanceHeadMultiT :: Name -> Q Type -> [Q Type] -> Q Type
instanceHeadMultiT className iType li = applyT className (iType : li)
+
+-- "User" -> ["name","id"] -> (User name id)
+destructRecord :: String -> [String] -> PatQ
+destructRecord conName fields = conP (mkName conName) (map (varP . mkName) fields)
diff --git a/src/Data/Morpheus/Types/Internal/Validation.hs b/src/Data/Morpheus/Types/Internal/Validation.hs
index 17a57c1..95b96b0 100644
--- a/src/Data/Morpheus/Types/Internal/Validation.hs
+++ b/src/Data/Morpheus/Types/Internal/Validation.hs
@@ -9,7 +9,6 @@ module Data.Morpheus.Types.Internal.Validation
, Validation
, ResolveT
, failResolveT
- , SchemaValidation
, ResolveValue
) where
@@ -34,8 +33,6 @@ data JSONError = JSONError
type Validation = Either GQLErrors
-type SchemaValidation = Validation
-
type ResolveT = ExceptT GQLErrors
type ResolveValue m = ExceptT GQLErrors m Value
diff --git a/src/Data/Morpheus/Validation/Query/Input/Object.hs b/src/Data/Morpheus/Validation/Internal/Value.hs
index 24975c4..18e2a74 100644
--- a/src/Data/Morpheus/Validation/Query/Input/Object.hs
+++ b/src/Data/Morpheus/Validation/Internal/Value.hs
@@ -1,31 +1,30 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
-module Data.Morpheus.Validation.Query.Input.Object
+module Data.Morpheus.Validation.Internal.Value
( validateInputValue
+ , validateEnum
) where
-import Data.Morpheus.Error.Input (InputError (..), InputValidation, Prop (..))
-import Data.Morpheus.Rendering.RenderGQL (renderWrapped)
-import Data.Morpheus.Types.Internal.Data (DataField (..), DataKind (..), DataTyCon (..),
- DataTypeLib (..), DataValidator (..), TypeAlias (..),
- WrapperD (..), isNullable)
-import Data.Morpheus.Types.Internal.Value (Value (..))
-import Data.Morpheus.Validation.Internal.Utils (getInputType, lookupField)
-import Data.Morpheus.Validation.Query.Input.Enum (validateEnum)
-import Data.Text (Text)
+import Data.List (elem)
-typeMismatch :: Value -> Text -> [Prop] -> InputError
-typeMismatch jsType expected' path' = UnexpectedType path' expected' jsType Nothing
+-- MORPHEUS
+import Data.Morpheus.Error.Input (InputError (..), InputValidation, Prop (..))
+import Data.Morpheus.Rendering.RenderGQL (renderWrapped)
+import Data.Morpheus.Types.Internal.Data (DataField (..), DataKind (..), DataTyCon (..),
+ DataTypeLib (..), DataValidator (..), Key, TypeAlias (..),
+ WrapperD (..), isNullable)
+import Data.Morpheus.Types.Internal.Value (Value (..))
+import Data.Morpheus.Validation.Internal.Utils (getInputType, lookupField)
-- Validate Variable Argument or all Possible input Values
-validateInputValue :: DataTypeLib -> [Prop] -> [WrapperD] -> DataKind -> (Text, Value) -> InputValidation Value
+validateInputValue :: DataTypeLib -> [Prop] -> [WrapperD] -> DataKind -> (Key, Value) -> InputValidation Value
validateInputValue lib prop' = validate
where
throwError :: [WrapperD] -> DataKind -> Value -> InputValidation Value
throwError wrappers type' value' = Left $ UnexpectedType prop' (renderWrapped type' wrappers) value' Nothing
-- VALIDATION
- validate :: [WrapperD] -> DataKind -> (Text, Value) -> InputValidation Value
+ validate :: [WrapperD] -> DataKind -> (Key, Value) -> InputValidation Value
-- Validate Null. value = null ?
validate wrappers tName (_, Null)
| isNullable wrappers = return Null
@@ -66,3 +65,13 @@ validateInputValue lib prop' = validate
Left errorMessage -> Left $ UnexpectedType prop' name' value' (Just errorMessage)
{-- 3. THROW ERROR: on invalid values --}
validate wrappers' type' (_, value') = throwError wrappers' type' value'
+
+validateEnum :: error -> [Key] -> Value -> Either error Value
+validateEnum error' tags' (Enum enumValue) =
+ if enumValue `elem` tags'
+ then pure (Enum enumValue)
+ else Left error'
+validateEnum error' _ _ = Left error'
+
+typeMismatch :: Value -> Key -> [Prop] -> InputError
+typeMismatch jsType expected' path' = UnexpectedType path' expected' jsType Nothing
diff --git a/src/Data/Morpheus/Validation/Query/Arguments.hs b/src/Data/Morpheus/Validation/Query/Arguments.hs
index 3efa717..cc933de 100644
--- a/src/Data/Morpheus/Validation/Query/Arguments.hs
+++ b/src/Data/Morpheus/Validation/Query/Arguments.hs
@@ -20,7 +20,7 @@ import Data.Morpheus.Types.Internal.Data (DataArgument, Da
import Data.Morpheus.Types.Internal.Validation (Validation)
import Data.Morpheus.Types.Internal.Value (Value (Null))
import Data.Morpheus.Validation.Internal.Utils (checkForUnknownKeys, checkNameCollision, getInputType)
-import Data.Morpheus.Validation.Query.Input.Object (validateInputValue)
+import Data.Morpheus.Validation.Internal.Value (validateInputValue)
import Data.Text (Text)
resolveArgumentVariables :: Text -> ValidVariables -> DataField -> RawArguments -> Validation Arguments
diff --git a/src/Data/Morpheus/Validation/Query/Input/Enum.hs b/src/Data/Morpheus/Validation/Query/Input/Enum.hs
deleted file mode 100644
index 7cab930..0000000
--- a/src/Data/Morpheus/Validation/Query/Input/Enum.hs
+++ /dev/null
@@ -1,16 +0,0 @@
-{-# LANGUAGE TypeOperators #-}
-
-module Data.Morpheus.Validation.Query.Input.Enum
- ( validateEnum
- ) where
-
-import Data.List (elem)
-import Data.Morpheus.Types.Internal.Value (Value (..))
-import Data.Text (Text)
-
-validateEnum :: error -> [Text] -> Value -> Either error Value
-validateEnum error' tags' (Enum enumValue) =
- if enumValue `elem` tags'
- then pure (Enum enumValue)
- else Left error'
-validateEnum error' _ _ = Left error'
diff --git a/src/Data/Morpheus/Validation/Query/Variable.hs b/src/Data/Morpheus/Validation/Query/Variable.hs
index 7b6325f..caa35cc 100644
--- a/src/Data/Morpheus/Validation/Query/Variable.hs
+++ b/src/Data/Morpheus/Validation/Query/Variable.hs
@@ -7,11 +7,11 @@ module Data.Morpheus.Validation.Query.Variable
import Data.List ((\\))
import qualified Data.Map as M (lookup)
import Data.Maybe (maybe)
-import Data.Morpheus.Error.Input (InputValidation, inputErrorMessage)
+import Data.Morpheus.Error.Input (inputErrorMessage)
import Data.Morpheus.Error.Variable (uninitializedVariable, unknownType, unusedVariables,
variableGotInvalidValue)
-import Data.Morpheus.Types.Internal.AST.Operation (Operation (..), RawOperation, ValidVariables,
- Variable (..))
+import Data.Morpheus.Types.Internal.AST.Operation (DefaultValue, Operation (..), RawOperation,
+ ValidVariables, Variable (..))
import Data.Morpheus.Types.Internal.AST.RawSelection (Fragment (..), FragmentLib, RawArgument (..),
RawSelection (..), RawSelection' (..), RawSelectionSet,
Reference (..))
@@ -21,8 +21,8 @@ import Data.Morpheus.Types.Internal.Validation (Validation)
import Data.Morpheus.Types.Internal.Value (Value (..))
import Data.Morpheus.Types.Types (Variables)
import Data.Morpheus.Validation.Internal.Utils (VALIDATION_MODE (..), getInputType)
+import Data.Morpheus.Validation.Internal.Value (validateInputValue)
import Data.Morpheus.Validation.Query.Fragment (getFragment)
-import Data.Morpheus.Validation.Query.Input.Object (validateInputValue)
import Data.Semigroup ((<>))
import Data.Text (Text)
@@ -31,16 +31,6 @@ getVariableType type' position' lib' = getInputType type' lib' error'
where
error' = unknownType type' position'
-lookupVariable :: Variables -> Text -> (Text -> error) -> Either error Value
-lookupVariable variables' key' error' =
- case M.lookup key' variables' of
- Nothing -> Left $ error' key'
- Just value -> pure value
-
-handleInputError :: Text -> Position -> InputValidation Value -> Validation (Text, Value)
-handleInputError key' position' (Left error') = Left $ variableGotInvalidValue key' (inputErrorMessage error') position'
-handleInputError key' _ (Right value') = pure (key', value')
-
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM f = fmap concat . mapM f
@@ -71,7 +61,7 @@ resolveOperationVariables typeLib lib root validationMode Operation {operationNa
allVariableReferences lib [operationSelection] >>= checkUnusedVariables
mapM (lookupAndValidateValueOnBody typeLib root validationMode) operationArgs
where
- varToKey :: (Text, Variable ()) -> EnhancedKey
+ varToKey :: (Text, Variable a) -> EnhancedKey
varToKey (key', Variable {variablePosition}) = EnhancedKey key' variablePosition
--
checkUnusedVariables :: [EnhancedKey] -> Validation ()
@@ -81,21 +71,29 @@ resolveOperationVariables typeLib lib root validationMode Operation {operationNa
unused' -> Left $ unusedVariables operationName unused'
lookupAndValidateValueOnBody ::
- DataTypeLib -> Variables -> VALIDATION_MODE -> (Text, Variable ()) -> Validation (Text, Variable Value)
+ DataTypeLib -> Variables -> VALIDATION_MODE -> (Text, Variable DefaultValue) -> Validation (Text, Variable Value)
lookupAndValidateValueOnBody typeLib bodyVariables validationMode (key, var@Variable { variableType
, variablePosition
, isVariableRequired
, variableTypeWrappers
+ , variableValue = defaultValue
}) =
- toVariable <$>
- (getVariableType variableType variablePosition typeLib >>=
- checkType (validationMode /= WITHOUT_VARIABLES && isVariableRequired))
+ toVariable <$> (getVariableType variableType variablePosition typeLib >>= checkType getVariable defaultValue)
where
toVariable (varKey, variableValue) = (varKey, var {variableValue})
+ getVariable = M.lookup key bodyVariables
------------------------------------------------------------------
- checkType True varType =
- lookupVariable bodyVariables key (uninitializedVariable variablePosition variableType) >>= validator varType
- checkType False varType = maybe (pure (key, Null)) (validator varType) (M.lookup key bodyVariables)
+ checkType (Just variable) Nothing varType = validator varType variable
+ checkType (Just variable) (Just defValue) varType = validator varType defValue >> validator varType variable
+ checkType Nothing (Just defValue) varType = validator varType defValue
+ checkType Nothing Nothing varType
+ | validationMode /= WITHOUT_VARIABLES && isVariableRequired =
+ Left $ uninitializedVariable variablePosition variableType key
+ | otherwise = returnNull
+ where
+ returnNull = maybe (pure (key, Null)) (validator varType) (M.lookup key bodyVariables)
-----------------------------------------------------------------------------------------------
validator varType varValue =
- handleInputError key variablePosition $ validateInputValue typeLib [] variableTypeWrappers varType (key, varValue)
+ case validateInputValue typeLib [] variableTypeWrappers varType (key, varValue) of
+ Left message -> Left $ variableGotInvalidValue key (inputErrorMessage message) variablePosition
+ Right value -> pure (key, value)
diff --git a/test/Feature/Holistic/API.hs b/test/Feature/Holistic/API.hs
index c4148dc..5236359 100644
--- a/test/Feature/Holistic/API.hs
+++ b/test/Feature/Holistic/API.hs
@@ -11,6 +11,7 @@
module Feature.Holistic.API
( api
+ , rootResolver
) where
import Data.Morpheus (interpreter)
diff --git a/test/Feature/Holistic/introspection/schemaTypes/__DirectiveLocation/response.json b/test/Feature/Holistic/introspection/schemaTypes/__DirectiveLocation/response.json
index ebc6001..e4c512b 100644
--- a/test/Feature/Holistic/introspection/schemaTypes/__DirectiveLocation/response.json
+++ b/test/Feature/Holistic/introspection/schemaTypes/__DirectiveLocation/response.json
@@ -43,11 +43,6 @@
"deprecationReason": null
},
{
- "name": "VARIABLE_DEFINITION",
- "isDeprecated": false,
- "deprecationReason": null
- },
- {
"name": "SCHEMA",
"isDeprecated": false,
"deprecationReason": null
diff --git a/test/Feature/InputType/cases.json b/test/Feature/InputType/cases.json
index 61ef1ff..ad65bdc 100644
--- a/test/Feature/InputType/cases.json
+++ b/test/Feature/InputType/cases.json
@@ -20,10 +20,14 @@
"description": "fail when: variable is defined by the operation but can't found on request body"
},
{
- "path": "variables/nullableVariable",
+ "path": "variables/valueNotProvided/nullableVariable",
"description": "don't fail when: variable is defined by the operation but can't found on request body"
},
{
+ "path": "variables/valueNotProvided/nonNullVariableWithDefaultValue",
+ "description": "don't fail when: not nullable variable was not provided but has default value"
+ },
+ {
"path": "variables/invalidValue/invalidListVariable",
"description": "fail when: variable receives invalid List value"
},
@@ -32,6 +36,14 @@
"description": "fail: if list of nonNull elements receives null"
},
{
+ "path": "variables/invalidValue/invalidDefaultValue",
+ "description": "fail: if default value is incompatible"
+ },
+ {
+ "path": "variables/invalidValue/invalidDefaultValueButVariableProvided",
+ "description": "fail: if default value is incompatible eve if correct variable value was provided"
+ },
+ {
"path": "variables/nestedListNullableListReceivedNull",
"description": "resolve: if list of nullable elements receives null"
},
diff --git a/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/query.gql b/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/query.gql
new file mode 100644
index 0000000..83b7a2f
--- /dev/null
+++ b/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/query.gql
@@ -0,0 +1,5 @@
+query invalidListVariable($v1: [[[Int!]!]]! = { id: "12" }) {
+ q1 {
+ a2(argList: [], argNestedList: $v1)
+ }
+}
diff --git a/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/response.json b/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/response.json
new file mode 100644
index 0000000..4454def
--- /dev/null
+++ b/test/Feature/InputType/variables/invalidValue/invalidDefaultValue/response.json
@@ -0,0 +1,13 @@
+{
+ "errors": [
+ {
+ "message": "Variable \"$v1\" got invalid value; Expected type \"[[[Int!]!]]!\" found {\"id\":\"12\"}.",
+ "locations": [
+ {
+ "line": 1,
+ "column": 27
+ }
+ ]
+ }
+ ]
+} \ No newline at end of file
diff --git a/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/query.gql b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/query.gql
new file mode 100644
index 0000000..51a022b
--- /dev/null
+++ b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/query.gql
@@ -0,0 +1,5 @@
+query invalidListVariable($v1: [[[Int!]!]]! = [["boo"]]) {
+ q1 {
+ a2(argList: [], argNestedList: $v1)
+ }
+}
diff --git a/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/response.json b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/response.json
new file mode 100644
index 0000000..14eef3c
--- /dev/null
+++ b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/response.json
@@ -0,0 +1,13 @@
+{
+ "errors": [
+ {
+ "message": "Variable \"$v1\" got invalid value; Expected type \"[Int!]!\" found \"boo\".",
+ "locations": [
+ {
+ "line": 1,
+ "column": 27
+ }
+ ]
+ }
+ ]
+} \ No newline at end of file
diff --git a/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/variables.json b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/variables.json
new file mode 100644
index 0000000..e464e0c
--- /dev/null
+++ b/test/Feature/InputType/variables/invalidValue/invalidDefaultValueButVariableProvided/variables.json
@@ -0,0 +1,3 @@
+{
+ "v1": []
+} \ No newline at end of file
diff --git a/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql b/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql
new file mode 100644
index 0000000..1ea96e0
--- /dev/null
+++ b/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/query.gql
@@ -0,0 +1,5 @@
+query TestNonNullVariable($i1: String! = "hello world") {
+ q1 {
+ a1(arg1: $i1)
+ }
+}
diff --git a/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json b/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json
new file mode 100644
index 0000000..d72d020
--- /dev/null
+++ b/test/Feature/InputType/variables/valueNotProvided/nonNullVariableWithDefaultValue/response.json
@@ -0,0 +1,7 @@
+{
+ "data": {
+ "q1": {
+ "a1": "a1Test"
+ }
+ }
+}
diff --git a/test/Feature/InputType/variables/nullableVariable/query.gql b/test/Feature/InputType/variables/valueNotProvided/nullableVariable/query.gql
index 3ee6558..3ee6558 100644
--- a/test/Feature/InputType/variables/nullableVariable/query.gql
+++ b/test/Feature/InputType/variables/valueNotProvided/nullableVariable/query.gql
diff --git a/test/Feature/InputType/variables/nullableVariable/response.json b/test/Feature/InputType/variables/valueNotProvided/nullableVariable/response.json
index 2d4fd28..2d4fd28 100644
--- a/test/Feature/InputType/variables/nullableVariable/response.json
+++ b/test/Feature/InputType/variables/valueNotProvided/nullableVariable/response.json
diff --git a/test/Rendering/Schema.hs b/test/Rendering/Schema.hs
new file mode 100644
index 0000000..d42a043
--- /dev/null
+++ b/test/Rendering/Schema.hs
@@ -0,0 +1,39 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Rendering.Schema
+ ( schemaProxy
+ ) where
+
+import Data.Morpheus.Document (importGQLDocumentWithNamespace)
+import Data.Morpheus.Kind (SCALAR)
+import Data.Morpheus.Types (GQLRootResolver (..), GQLScalar (..), GQLType (..), ID (..), IORes,
+ ScalarValue (..))
+import Data.Proxy (Proxy (..))
+import Data.Text (Text)
+import GHC.Generics (Generic)
+
+data TestScalar =
+ TestScalar
+ deriving (Show, Generic)
+
+instance GQLType TestScalar where
+ type KIND TestScalar = SCALAR
+
+instance GQLScalar TestScalar where
+ parseValue _ = pure TestScalar
+ serialize TestScalar = Int 0
+
+importGQLDocumentWithNamespace "test/Rendering/schema.gql"
+
+schemaProxy :: Proxy (GQLRootResolver IO () () (Query IORes) () ())
+schemaProxy = Proxy @(GQLRootResolver IO () () (Query IORes) () ())
diff --git a/test/Rendering/TestSchemaRendering.hs b/test/Rendering/TestSchemaRendering.hs
new file mode 100644
index 0000000..cb56134
--- /dev/null
+++ b/test/Rendering/TestSchemaRendering.hs
@@ -0,0 +1,19 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+module Rendering.TestSchemaRendering
+ ( testSchemaRendering
+ ) where
+
+import Data.Morpheus.Document (toGraphQLDocument)
+import Rendering.Schema (schemaProxy)
+import Test.Tasty (TestTree)
+import Test.Tasty.HUnit (assertEqual, testCase)
+
+-- TODO: better Test
+testSchemaRendering :: TestTree
+testSchemaRendering = testCase "Test Rendering" $ assertEqual "test schema Rendering" schema expected
+ where
+ schema = toGraphQLDocument schemaProxy
+ expected =
+ "type Query { \n user: User!\n testUnion: TestUnion\n}\n\nenum TestEnum { \n EnumA\n EnumB\n EnumC\n}\n\nscalar TestScalar\n\ninput Coordinates { \n latitude: TestScalar!\n longitude: Int!\n}\n\ntype Address { \n street: [[[[String!]!]!]]\n}\n\ntype User { \n type: String!\n address(coordinates: Coordinates!, type: String): Int!\n friend(id: ID!, cityID: TestEnum): User!\n}\n\nunion TestUnion =\n User!\n | Address!"
diff --git a/test/Rendering/schema.gql b/test/Rendering/schema.gql
new file mode 100644
index 0000000..b573016
--- /dev/null
+++ b/test/Rendering/schema.gql
@@ -0,0 +1,27 @@
+enum TestEnum {
+ EnumA
+ EnumB
+ EnumC
+}
+
+input Coordinates {
+ latitude: TestScalar!
+ longitude: Int!
+}
+
+union TestUnion = User | Address
+
+type Address {
+ street: [[[[String!]!]!]]
+}
+
+type User {
+ type: String!
+ address(coordinates: Coordinates!, type: String): Int!
+ friend(id: ID! , cityID: TestEnum): User!
+}
+
+type Query {
+ user: User!
+ testUnion: TestUnion
+}
diff --git a/test/Spec.hs b/test/Spec.hs
index 2a0e1c5..fba5605 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -4,14 +4,15 @@ module Main
( main
) where
-import qualified Feature.Holistic.API as Holistic (api)
-import qualified Feature.Input.Enum.API as InputEnum (api)
-import qualified Feature.InputType.API as InputType (api)
-import qualified Feature.Schema.API as Schema (api)
-import qualified Feature.UnionType.API as UnionType (api)
-import qualified Feature.WrappedTypeName.API as TypeName (api)
-import Test.Tasty (defaultMain, testGroup)
-import TestFeature (testFeature)
+import qualified Feature.Holistic.API as Holistic (api)
+import qualified Feature.Input.Enum.API as InputEnum (api)
+import qualified Feature.InputType.API as InputType (api)
+import qualified Feature.Schema.API as Schema (api)
+import qualified Feature.UnionType.API as UnionType (api)
+import qualified Feature.WrappedTypeName.API as TypeName (api)
+import Rendering.TestSchemaRendering (testSchemaRendering)
+import Test.Tasty (defaultMain, testGroup)
+import TestFeature (testFeature)
main :: IO ()
main = do
@@ -21,4 +22,7 @@ main = do
schemaTest <- testFeature Schema.api "Feature/Schema"
typeName <- testFeature TypeName.api "Feature/WrappedTypeName"
inputEnum <- testFeature InputEnum.api "Feature/Input/Enum"
- defaultMain (testGroup "Morpheus Graphql Tests" [ioTests, unionTest, inputTest, schemaTest, typeName, inputEnum])
+ defaultMain
+ (testGroup
+ "Morpheus Graphql Tests"
+ [ioTests, unionTest, inputTest, schemaTest, typeName, inputEnum, testSchemaRendering])