morpheus-graphql 0.5.0 → 0.6.0
raw patch · 47 files changed
+318/−3173 lines, 47 filesdep −filepathdep −optparse-applicativedep −scottydep ~aesondep ~bytestringdep ~mtl
Dependencies removed: filepath, optparse-applicative, scotty, wai, wai-websockets, warp
Dependency ranges changed: aeson, bytestring, mtl, template-haskell, text, websockets
Files
- CLI/Main.hs +0/−73
- README.md +10/−17
- assets/introspection.json +0/−1829
- assets/mut.gql +0/−40
- assets/pubsub.gql +0/−46
- assets/simple.gql +0/−88
- changelog.md +19/−0
- examples/Client/Client.hs +0/−99
- examples/Files.hs +0/−12
- examples/Main.hs +0/−45
- examples/Mythology/API.hs +0/−37
- examples/Mythology/Character/Deity.hs +0/−28
- examples/Mythology/Character/Human.hs +0/−21
- examples/Mythology/Place/Places.hs +0/−34
- examples/Sophisticated/API.hs +0/−136
- examples/Sophisticated/Model.hs +0/−33
- examples/Sophisticated/api.gql +0/−94
- examples/Subscription/SimpleSubscription.hs +0/−67
- examples/Subscription/api.gql +0/−11
- examples/TH/Simple.hs +0/−39
- examples/TH/simple.gql +0/−8
- morpheus-graphql.cabal +9/−83
- src/Data/Morpheus/Error/Internal.hs +0/−6
- src/Data/Morpheus/Execution/Client/Fetch.hs +8/−7
- src/Data/Morpheus/Execution/Client/Selection.hs +27/−32
- src/Data/Morpheus/Execution/Document/Convert.hs +18/−19
- src/Data/Morpheus/Execution/Document/GQLType.hs +5/−3
- src/Data/Morpheus/Execution/Internal/Declare.hs +2/−2
- src/Data/Morpheus/Execution/Server/Introspect.hs +13/−12
- src/Data/Morpheus/Parsing/Document/TypeSystem.hs +12/−13
- src/Data/Morpheus/Parsing/Internal/Create.hs +20/−15
- src/Data/Morpheus/Parsing/JSONSchema/Parse.hs +6/−6
- src/Data/Morpheus/Rendering/Haskell/RenderHS.hs +0/−35
- src/Data/Morpheus/Rendering/Haskell/Types.hs +9/−10
- src/Data/Morpheus/Rendering/Haskell/Values.hs +7/−8
- src/Data/Morpheus/Rendering/RenderGQL.hs +17/−17
- src/Data/Morpheus/Rendering/RenderIntrospection.hs +19/−22
- src/Data/Morpheus/Types.hs +4/−1
- src/Data/Morpheus/Types/Internal/Data.hs +53/−60
- src/Data/Morpheus/Types/Internal/Resolver.hs +16/−26
- src/Data/Morpheus/Types/Internal/TH.hs +6/−1
- src/Data/Morpheus/Validation/Document/Validation.hs +5/−5
- src/Data/Morpheus/Validation/Internal/Utils.hs +12/−12
- src/Data/Morpheus/Validation/Internal/Value.hs +10/−10
- src/Data/Morpheus/Validation/Query/Selection.hs +7/−7
- src/Data/Morpheus/Validation/Query/Variable.hs +2/−2
- test/Rendering/TestSchemaRendering.hs +2/−2
− CLI/Main.hs
@@ -1,73 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}--module Main- ( main- ) where--import qualified Data.ByteString.Lazy as L (readFile, writeFile)-import Data.Semigroup ((<>))-import Data.Version (showVersion)-import Options.Applicative (Parser, command, customExecParser, fullDesc, help, helper, info, long, metavar,- prefs, progDesc, short, showHelpOnError, strArgument, subparser, switch)-import qualified Options.Applicative as OA-import Paths_morpheus_graphql (version)-import System.FilePath.Posix (takeBaseName)---- MORPHEUS-import Data.Morpheus.Document (toMorpheusHaskellAPi)--morpheusVersion :: String-morpheusVersion = showVersion version--main :: IO ()-main = defaultParser >>= buildHaskellApi- where- buildHaskellApi Options {optionCommand} = executeCommand optionCommand- where- executeCommand About = putStrLn $ "Morpheus GraphQL CLI, version " <> morpheusVersion- executeCommand Build {source, target} =- toMorpheusHaskellAPi (takeBaseName target) <$> L.readFile source >>= saveDocument- where- saveDocument (Left errors) = print errors- saveDocument (Right doc) = L.writeFile target doc--data Command- = Build { source :: FilePath- , target :: FilePath }- | About- deriving (Show)--data Options = Options- { optionVerbose :: Bool- , optionCommand :: Command- } deriving (Show)--data Behavior = Behavior- { bName :: String- , bValue :: Parser Command- , bDesc :: String- }--defaultParser :: IO Options-defaultParser = customExecParser (prefs showHelpOnError) (info (helper <*> optionParser) morpheusDescription)- where- morpheusDescription = fullDesc <> progDesc "Morpheus GraphQL CLI - haskell Api Generator"- ------------------------------------------------------ optionParser :: OA.Parser Options- optionParser = Options <$> versionParser <*> commandParser- where- versionParser = switch (long "version" <> short 'v' <> help "show Version number")- ----------------------------------------------------------------------------------------------- commandParser = subparser $ foldr ((<>) . produceCommand) mempty commands- where- pathParser label = strArgument $ metavar label <> help (label <> " file")- produceCommand Behavior {bName, bValue, bDesc} =- command bName (info (helper <*> bValue) (fullDesc <> progDesc bDesc))- commands =- [ Behavior- { bName = "build"- , bValue = pure Build <*> pathParser "Source.gql" <*> pathParser "Target.hs"- , bDesc = "builds haskell API from from GhraphQL schema \"*.gql\" "- }- , Behavior {bName = "about", bValue = pure About, bDesc = "api information"}- ]
README.md view
@@ -29,7 +29,7 @@ resolver: lts-14.8 extra-deps:- - morpheus-graphql-0.5.0+ - morpheus-graphql-0.6.0 ``` As Morpheus is quite new, make sure stack can find morpheus-graphql by running `stack upgrade` and `stack update`@@ -80,7 +80,7 @@ GQLRootResolver { queryResolver = Query {queryDeity},- mutationResolver = Undefined, + mutationResolver = Undefined, subscriptionResolver = Undefined } where@@ -137,8 +137,8 @@ The field name in the final request will be `type` instead of `type'`. The Morpheus request parser converts each of the reserved identities in Haskell 2010 to their corresponding names internally. This also applies to selections. ```haskell-resolveDeity :: DeityArgs -> IORes Deity-resolveDeity args = QueryResolver $ ExceptT $ askDB (name args) (mythology args)+resolveDeity :: DeityArgs -> IORes e Deity+resolveDeity DeityArgs { name, mythology } = liftEitherM $ dbDeity name mythology askDB :: Text -> Maybe Text -> IO (Either String Deity) askDB = ...@@ -201,7 +201,7 @@ Mythology API is deployed on : [_api.morpheusgraphql.com_](https://api.morpheusgraphql.com) where you can test it with `GraphiQL` -+ ## Advanced topics @@ -274,9 +274,9 @@ screenshots from `Insomnia` ---+++ ### Mutations @@ -344,7 +344,7 @@ } where createDeity _args = MutResolver events updateDeity- where + where events = [Event {channels = [ChannelA], content = ContentA 1}] updateDeity = updateDBDeity newDeity _args = SubResolver [ChannelA] subResolver@@ -437,14 +437,7 @@ ## Morpheus CLI for Code Generating -Generating dummy Morpheus Api from `schema.gql`--```-morpheus build src/schem.gql src/GQLApi.hs-```--this command will generate Haskell API and resolvers,-resolvers will resolve default values for every object+you should use [morpheus-graphql-cli](https://github.com/morpheusgraphql/morpheus-graphql-cli) # About
− assets/introspection.json
@@ -1,1829 +0,0 @@-{- "data": {- "__schema": {- "queryType": {- "name": "Query"- },- "mutationType": {- "name": "Mutation"- },- "subscriptionType": {- "name": "Subscription"- },- "types": [- {- "kind": "OBJECT",- "name": "Query",- "description": "",- "fields": [- {- "name": "user",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "User",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "wrappedA1",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "A_Pair_Int_Text",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "setAnimal",- "description": null,- "args": [- {- "name": "animal",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "INPUT_OBJECT",- "name": "Animal",- "ofType": null- }- },- "defaultValue": null- }- ],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "wrappedA2",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "A_Text",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "integerSet",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Int",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "textIntMap",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "MapKind_Text_Int",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "Mutation",- "description": "",- "fields": [- {- "name": "createUser",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "User",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "createAddress",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Address",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "Subscription",- "description": "",- "fields": [- {- "name": "newAddress",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Address",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "newUser",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "User",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "ENUM",- "name": "AnimalTags",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": [- {- "name": "Cat",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "Dog",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "Bird",- "description": null,- "isDeprecated": false,- "deprecationReason": null- }- ],- "possibleTypes": null- },- {- "kind": "ENUM",- "name": "CityID",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": [- {- "name": "Paris",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "BLN",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "HH",- "description": null,- "isDeprecated": false,- "deprecationReason": null- }- ],- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "Euro",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "ENUM",- "name": "__DirectiveLocation",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": [- {- "name": "QUERY",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "MUTATION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "SUBSCRIPTION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "FIELD",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "FRAGMENT_DEFINITION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "FRAGMENT_SPREAD",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INLINE_FRAGMENT",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "VARIABLE_DEFINITION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "SCHEMA",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "SCALAR",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "OBJECT",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "FIELD_DEFINITION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "ARGUMENT_DEFINITION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INTERFACE",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "UNION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "ENUM",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "ENUM_VALUE",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INPUT_OBJECT",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INPUT_FIELD_DEFINITION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- }- ],- "possibleTypes": null- },- {- "kind": "ENUM",- "name": "__TypeKind",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": [- {- "name": "SCALAR",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "OBJECT",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INTERFACE",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "UNION",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "ENUM",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "INPUT_OBJECT",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "LIST",- "description": null,- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "NON_NULL",- "description": null,- "isDeprecated": false,- "deprecationReason": null- }- ],- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "ID",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "String",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "Float",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "Int",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "SCALAR",- "name": "Boolean",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "Bird",- "description": "",- "fields": null,- "inputFields": [- {- "name": "birdName",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "Dog",- "description": "",- "fields": null,- "inputFields": [- {- "name": "dogName",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "Cat",- "description": "",- "fields": null,- "inputFields": [- {- "name": "catName",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "UniqueID",- "description": "",- "fields": null,- "inputFields": [- {- "name": "uid",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "Coordinates",- "description": "just random latitude and longitude",- "fields": null,- "inputFields": [- {- "name": "latitude",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Euro",- "ofType": null- }- },- "defaultValue": null- },- {- "name": "longitude",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "INPUT_OBJECT",- "name": "UniqueID",- "ofType": null- }- }- }- }- }- }- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "INPUT_OBJECT",- "name": "Animal",- "description": "",- "fields": null,- "inputFields": [- {- "name": "tag",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "ENUM",- "name": "AnimalTags",- "ofType": null- }- },- "defaultValue": null- },- {- "name": "Cat",- "description": null,- "type": {- "kind": "INPUT_OBJECT",- "name": "Cat",- "ofType": null- },- "defaultValue": null- },- {- "name": "Dog",- "description": null,- "type": {- "kind": "INPUT_OBJECT",- "name": "Dog",- "ofType": null- },- "defaultValue": null- },- {- "name": "Bird",- "description": null,- "type": {- "kind": "INPUT_OBJECT",- "name": "Bird",- "ofType": null- },- "defaultValue": null- }- ],- "interfaces": null,- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "Pair_Text_Int",- "description": "",- "fields": [- {- "name": "key",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "value",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Int",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "MapKind_Text_Int",- "description": "",- "fields": [- {- "name": "size",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Int",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "pairs",- "description": null,- "args": [- {- "name": "oneOf",- "description": null,- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- }- },- "defaultValue": null- }- ],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Pair_Text_Int",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "A_Text",- "description": "",- "fields": [- {- "name": "wrappedA",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "Pair_Int_Text",- "description": "",- "fields": [- {- "name": "key",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Int",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "value",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "A_Pair_Int_Text",- "description": "",- "fields": [- {- "name": "wrappedA",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Pair_Int_Text",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "Address",- "description": "",- "fields": [- {- "name": "city",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "street",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "houseNumber",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Int",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "User",- "description": "Custom Description for Client Defined User Type",- "fields": [- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "email",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "address",- "description": null,- "args": [- {- "name": "coordinates",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "INPUT_OBJECT",- "name": "Coordinates",- "ofType": null- }- },- "defaultValue": null- },- {- "name": "comment",- "description": null,- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "defaultValue": null- }- ],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Address",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "office",- "description": null,- "args": [- {- "name": "zipCode",- "description": null,- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "ID",- "ofType": null- }- }- }- }- }- },- "defaultValue": null- },- {- "name": "cityID",- "description": null,- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "ENUM",- "name": "CityID",- "ofType": null- }- },- "defaultValue": null- }- ],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "Address",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "myUnion",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "UNION",- "name": "MyUnion",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "home",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "ENUM",- "name": "CityID",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__Directive",- "description": "",- "fields": [- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "description",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "locations",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "ENUM",- "name": "__DirectiveLocation",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "args",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__InputValue",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__EnumValue",- "description": "",- "fields": [- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "description",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "isDeprecated",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Boolean",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "deprecationReason",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__InputValue",- "description": "",- "fields": [- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "description",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "type",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "defaultValue",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__Field",- "description": "",- "fields": [- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "String",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "description",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "args",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__InputValue",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "type",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "isDeprecated",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "SCALAR",- "name": "Boolean",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "deprecationReason",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__Type",- "description": "",- "fields": [- {- "name": "kind",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "ENUM",- "name": "__TypeKind",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "name",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "description",- "description": null,- "args": [],- "type": {- "kind": "SCALAR",- "name": "String",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "fields",- "description": null,- "args": [- {- "name": "includeDeprecated",- "description": null,- "type": {- "kind": "SCALAR",- "name": "Boolean",- "ofType": null- },- "defaultValue": null- }- ],- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Field",- "ofType": null- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "interfaces",- "description": null,- "args": [],- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "possibleTypes",- "description": null,- "args": [],- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "enumValues",- "description": null,- "args": [- {- "name": "includeDeprecated",- "description": null,- "type": {- "kind": "SCALAR",- "name": "Boolean",- "ofType": null- },- "defaultValue": null- }- ],- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__EnumValue",- "ofType": null- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "inputFields",- "description": null,- "args": [],- "type": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__InputValue",- "ofType": null- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "ofType",- "description": null,- "args": [],- "type": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "OBJECT",- "name": "__Schema",- "description": "",- "fields": [- {- "name": "types",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "queryType",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- }- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "mutationType",- "description": null,- "args": [],- "type": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "subscriptionType",- "description": null,- "args": [],- "type": {- "kind": "OBJECT",- "name": "__Type",- "ofType": null- },- "isDeprecated": false,- "deprecationReason": null- },- {- "name": "directives",- "description": null,- "args": [],- "type": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "LIST",- "name": null,- "ofType": {- "kind": "NON_NULL",- "name": null,- "ofType": {- "kind": "OBJECT",- "name": "__Directive",- "ofType": null- }- }- }- },- "isDeprecated": false,- "deprecationReason": null- }- ],- "inputFields": null,- "interfaces": [],- "enumValues": null,- "possibleTypes": null- },- {- "kind": "UNION",- "name": "MyUnion",- "description": "",- "fields": null,- "inputFields": null,- "interfaces": null,- "enumValues": null,- "possibleTypes": [- {- "kind": "OBJECT",- "name": "User",- "ofType": null- },- {- "kind": "OBJECT",- "name": "Address",- "ofType": null- }- ]- }- ],- "directives": []- }- }-}
− assets/mut.gql
@@ -1,40 +0,0 @@-type Query {- deity (name: [[[[[String!]]!]]], mythology: String): Deity!- character (characterID: String! , age: Int ): Character!- hero: Human!-}--type Mutation {- createDeity (deityName: [[[[[String!]]!]]], deityMythology: String): Deity!- createCharacter (charRealm: Realm! , charMutID: String! ): Character!-}--union Character = Creature | Deity | Human--type Deity {- fullName: String!- power: Power!-}--type Creature {- creatureName: String!- realm: City!-}--type Human {- humanName: String!- profession: String-}--input Realm {- owner: String!- place: Int-}--enum City {- Athens- Ithaca- Sparta Troy-}--scalar Power
− assets/pubsub.gql
@@ -1,46 +0,0 @@-type Query {- deity (name: [[[[[String!]]!]]], mythology: String): Deity!- character (characterID: String! , age: Int ): Character!- hero: Human!-}--type Mutation {- createDeity (deityName: [[[[[String!]]!]]], deityMythology: String): Deity!- createCharacter (charRealm: Realm! , charMutID: String! ): Character!-}--type Subscription {- newDeity : Deity!- newCharacter : Character!-}---union Character = Creature | Deity | Human--type Deity {- fullName: String!- power: Power!-}--type Creature {- creatureName: String!- realm: City!-}--type Human {- humanName: String!- profession: String-}--input Realm {- owner: String!- place: Int-}--enum City {- Athens- Ithaca- Sparta Troy-}--scalar Power
− assets/simple.gql
@@ -1,88 +0,0 @@-"""-my interface description-"""-type Query {- deity (name: [[[[[String!]]!]]], mythology: Realm): Deity!- character (characterID: String! , age: Int ): Character!- hero: Human!-}--"""-my interface description-"""-interface MyInterface {- """- interface field description- """- name: String-}---type Mutation {- createDeity (name: [[[[[String!]]!]]], mythology: String): Deity!- createCharacter (realm: Realm! , id: String! ): Character!-}--"""-my unon description-"""-union Character = Creature | Deity | Human--"my mutation description"-type Deity {- fullName: String!- power: Power-}--"""-my mutation description-some creature-"""-type Creature {- name: String!- realm: City!- immortality: Boolean!-}--"""-human--ewrw-"""-type Human {- humanName: String!- lifetime: Lifetime!- profession: Profession-}---enum Profession {- Priest- Farmer- Artist-}--"""-human-ew jso-ewrw-"""-input Realm {- owner: String!- age: Int- realm: Realm- profession: Profession-}--"ancient city"-enum City {- Athens- Ithaca- Sparta Troy-}--""" lifespan of mortal creatures """-scalar Lifetime---scalar Power
changelog.md view
@@ -1,3 +1,22 @@+## [0.6.0] - *.11.2019++### Removed++- removed `morpheus` cli for code generating, if you need cli you should use +[morpheus-graphql-cli](https://github.com/morpheusgraphql/morpheus-graphql-cli/)++- example `API` executable is removed from Production build++## Added++- helper functions: `liftEitherM` , `liftM`++ ```haskell+ liftM :: m a -> Resolver o m e a+ liftEitherM :: m (Either String a) -> Resolver o m e a+ ```++ ## [0.5.0] - 31.10.2019 ### Added
− examples/Client/Client.hs
@@ -1,99 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE QuasiQuotes #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--module Client.Client- ( fetchHero- , fetUser- ) where--import Data.ByteString.Lazy.Char8 (ByteString)-import Data.Morpheus.Client (Fetch (..), defineByDocumentFile, defineByIntrospectionFile, gql)-import Data.Morpheus.Types (ScalarValue (..))-import Data.Text (Text)--defineByIntrospectionFile- "./assets/introspection.json"- [gql|- - # Query Hero with Compile time Validation- query GetUser ($coordinates: Coordinates!)- {- myUser: user {- boo3: name- myUserEmail: email- address (coordinates: $coordinates ){- city- }- customAdress: address (coordinates: $coordinates ){- customCity: city- }- }- user {- email- }- }- |]---defineByDocumentFile- "./assets/simple.gql"- [gql|- # Query Hero with Compile time Validation- query GetHero ($god: Realm, $id: String!)- {- deity (mythology:$god) {- power- fullName- }- character(characterID: $id ) {- ...on Creature {- name- immortality- }- ...on Human {- lifetime- profession- }- }- char2: character(characterID: $id ) {- ...on Creature {- cName: name- }- ...on Human {- lTime: lifetime- prof: profession- }- }- }- |]---ioRes :: ByteString -> IO ByteString-ioRes req = do- print req- return- "{\"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- { 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 {getUserArgsCoordinates = Coordinates {coordinatesLongitude = [], coordinatesLatitude = String "1"}}
− examples/Files.hs
@@ -1,12 +0,0 @@-module Files- ( getJson- ) where--import Data.Aeson (FromJSON, eitherDecode)-import qualified Data.ByteString.Lazy as L (readFile)--jsonPath :: String -> String-jsonPath name = "examples/db/" ++ name ++ ".json"--getJson :: FromJSON a => FilePath -> IO (Either String a)-getJson path = eitherDecode <$> L.readFile (jsonPath path)
− examples/Main.hs
@@ -1,45 +0,0 @@-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}--module Main- ( main- ) where--import Client.Client (fetUser, fetchHero)-import Control.Monad.IO.Class (liftIO)-import Data.Functor.Identity (Identity (..))-import Data.Morpheus (Interpreter (..))-import Data.Morpheus.Document (toGraphQLDocument)-import Data.Morpheus.Server (GQLState, gqlSocketApp, initGQLState)-import Mythology.API (mythologyApi)-import qualified Network.Wai as Wai-import qualified Network.Wai.Handler.Warp as Warp-import qualified Network.Wai.Handler.WebSockets as WaiWs-import Network.WebSockets (defaultConnectionOptions)-import Sophisticated.API (APIEvent, gqlRoot)-import TH.Simple (thSimpleApi)-import Web.Scotty (body, file, get, post, raw, scottyApp)--main :: IO ()-main = do- state <- initGQLState- httpApp <- httpServer state- fetchHero >>= print- fetUser (interpreter gqlRoot state) >>= print- Warp.runSettings settings $ WaiWs.websocketsOr defaultConnectionOptions (wsApp state) httpApp- where- settings = Warp.setPort 3000 Warp.defaultSettings- wsApp = gqlSocketApp gqlRoot- httpServer :: GQLState IO APIEvent -> IO Wai.Application- httpServer state =- scottyApp $ do- post "/" $ raw =<< (liftIO . interpreter gqlRoot state =<< body)- get "/" $ file "examples/index.html"- get "/schema.gql" $ raw $ toGraphQLDocument $ Identity gqlRoot- post "/mythology" $ raw =<< (liftIO . mythologyApi =<< body)- get "/mythology" $ file "examples/index.html"- post "/th" $ raw =<< (liftIO . thSimpleApi =<< body)- get "/th" $ file "examples/index.html"
− examples/Mythology/API.hs
@@ -1,37 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}--module Mythology.API- ( mythologyApi- ) where--import Control.Monad.Except (ExceptT (..))-import qualified Data.ByteString.Lazy.Char8 as B-import Data.Morpheus (interpreter)-import Data.Morpheus.Types (Resolver (..), IORes, GQLRootResolver (..), GQLType, Undefined (..))-import Data.Text (Text)-import GHC.Generics (Generic)-import Mythology.Character.Deity (Deity (..), dbDeity)--newtype Query m = Query- { deity :: DeityArgs -> m Deity- } deriving (Generic, GQLType)--data DeityArgs = DeityArgs- { name :: Text -- Required Argument- , mythology :: Maybe Text -- Optional Argument- } deriving (Generic)--resolveDeity :: DeityArgs -> IORes e Deity-resolveDeity args = QueryResolver $ ExceptT $ dbDeity (name args) (mythology args)--rootResolver :: GQLRootResolver IO () Query Undefined Undefined-rootResolver =- GQLRootResolver- { queryResolver = Query {deity = resolveDeity}- , mutationResolver = Undefined- , subscriptionResolver = Undefined- }--mythologyApi :: B.ByteString -> IO B.ByteString-mythologyApi = interpreter rootResolver
− examples/Mythology/Character/Deity.hs
@@ -1,28 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--module Mythology.Character.Deity- ( Deity(..)- , dbDeity- ) where--import Data.Morpheus.Kind (OBJECT)-import Data.Morpheus.Types (GQLType (..))-import Data.Text (Text)-import GHC.Generics (Generic)-import Mythology.Place.Places (Realm (..))--data Deity = Deity- { fullName :: Text -- Non-Nullable Field- , power :: Maybe Text -- Nullable Field- , realm :: Realm- } deriving (Generic)--instance GQLType Deity where- type KIND Deity = OBJECT- description _ = Just "Custom Description for Client Defined User Type"--dbDeity :: Text -> Maybe Text -> IO (Either String Deity)-dbDeity _ _ = return $ Right $ Deity {fullName = "Morpheus", power = Just "Shapeshifting", realm = Dream}
− examples/Mythology/Character/Human.hs
@@ -1,21 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE TypeOperators #-}--module Mythology.Character.Human- ( Human(..)- ) where--import Data.Morpheus.Kind (OBJECT)-import Data.Morpheus.Types (GQLType (..))-import Data.Text (Text)-import GHC.Generics (Generic)-import Mythology.Place.Places (City (..))--data Human = Human- { name :: Text- , home :: City- } deriving (Generic)--instance GQLType Human where- type KIND Human = OBJECT
− examples/Mythology/Place/Places.hs
@@ -1,34 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE TypeFamilies #-}--module Mythology.Place.Places- ( Realm(..)- , City(..)- ) where--import Data.Morpheus.Kind (ENUM)-import Data.Morpheus.Types (GQLType (..))-import GHC.Generics (Generic)--data Realm- = MountOlympus- | Sky- | Sea- | Underworld- | Dream- deriving (Generic)--instance GQLType Realm where- type KIND Realm = ENUM--data City- = Athens- | Colchis- | Delphi- | Ithaca- | Sparta- | Troy--instance GQLType City where- type KIND City = ENUM
− examples/Sophisticated/API.hs
@@ -1,136 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DerivingStrategies #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--module Sophisticated.API- ( gqlRoot- , APIEvent- ) where--import Data.Map (Map)-import qualified Data.Map as M (fromList)-import Data.Set (Set)-import qualified Data.Set as S (fromList)-import Data.Text (Text, pack)-import Data.Typeable (Typeable)-import GHC.Generics (Generic)---- MORPHEUS-import Data.Morpheus.Document (importGQLDocumentWithNamespace)-import Data.Morpheus.Kind (INPUT_UNION, OBJECT, SCALAR)-import Data.Morpheus.Types (Event (..), GQLRootResolver (..), GQLScalar (..), GQLType (..), ID, QUERY,- Resolver (..), ScalarValue (..), constRes)---$(importGQLDocumentWithNamespace "examples/Sophisticated/api.gql")--type AIntText = A (Int, Text)--type AText = A Text--type SetInt = Set Int--type MapTextInt = Map Text Int--data Animal- = CAT Cat- | DOG Dog- | BIRD Bird- deriving (Show, Generic)--instance GQLType Animal where- type KIND Animal = INPUT_UNION--data Euro =- Euro Int- Int- deriving (Show, Generic)--instance GQLType Euro where- type KIND Euro = SCALAR--instance GQLScalar Euro where- parseValue _ = pure (Euro 1 0)- serialize (Euro x y) = Int (x * 100 + y)--instance Typeable a => GQLType (A a) where- type KIND (A a) = OBJECT--newtype A a = A- { wrappedA :: a- } deriving (Generic)--data Channel- = UPDATE_USER- | UPDATE_ADDRESS- deriving (Show, Eq, Ord)--data Content = Update- { contentID :: Int- , contentMessage :: Text- }--type APIEvent = (Event Channel Content)---gqlRoot :: GQLRootResolver IO APIEvent Query Mutation Subscription-gqlRoot = GQLRootResolver {queryResolver, mutationResolver, subscriptionResolver}- where- queryResolver = Query- { queryUser = const fetchUser- , queryAnimal = \QueryAnimalArgs {queryAnimalArgsAnimal} -> pure (pack $ show queryAnimalArgsAnimal)- , querySet = constRes $ S.fromList [1, 2]- , queryMap = constRes $ M.fromList [("robin", 1), ("carl", 2)]- , queryWrapped1 = constRes $ A (0, "")- , queryWrapped2 = constRes $ A ""- }- -------------------------------------------------------------- mutationResolver = Mutation { mutationCreateUser , mutationCreateAddress }- where- mutationCreateUser _ =- MutResolver- [Event [UPDATE_USER] (Update {contentID = 12, contentMessage = "some message for user"})]- (pure User- { userName = constRes "George"- , userEmail = constRes "George@email.com"- , userAddress = constRes mutationAddress- , userOffice = constRes Nothing- , userHome = constRes HH- , userEntity = constRes Nothing- })- -------------------------- mutationCreateAddress _ =- MutResolver- [Event [UPDATE_ADDRESS] (Update {contentID = 10, contentMessage = "message for address"})] (pure mutationAddress)- ----------------------------------------------------------------- subscriptionResolver = Subscription {subscriptionNewAddress, subscriptionNewUser}- where- subscriptionNewUser () = SubResolver [UPDATE_USER] subResolver- where- subResolver (Event _ Update {}) = fetchUser- subscriptionNewAddress () = SubResolver [UPDATE_ADDRESS] subResolver- where- subResolver (Event _ Update {contentID}) = fetchAddress- ----------------------------------------------------------------------------------------------- fetchAddress = pure Address {addressCity = constRes "", addressStreet = constRes "", addressHouseNumber = constRes 0}- fetchUser :: Resolver QUERY IO (Event Channel Content) (User (Resolver QUERY IO (Event Channel Content)))- fetchUser = pure User { userName = constRes "George"- , userEmail = constRes "George@email.com"- , userAddress = const fetchAddress- , userOffice = constRes Nothing- , userHome = constRes HH- , userEntity = constRes Nothing- }- mutationAddress = Address {- addressCity = constRes "",- addressStreet = constRes "",- addressHouseNumber = constRes 0- }
− examples/Sophisticated/Model.hs
@@ -1,33 +0,0 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE TypeOperators #-}--module Sophisticated.Model- ( jsonAddress- , jsonUser- , JSONUser(..)- , JSONAddress(..)- ) where--import Data.Aeson (FromJSON)-import Data.Text (Text)-import Files (getJson)-import GHC.Generics (Generic)--data JSONUser = JSONUser- { name :: Text- , email :: Text- } deriving (Show, Generic, FromJSON)--data JSONAddress = JSONAddress- { city :: Text- , street :: Text- , houseNumber :: Int- } deriving (Generic, Show, FromJSON)--jsonUser :: IO (Either String JSONUser)-jsonUser = getJson "deprecated/user"--jsonAddress :: IO (Either String JSONAddress)-jsonAddress = getJson "deprecated/address"
− examples/Sophisticated/api.gql
@@ -1,94 +0,0 @@-# for Input Union--input Cat @testDir {- name: String!-}--input Dog {- name: String! @testDirective(testName:"")-}--input Bird {- name: String!-}--# Main APi--enum CityID @enumDir {- """- temporary multiline Test for Enum field descripions-- """- Paris- BLN @testDirective(testName:"")- "temporary singleline Test for Enum field descripions"- HH @enumFieldDir-}--input Coordinates {- latitude: Euro! @testDirective(testName:"")- "temporary singleline Test for input object field descripions"- longitude: [[[UniqueID!]!]]!-}--input UniqueID {- """- temporary multiline Test for Enum field descripions-- """- type: String = "test default value"- id: String!-}--type Address @typeDirective(id:1) {- """- temporary multiline Test for Enum field descripions-- """- city: String! @deprecated(testName:"",testName2: 123)- street: String!- "temporary singleline Test for input object field descripions"- houseNumber: Int!-}--"""-my custom description for user-"""-type User {- name: String!- email: String!- address(- """- temporary multiline Test for- arguments- descripions- """- coordinates: Coordinates! @argsDirective(id:1) ,- "temporary singleline Test for input object field descripions"- comment: String = "test default value"- ): Address!- home: CityID!- office(zipCode: [[[ID!]]!], id: CityID!): Address- entity: MyUnion-}--union MyUnion = User | Address--type Query {- user: User!- animal(animal: Animal): String!- wrapped1(type: UniqueID): AIntText!- wrapped2: AText!- set: SetInt!- map: MapTextInt!-}--type Mutation {- createUser: User!- createAddress: Address!-}--type Subscription {- newAddress: Address!- newUser: User!-}
− examples/Subscription/SimpleSubscription.hs
@@ -1,67 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE KindSignatures #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Subscription.SimpleSubscription where--import Data.Morpheus.Types (Event (..), Resolver (..), GQLRootResolver (..))-import Data.Text (Text)-import GHC.Generics (Generic)-import Mythology.Character.Deity (Deity (..))-import Mythology.Place.Places (Realm (..))---- TODO: importGQLDocument "examples/Subscription/api.gql"----data Channel- = ChannelA- | ChannelB--data Content- = ContentA Int- | ContentB Text--type MyEvent = Event Channel Content--newtype Query m = Query- { deity :: () -> m Deity- } deriving (Generic)--newtype Mutation m = Mutation- { createDeity :: () -> m Deity- } deriving (Generic)--newtype Subscription (m :: * -> * ) = Subscription- { newDeity :: () -> m Deity- } deriving (Generic)--type APIEvent = Event Channel Content--rootResolver :: GQLRootResolver IO APIEvent Query Mutation Subscription-rootResolver =- GQLRootResolver- { queryResolver = Query {deity = const fetchDeity}- , mutationResolver = Mutation {createDeity}- , subscriptionResolver = Subscription {newDeity}- }- where- -- TODO: resolver $ dbDeity "" Nothing- createDeity _args = MutResolver [Event {channels = [ChannelA], content = ContentA 1}]- (pure Deity {- fullName = ""- , power = Nothing- , realm = Sky- })- newDeity _args = SubResolver [ChannelA] subResolver- where- subResolver (Event [ChannelA] (ContentA _value)) = fetchDeity -- resolve New State- subResolver (Event [ChannelA] (ContentB _value)) = fetchDeity -- resolve New State- subResolver _ = fetchDeity -- Resolve Old State- ---------------------------------------------------------- fetchDeity = pure Deity {- fullName = ""- , power = Nothing- , realm = Sky- }
− examples/Subscription/api.gql
@@ -1,11 +0,0 @@-type Query {- deity: Deity-}--type Mutation {- createDeity: Deity-}--type Subscription {- newDeity: Deity-}
− examples/TH/Simple.hs
@@ -1,39 +0,0 @@-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeFamilies #-}--module TH.Simple- ( thSimpleApi- ) where--import qualified Data.ByteString.Lazy.Char8 as B--import Data.Morpheus (interpreter)-import Data.Morpheus.Document (importGQLDocumentWithNamespace)-import Data.Morpheus.Types (GQLRootResolver (..), Undefined (..))-import Data.Text (Text)--importGQLDocumentWithNamespace "examples/TH/simple.gql"--rootResolver :: GQLRootResolver IO () Query Undefined Undefined-rootResolver =- GQLRootResolver- {- queryResolver = Query {queryDeity},- mutationResolver = Undefined,- subscriptionResolver = Undefined- }- where- queryDeity QueryDeityArgs {queryDeityArgsName} = pure Deity {deityName, deityPower}- where- deityName _ = pure "Morpheus"- deityPower _ = pure (Just "Shapeshifting")--thSimpleApi :: B.ByteString -> IO B.ByteString-thSimpleApi = interpreter rootResolver
− examples/TH/simple.gql
@@ -1,8 +0,0 @@-type Query {- deity(name: String!): Deity!-}--type Deity {- name: String!- power: String-}
morpheus-graphql.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 4915b5eb44b1d86031d2ea36b172b06b8f2e91862755d5e1df90e3d17542368c+-- hash: 31270ea6ec92f02d87e2706e3e58eb784159f13809d7558c20c648f62557da8e name: morpheus-graphql-version: 0.5.0+version: 0.6.0 synopsis: Morpheus GraphQL description: Build GraphQL APIs with your favourite functional language! category: web, graphql@@ -16,19 +16,12 @@ author: Daviti Nalchevanidze maintainer: d.nalchevanidze@gmail.com copyright: (c) 2019 Daviti Nalchevanidze-license: BSD3+license: MIT license-file: LICENSE build-type: Simple extra-source-files: changelog.md README.md- examples/Sophisticated/api.gql- examples/Subscription/api.gql- examples/TH/simple.gql- assets/introspection.json- assets/mut.gql- assets/pubsub.gql- assets/simple.gql data-files: test/Feature/Holistic/API.gql test/Feature/Holistic/arguments/nameConflict/query.gql@@ -300,7 +293,6 @@ Data.Morpheus.Parsing.Request.Parser Data.Morpheus.Parsing.Request.Selection Data.Morpheus.Rendering.Haskell.Render- Data.Morpheus.Rendering.Haskell.RenderHS Data.Morpheus.Rendering.Haskell.Terms Data.Morpheus.Rendering.Haskell.Types Data.Morpheus.Rendering.Haskell.Values@@ -346,81 +338,15 @@ , bytestring >=0.10.4 && <0.11 , containers >=0.4.2.1 && <0.7 , megaparsec >=7.0.0 && <8.0- , mtl >=2.0 && <=2.2.2+ , mtl >=2.0 && <=2.3 , scientific >=0.3.6.2 && <0.4- , template-haskell+ , template-haskell >=2.0 && <=2.14.0.0 , text >=1.2.3.0 && <1.3 , transformers >=0.3.0.0 && <0.6 , unordered-containers >=0.2.8.0 && <0.3 , uuid >=1.0 && <=1.4 , vector >=0.12.0.1 && <0.13- , websockets >=0.11.0 && <=0.12.5.3- default-language: Haskell2010--executable api- main-is: Main.hs- other-modules:- Client.Client- Files- Mythology.API- Mythology.Character.Deity- Mythology.Character.Human- Mythology.Place.Places- Sophisticated.API- Sophisticated.Model- Subscription.SimpleSubscription- TH.Simple- Paths_morpheus_graphql- hs-source-dirs:- examples- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall- build-depends:- aeson- , base >=4.7 && <5- , bytestring- , containers >=0.4.2.1 && <0.7- , megaparsec >=7.0.0 && <8.0- , morpheus-graphql- , mtl- , scientific >=0.3.6.2 && <0.4- , scotty- , template-haskell- , text- , transformers >=0.3.0.0 && <0.6- , unordered-containers >=0.2.8.0 && <0.3- , uuid >=1.0 && <=1.4- , vector >=0.12.0.1 && <0.13- , wai- , wai-websockets >=1.0 && <=3.5- , warp- , websockets >=0.11.0 && <=0.12.5.3- default-language: Haskell2010--executable morpheus- main-is: Main.hs- other-modules:- Paths_morpheus_graphql- hs-source-dirs:- CLI- ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall- build-depends:- aeson- , base >=4.7 && <5- , bytestring- , containers >=0.4.2.1 && <0.7- , filepath >=1.1 && <1.5- , megaparsec >=7.0.0 && <8.0- , morpheus-graphql- , mtl- , optparse-applicative >=0.12 && <0.15- , scientific >=0.3.6.2 && <0.4- , template-haskell- , text- , transformers >=0.3.0.0 && <0.6- , unordered-containers >=0.2.8.0 && <0.3- , uuid >=1.0 && <=1.4- , vector >=0.12.0.1 && <0.13- , websockets >=0.11.0 && <=0.12.5.3+ , websockets >=0.11.0 && <=0.13 default-language: Haskell2010 test-suite morpheus-test@@ -449,15 +375,15 @@ , containers >=0.4.2.1 && <0.7 , megaparsec >=7.0.0 && <8.0 , morpheus-graphql- , mtl >=2.0 && <=2.2.2+ , mtl >=2.0 && <=2.3 , scientific >=0.3.6.2 && <0.4 , tasty , tasty-hunit- , template-haskell+ , template-haskell >=2.0 && <=2.14.0.0 , text >=1.2.3.0 && <1.3 , transformers >=0.3.0.0 && <0.6 , unordered-containers >=0.2.8.0 && <0.3 , uuid >=1.0 && <=1.4 , vector >=0.12.0.1 && <0.13- , websockets >=0.11.0 && <=0.12.5.3+ , websockets >=0.11.0 && <=0.13 default-language: Haskell2010
src/Data/Morpheus/Error/Internal.hs view
@@ -5,7 +5,6 @@ , internalArgumentError , internalUnknownTypeMessage , internalError- , internalErrorT ) where import Data.Text (Text)@@ -13,7 +12,6 @@ -- MORPHEUS import Data.Morpheus.Error.Utils (globalErrorMessage)-import Data.Morpheus.Types.Internal.Resolver (ResolveT, failResolveT) import Data.Morpheus.Types.Internal.Validation (GQLErrors) import Data.Morpheus.Types.Internal.Value (Value (..)) @@ -22,10 +20,6 @@ -- all kind internal error in development internalError :: Text -> Either GQLErrors b internalError x = Left $ globalErrorMessage $ T.concat ["INTERNAL ERROR: ", x]--internalErrorT :: Monad m => Text -> ResolveT m b-internalErrorT x =- failResolveT $ globalErrorMessage $ T.concat ["INTERNAL ERROR: ", x] -- if type did not not found, but was defined by Schema internalUnknownTypeMessage :: Text -> GQLErrors
src/Data/Morpheus/Execution/Client/Fetch.hs view
@@ -16,12 +16,13 @@ import Data.Text (pack) import Language.Haskell.TH -import qualified Data.Aeson as A-import qualified Data.Aeson.Types as A +import qualified Data.Aeson as A+import qualified Data.Aeson.Types as A+ -- -- MORPHEUS-import Data.Morpheus.Types.Internal.TH (instanceHeadT)+import Data.Morpheus.Types.Internal.TH (instanceHeadT, typeInstanceDec) import Data.Morpheus.Types.IO (GQLRequest (..), JSONResponse (..)) fixVars :: A.Value -> Maybe A.Value@@ -42,15 +43,15 @@ where gqlReq = GQLRequest {operationName = Just (pack opName), query = pack strQuery, variables = fixVars (toJSON vars)} -------------------------------------------------------------- processResponse JSONResponse {responseData = Just x} = pure x- processResponse invalidResponse = fail $ show invalidResponse+ processResponse JSONResponse {responseData = Just x} = Right x+ processResponse invalidResponse = Left (show invalidResponse) fetch :: (Monad m, FromJSON a) => (ByteString -> m ByteString) -> Args a -> m (Either String a) deriveFetch :: Type -> String -> String -> Q [Dec]-deriveFetch argDatatype typeName query = pure <$> instanceD (cxt []) iHead methods+deriveFetch resultType typeName query = pure <$> instanceD (cxt []) iHead methods where iHead = instanceHeadT ''Fetch typeName [] methods = [ funD 'fetch [clause [] (normalB [|__fetch query typeName|]) []]- , pure $ TySynInstD ''Args (TySynEqn [ConT $ mkName typeName] argDatatype)+ , pure $ typeInstanceDec ''Args (ConT $ mkName typeName) resultType ]
src/Data/Morpheus/Execution/Client/Selection.hs view
@@ -20,9 +20,9 @@ Variable (..), VariableDefinitions, getOperationName) import Data.Morpheus.Types.Internal.AST.Selection (Selection (..), SelectionRec (..), SelectionSet, ValidSelection)-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataLeaf (..),- DataTyCon (..), DataTypeKind (..), DataTypeLib (..),- Key, TypeAlias (..), allDataTypes)+import Data.Morpheus.Types.Internal.Data (DataField (..), DataType (..), 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)@@ -43,7 +43,7 @@ inputTypesAndEnums <- buildListedTypes (inputTypeRequests <> enums) pure (rootArguments (getOperationName operationName <> "Args"), queryTypes <> inputTypesAndEnums) where- queryDataType = OutputObject $ snd $ query lib+ queryDataType = DataObject $ snd $ query lib ------------------------------------------------------------------------- buildListedTypes = fmap concat . traverse (buildInputType lib) . removeDuplicates -------------------------------------------------------------------------@@ -74,7 +74,7 @@ } --------------------------------------------------------- -- generates selection Object Types- genRecordType :: [Key] -> Key -> DataFullType -> SelectionSet -> Validation ([GQLTypeD], [Text])+ genRecordType :: [Key] -> Key -> DataType -> SelectionSet -> Validation ([GQLTypeD], [Text]) genRecordType path name dataType recordSelSet = do (con, subTypes, requests) <- genConsD (unpack name) dataType recordSelSet pure@@ -87,7 +87,7 @@ , requests) where tName = unpack name- genConsD :: String -> DataFullType -> SelectionSet -> Validation (ConsD, [GQLTypeD], [Text])+ genConsD :: String -> DataType -> SelectionSet -> Validation (ConsD, [GQLTypeD], [Text]) genConsD cName datatype selSet = do cFields <- traverse genField selSet (subTypes, requests) <- newFieldTypes datatype selSet@@ -106,7 +106,7 @@ fieldType <- snd <$> lookupFieldType lib fieldPath datatype fieldName pure $ DataField {fieldName, fieldArgs = [], fieldArgsType = Nothing, fieldType, fieldHidden = False} ------------------------------------------------------------------------------------------------------------- newFieldTypes :: DataFullType -> SelectionSet -> Validation ([[GQLTypeD]], [[Text]])+ newFieldTypes :: DataType -> SelectionSet -> Validation ([[GQLTypeD]], [[Text]]) newFieldTypes parentType seSet = unzip <$> mapM valSelection seSet where valSelection (key, selection@Selection { selectionAlias }) = do@@ -116,10 +116,8 @@ where fieldPath = path <> [fromMaybe key selectionAlias] --------------------------------------------------------------------- validateSelection :: DataFullType -> ValidSelection -> Validation ([GQLTypeD], [Text])- validateSelection dType Selection {selectionRec = SelectionField} = do- lName <- withLeaf (pure . leafName) dType- pure ([], lName)+ validateSelection :: DataType -> ValidSelection -> Validation ([GQLTypeD], [Text])+ validateSelection dType Selection {selectionRec = SelectionField} = leafType dType --withLeaf buildLeaf dType validateSelection dType Selection {selectionRec = SelectionSet selectionSet} = genRecordType fieldPath (typeFrom [] dType) dType selectionSet@@ -145,17 +143,17 @@ | name `elem` collected = pure collected | otherwise = getType lib name >>= scanType where- scanType (InputObject DataTyCon {typeData}) = resolveUpdates (name : collected) (map toInputTypeD typeData)+ scanType (DataInputObject 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 (DataEnum DataTyCon {typeName}) = pure (collected <> [typeName]) scanType _ = pure collected buildInputType :: DataTypeLib -> Text -> Validation [GQLTypeD] buildInputType lib name = getType lib name >>= subTypes where- subTypes (InputObject DataTyCon {typeName, typeData}) = do+ subTypes (DataInputObject DataTyCon {typeName, typeData}) = do fields <- traverse toFieldD typeData pure [ GQLTypeD@@ -175,7 +173,7 @@ toFieldD (_, field@DataField {fieldType}) = do aliasTyCon <- typeFrom [] <$> getType lib (aliasTyCon fieldType) pure $ field {fieldType = fieldType {aliasTyCon}}- subTypes (Leaf (LeafEnum DataTyCon {typeName, typeData})) =+ subTypes (DataEnum DataTyCon {typeName, typeData}) = pure [ GQLTypeD { typeD = TypeD {tName = unpack typeName, tNamespace = [], tCons = map enumOption typeData}@@ -187,23 +185,21 @@ enumOption eName = ConsD {cName = unpack eName, cFields = []} subTypes _ = pure [] -lookupFieldType :: DataTypeLib -> [Key] -> DataFullType -> Text -> Validation (DataFullType, TypeAlias)-lookupFieldType lib path (OutputObject DataTyCon {typeData}) key =+lookupFieldType :: DataTypeLib -> [Key] -> DataType -> Text -> Validation (DataType, TypeAlias)+lookupFieldType lib path (DataObject 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 $ "cant find field \""<> key<>"\"") lookupFieldType _ _ dt _ = Left (compileError $ "Type should be output Object \"" <> pack (show dt)) -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 _ = []+leafType :: DataType -> Validation ([GQLTypeD], [Text])+leafType (DataEnum DataTyCon {typeName}) = pure ([],[typeName])+leafType DataScalar {} = pure ([],[])+leafType _ = Left $ compileError "Invalid schema Expected scalar" -getType :: DataTypeLib -> Text -> Validation DataFullType+getType :: DataTypeLib -> Text -> Validation DataType getType lib typename = lookupType (compileError typename) (allDataTypes lib) typename typeFromScalar :: Text -> Text@@ -214,11 +210,10 @@ typeFromScalar "ID" = "ID" typeFromScalar _ = "ScalarValue" -typeFrom :: [Key] -> DataFullType -> Text-typeFrom _ (Leaf (BaseScalar x)) = typeName x-typeFrom _ (Leaf (CustomScalar DataTyCon {typeName})) = typeFromScalar typeName-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+typeFrom :: [Key] -> DataType -> Text+typeFrom _ (DataScalar DataTyCon {typeName}) = typeFromScalar typeName+typeFrom _ (DataEnum x) = typeName x+typeFrom _ (DataInputObject x) = typeName x+typeFrom path (DataObject x) = pack $ nameSpaceType path $ typeName x+typeFrom path (DataUnion x) = pack $ nameSpaceType path $ typeName x+typeFrom _ (DataInputUnion x) = typeName x
src/Data/Morpheus/Execution/Document/Convert.hs view
@@ -15,17 +15,16 @@ -- MORPHEUS import Data.Morpheus.Error.Internal (internalError) import Data.Morpheus.Execution.Internal.Utils (capital)-import Data.Morpheus.Types.Internal.Data (ArgsType (..), DataField (..), DataField, DataFullType (..),- DataLeaf (..), DataTyCon (..), DataTypeKind (..),- DataTypeKind (..), OperationType (..), ResolverKind (..),- TypeAlias (..), sysTypes)+import Data.Morpheus.Types.Internal.Data (ArgsType (..), DataField (..), DataType (..),+ DataTyCon (..), DataTypeKind (..), OperationType (..),+ ResolverKind (..), TypeAlias (..), sysTypes) import Data.Morpheus.Types.Internal.DataD (ConsD (..), GQLTypeD (..), TypeD (..)) import Data.Morpheus.Types.Internal.Validation (Validation) -renderTHTypes :: Bool -> [(Text, DataFullType)] -> Validation [GQLTypeD]+renderTHTypes :: Bool -> [(Text, DataType)] -> Validation [GQLTypeD] renderTHTypes namespace lib = traverse renderTHType lib where- renderTHType :: (Text, DataFullType) -> Validation GQLTypeD+ renderTHType :: (Text, DataType) -> Validation GQLTypeD renderTHType (tyConName, x) = genType x where genArgsTypeName fieldName@@ -69,9 +68,9 @@ --------------------------------------- aliasArgs = case lookup aliasTyCon lib of- Just OutputObject {} -> Just "m"- Just Union {} -> Just "m"- _ -> Nothing+ Just DataObject {} -> Just "m"+ Just DataUnion {} -> Just "m"+ _ -> Nothing ----------------------------------- fieldArgsType = Just $ ArgsType {argsTypeName, resKind = getFieldType ftName} where@@ -81,12 +80,12 @@ -------------------------------------- getFieldType key = case lookup key lib of- Nothing -> ExternalResolver- Just OutputObject {} -> TypeVarResolver- Just Union {} -> TypeVarResolver- Just _ -> PlainResolver+ Nothing -> ExternalResolver+ Just DataObject {} -> TypeVarResolver+ Just DataUnion {} -> TypeVarResolver+ Just _ -> PlainResolver --------------------------------------------- genType (Leaf (LeafEnum DataTyCon {typeName, typeData})) =+ genType (DataEnum DataTyCon {typeName, typeData}) = pure GQLTypeD { typeD = TypeD {tName = sysName typeName, tNamespace = [], tCons = map enumOption typeData}@@ -95,9 +94,9 @@ } where enumOption name = ConsD {cName = sysName name, cFields = []}- genType (Leaf _) = internalError "Scalar Types should defined By Native Haskell Types"- genType (InputUnion _) = internalError "Input Unions not Supported"- genType (InputObject DataTyCon {typeName, typeData}) =+ genType (DataScalar _) = internalError "Scalar Types should defined By Native Haskell Types"+ genType (DataInputUnion _) = internalError "Input Unions not Supported"+ genType (DataInputObject DataTyCon {typeName, typeData}) = pure GQLTypeD { typeD =@@ -109,7 +108,7 @@ , typeKindD = KindInputObject , typeArgD = [] }- genType (OutputObject DataTyCon {typeName, typeData}) = do+ genType (DataObject DataTyCon {typeName, typeData}) = do typeArgD <- concat <$> traverse genArgumentType typeData pure GQLTypeD@@ -125,7 +124,7 @@ else KindObject Nothing , typeArgD }- genType (Union DataTyCon {typeName, typeData}) = do+ genType (DataUnion DataTyCon {typeName, typeData}) = do let tCons = map unionCon typeData pure GQLTypeD
src/Data/Morpheus/Execution/Document/GQLType.hs view
@@ -19,7 +19,7 @@ import Data.Morpheus.Types.GQLType (GQLType (..), TRUE) 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.Morpheus.Types.Internal.TH (instanceHeadT, typeT, typeInstanceDec) import Data.Typeable (Typeable) genTypeName :: String -> String@@ -27,6 +27,8 @@ | isSchemaTypeName (pack name) = name genTypeName name = name ++ deriveGQLType :: GQLTypeD -> Q [Dec] deriveGQLType GQLTypeD {typeD = TypeD {tName}, typeKindD} = pure <$> instanceD (cxt constrains) iHead (def__typeName : typeFamilies)@@ -54,11 +56,11 @@ where deriveCUSTOM = do typeN <- headSig- pure $ TySynInstD ''CUSTOM (TySynEqn [typeN] (ConT ''TRUE))+ pure $ typeInstanceDec ''CUSTOM typeN (ConT ''TRUE) --------------------------------------------------------------- deriveKind = do typeN <- headSig- pure $ TySynInstD ''KIND (TySynEqn [typeN] (ConT $ toKIND typeKindD))+ pure $ typeInstanceDec ''KIND typeN (ConT $ toKIND typeKindD) --------------------------------- toKIND KindScalar = ''SCALAR toKIND KindEnum = ''ENUM
src/Data/Morpheus/Execution/Internal/Declare.hs view
@@ -25,7 +25,7 @@ import Data.Morpheus.Types.Internal.DataD (ConsD (..), TypeD (..)) import Data.Morpheus.Types.Internal.Resolver (UnSubResolver) -type FUNC = (->)+type Arrow = (->) declareTypeAlias :: Bool -> TypeAlias -> Type declareTypeAlias isSub TypeAlias {aliasTyCon, aliasWrappers, aliasArgs} = wrappedT aliasWrappers@@ -73,7 +73,7 @@ genFieldT (Just ArgsType {argsTypeName}) = AppT (AppT arrowType argType) (fType True) where argType = ConT $ mkName (unpack argsTypeName)- arrowType = ConT ''FUNC+ arrowType = ConT ''Arrow ------------------------------------------------ fType isResolver | maybe False isSubscription kindD = AppT monadVar result
src/Data/Morpheus/Execution/Server/Introspect.hs view
@@ -39,11 +39,12 @@ import Data.Morpheus.Types.Custom (MapKind, Pair) import Data.Morpheus.Types.GQLScalar (GQLScalar (..)) import Data.Morpheus.Types.GQLType (GQLType (..))-import Data.Morpheus.Types.Internal.Data (DataArguments, DataField (..), DataFullType (..),- DataLeaf (..), DataTyCon (..), DataTypeLib,- TypeAlias (..), defineType, isTypeDefined,- toListField, toNullableField)+import Data.Morpheus.Types.Internal.Data (DataArguments, DataField (..), DataType (..),+ DataTyCon (..), DataTypeLib, TypeAlias (..),+ defineType, isTypeDefined, toListField,+ toNullableField) + type IntroCon a = (GQLType a, ObjectFields (CUSTOM a) a) -- | Generates internal GraphQL Schema for query validation and introspection rendering@@ -99,23 +100,23 @@ instance (GQLType a, GQLScalar a) => IntrospectKind SCALAR a where introspectKind _ = updateLib scalarType [] (Proxy @a) where- scalarType = Leaf . CustomScalar . buildType (scalarValidator (Proxy @a))+ scalarType = DataScalar . buildType (scalarValidator (Proxy @a)) -- ENUM instance (GQL_TYPE a, EnumRep (Rep a)) => IntrospectKind ENUM a where introspectKind _ = updateLib enumType [] (Proxy @a) where- enumType = Leaf . LeafEnum . buildType (enumTags (Proxy @(Rep a)))+ enumType = DataEnum . buildType (enumTags (Proxy @(Rep a))) -- INPUT_OBJECT instance (GQL_TYPE a, ObjectFields (CUSTOM a) a) => IntrospectKind INPUT_OBJECT a where- introspectKind _ = updateLib (InputObject . buildType fields) types (Proxy @a)+ introspectKind _ = updateLib (DataInputObject . buildType fields) types (Proxy @a) where (fields, types) = objectFields (Proxy @(CUSTOM a)) (Proxy @a) -- OBJECTS instance (GQL_TYPE a, ObjectFields (CUSTOM a) a) => IntrospectKind OBJECT a where- introspectKind _ = updateLib (OutputObject . buildType (__typename : fields)) types (Proxy @a)+ introspectKind _ = updateLib (DataObject . buildType (__typename : fields)) types (Proxy @a) where __typename = ( "__typename"@@ -130,19 +131,19 @@ -- UNION instance (GQL_TYPE a, GQLRep UNION (Rep a)) => IntrospectKind UNION a where- introspectKind _ = updateLib (Union . buildType fields) stack (Proxy @a)+ introspectKind _ = updateLib (DataUnion . buildType fields) stack (Proxy @a) where (fields, stack) = unzip $ gqlRep (Context :: Context UNION (Rep a)) -- INPUT_UNION instance (GQL_TYPE a, GQLRep UNION (Rep a)) => IntrospectKind INPUT_UNION a where- introspectKind _ = updateLib (InputUnion . buildType (fieldTag : fields)) (tagsEnumType : stack) (Proxy @a)+ introspectKind _ = updateLib (DataInputUnion . buildType (fieldTag : fields)) (tagsEnumType : stack) (Proxy @a) where (inputUnions, stack) = unzip $ gqlRep (Context :: Context UNION (Rep a)) fields = map toNullableField inputUnions -- for every input Union 'User' adds enum type of possible TypeNames 'UserTags' tagsEnumType :: TypeUpdater- tagsEnumType x = pure $ defineType (typeName, Leaf $ LeafEnum tagsEnum) x+ tagsEnumType x = pure $ defineType (typeName, DataEnum tagsEnum) x where tagsEnum = DataTyCon@@ -226,7 +227,7 @@ , typeData } -updateLib :: GQLType a => (Proxy a -> DataFullType) -> [TypeUpdater] -> Proxy a -> TypeUpdater+updateLib :: GQLType a => (Proxy a -> DataType) -> [TypeUpdater] -> Proxy a -> TypeUpdater updateLib typeBuilder stack proxy lib' = case isTypeDefined (__typeName proxy) lib' of Nothing -> resolveUpdates (defineType (__typeName proxy, typeBuilder proxy) lib') stack
src/Data/Morpheus/Parsing/Document/TypeSystem.hs view
@@ -15,9 +15,8 @@ typDeclaration) import Data.Morpheus.Parsing.Internal.Terms (keyword, operator, optDescription, parseName, pipeLiteral, sepByAnd, setOf)-import Data.Morpheus.Types.Internal.Data (DataField, DataFingerprint (..), DataFullType (..),- DataLeaf (..), DataTyCon (..), DataValidator (..), Key,- RawDataType (..))+import Data.Morpheus.Types.Internal.Data (DataField, DataFingerprint (..), DataType (..),+ DataTyCon (..), DataValidator (..), Key, RawDataType (..)) -- Scalars : https://graphql.github.io/graphql-spec/June2018/#sec-Scalars@@ -25,7 +24,7 @@ -- ScalarTypeDefinition: -- Description(opt) scalar Name Directives(Const)(opt) ---scalarTypeDefinition :: Maybe Text -> Parser (Text, DataFullType)+scalarTypeDefinition :: Maybe Text -> Parser (Text, DataType) scalarTypeDefinition typeDescription = label "ScalarTypeDefinition" $ do typeName <- typDeclaration "scalar"@@ -33,7 +32,7 @@ _ <- optionalDirectives pure ( typeName,- Leaf $ CustomScalar DataTyCon {+ DataScalar DataTyCon { typeName, typeDescription, typeFingerprint = SystemFingerprint typeName,@@ -111,7 +110,7 @@ -- = |(opt) NamedType -- UnionMemberTypes | NamedType ---unionTypeDefinition :: Maybe Text -> Parser (Text, DataFullType)+unionTypeDefinition :: Maybe Text -> Parser (Text, DataType) unionTypeDefinition typeDescription = label "UnionTypeDefinition" $ do typeName <- typDeclaration "union"@@ -120,7 +119,7 @@ memberTypes <- unionMemberTypes pure ( typeName,- Union DataTyCon {+ DataUnion DataTyCon { typeName, typeDescription, typeFingerprint = SystemFingerprint typeName,@@ -142,7 +141,7 @@ -- EnumValueDefinition -- Description(opt) EnumValue Directives(Const)(opt) ---enumTypeDefinition :: Maybe Text -> Parser (Text, DataFullType)+enumTypeDefinition :: Maybe Text -> Parser (Text, DataType) enumTypeDefinition typeDescription = label "EnumTypeDefinition" $ do typeName <- typDeclaration "enum"@@ -150,8 +149,8 @@ _directives <- optionalDirectives enumValuesDefinition <- setOf enumValueDefinition pure (- typeName,- Leaf $ LeafEnum DataTyCon {+ typeName,+ DataEnum DataTyCon { typeName, typeDescription, typeFingerprint = SystemFingerprint typeName,@@ -175,7 +174,7 @@ -- InputFieldsDefinition: -- { InputValueDefinition(list) } ---inputObjectTypeDefinition :: Maybe Text -> Parser (Text, DataFullType)+inputObjectTypeDefinition :: Maybe Text -> Parser (Text, DataType) inputObjectTypeDefinition typeDescription = label "InputObjectTypeDefinition" $ do typeName <- typDeclaration "input"@@ -185,7 +184,7 @@ pure ( typeName,- InputObject DataTyCon {+ DataInputObject DataTyCon { typeName, typeDescription, typeFingerprint = SystemFingerprint typeName,@@ -197,7 +196,7 @@ inputFieldsDefinition = label "InputFieldsDefinition" $ setOf inputValueDefinition -parseFinalDataType :: Maybe Text -> Parser (Text, DataFullType)+parseFinalDataType :: Maybe Text -> Parser (Text, DataType) parseFinalDataType description = label "TypeDefinition" $ inputObjectTypeDefinition description <|> unionTypeDefinition description
src/Data/Morpheus/Parsing/Internal/Create.hs view
@@ -11,12 +11,17 @@ , createDataTypeLib ) where -import Data.Morpheus.Types.Internal.Data (DataArguments, DataField (..), DataFingerprint (..),- DataFullType (..), DataLeaf (..), DataTyCon (..), DataTypeLib (..),- DataValidator (..), TypeAlias (..), WrapperD, defineType,- initTypeLib)-import Data.Text (Text)+import Data.Text (Text) +-- MORPHEUS+import Data.Morpheus.Error.Internal (internalError)+import Data.Morpheus.Types.Internal.Data (DataArguments, DataField (..), DataFingerprint (..),+ DataTyCon (..), DataType (..), DataTypeLib (..),+ DataValidator (..), TypeAlias (..), WrapperD, defineType,+ initTypeLib)+import Data.Morpheus.Types.Internal.Validation (Validation)++ createField :: DataArguments -> Text -> ([WrapperD], Text) -> DataField createField fieldArgs fieldName (aliasWrappers, aliasTyCon) = DataField@@ -34,18 +39,18 @@ createType typeName typeData = DataTyCon {typeName, typeDescription = Nothing, typeFingerprint = SystemFingerprint "", typeData} -createScalarType :: Text -> (Text, DataFullType)-createScalarType typeName = (typeName, Leaf $ CustomScalar $ createType typeName (DataValidator pure))+createScalarType :: Text -> (Text, DataType)+createScalarType typeName = (typeName, DataScalar $ createType typeName (DataValidator pure)) -createEnumType :: Text -> [Text] -> (Text, DataFullType)-createEnumType typeName typeData = (typeName, Leaf $ LeafEnum $ createType typeName typeData)+createEnumType :: Text -> [Text] -> (Text, DataType)+createEnumType typeName typeData = (typeName, DataEnum $ createType typeName typeData) -createUnionType :: Text -> [Text] -> (Text, DataFullType)-createUnionType typeName typeData = (typeName, Union $ createType typeName $ map unionField typeData)+createUnionType :: Text -> [Text] -> (Text, DataType)+createUnionType typeName typeData = (typeName, DataUnion $ createType typeName $ map unionField typeData) where unionField fieldType = createField [] "" ([], fieldType) -createDataTypeLib :: Monad m => [(Text, DataFullType)] -> m DataTypeLib+createDataTypeLib :: [(Text, DataType)] -> Validation DataTypeLib createDataTypeLib types = case takeByKey "Query" types of (Just query, lib1) ->@@ -53,10 +58,10 @@ (mutation, lib2) -> case takeByKey "Subscription" lib2 of (subscription, lib3) -> pure ((foldr defineType (initTypeLib query) lib3) {mutation, subscription})- _ -> fail "Query Not Defined"+ _ -> internalError "Query Not Defined" ---------------------------------------------------------------------------- where takeByKey key lib = case lookup key lib of- Just (OutputObject value) -> (Just (key, value), filter ((/= key) . fst) lib)- _ -> (Nothing, lib)+ Just (DataObject value) -> (Just (key, value), filter ((/= key) . fst) lib)+ _ -> (Nothing, lib)
src/Data/Morpheus/Parsing/JSONSchema/Parse.hs view
@@ -16,7 +16,7 @@ import Data.Morpheus.Parsing.JSONSchema.Types (EnumValue (..), Field (..), InputValue (..), Introspection (..), Schema (..), Type (..)) import Data.Morpheus.Schema.TypeKind (TypeKind (..))-import Data.Morpheus.Types.Internal.Data (DataField, DataFullType (..), DataTypeLib,+import Data.Morpheus.Types.Internal.Data (DataField, DataType (..), DataTypeLib, DataTypeWrapper (..), Key, WrapperD, toHSWrappers) import Data.Morpheus.Types.Internal.Validation (Validation) import Data.Morpheus.Types.IO (JSONResponse (..))@@ -29,7 +29,7 @@ Left errors -> internalError $ pack errors Right JSONResponse {responseData = Just Introspection {__schema = Schema {types}}} -> traverse parse types >>= createDataTypeLib- Right res -> fail $ show res+ Right res -> internalError (pack $ show res) where jsonSchema :: Either String (JSONResponse Introspection) jsonSchema = eitherDecode jsonDoc@@ -37,20 +37,20 @@ class ParseJSONSchema a b where parse :: a -> Validation (Key, b) -instance ParseJSONSchema Type DataFullType where+instance ParseJSONSchema Type DataType where parse Type {name = Just typeName, kind = SCALAR} = pure $ createScalarType typeName parse Type {name = Just typeName, kind = ENUM, enumValues = Just enums} = pure $ createEnumType typeName (map enumName enums) parse Type {name = Just typeName, kind = UNION, possibleTypes = Just unions} = case traverse name unions of- Nothing -> fail "ERROR: GQL ERROR"+ Nothing -> internalError "ERROR: GQL ERROR" Just uni -> pure $ createUnionType typeName uni parse Type {name = Just typeName, kind = INPUT_OBJECT, inputFields = Just iFields} = do fields <- traverse parse iFields- pure (typeName, InputObject $ createType typeName fields)+ pure (typeName, DataInputObject $ createType typeName fields) parse Type {name = Just typeName, kind = OBJECT, fields = Just oFields} = do fields <- traverse parse oFields- pure (typeName, OutputObject $ createType typeName fields)+ pure (typeName, DataObject $ createType typeName fields) parse x = internalError $ "Unsuported type" <> pack (show x) instance ParseJSONSchema Field DataField where
− src/Data/Morpheus/Rendering/Haskell/RenderHS.hs
@@ -1,35 +0,0 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeSynonymInstances #-}--module Data.Morpheus.Rendering.Haskell.RenderHS- ( RenderHS(..)- ) where--import Data.Semigroup ((<>))---- MORPHEUS-import Data.Morpheus.Types.Internal.Data--class RenderHS a where- render :: a -> Key- renderWrapped :: a -> [WrapperD] -> Key- default renderWrapped :: a -> [WrapperD] -> Key- renderWrapped x wrappers = showGQLWrapper (toGQLWrapper wrappers)- where- showGQLWrapper [] = render x- showGQLWrapper (ListType:xs) = "[" <> showGQLWrapper xs <> "]"- showGQLWrapper (NonNullType:xs) = showGQLWrapper xs <> "!"--instance RenderHS Key where- render = id--instance RenderHS TypeAlias where- render TypeAlias {aliasTyCon, aliasWrappers} = renderWrapped aliasTyCon aliasWrappers--instance RenderHS DataKind where- render (ScalarKind x) = typeName x- render (EnumKind x) = typeName x- render (ObjectKind x) = typeName x- render (UnionKind x) = typeName x
src/Data/Morpheus/Rendering/Haskell/Types.hs view
@@ -14,20 +14,19 @@ import Data.Morpheus.Rendering.Haskell.Terms (Context (..), Scope (..), indent, renderAssignment, renderCon, renderData, renderSet, renderTuple, renderUnionCon, renderWrapped)-import Data.Morpheus.Types.Internal.Data (DataArgument, DataField (..), DataFullType (..), DataLeaf (..),- DataTyCon (..), TypeAlias (..), isNullable)+import Data.Morpheus.Types.Internal.Data (DataArgument, DataField (..), DataType (..), DataTyCon (..),+ TypeAlias (..), isNullable) -renderType :: Context -> (Text, DataFullType) -> Text+renderType :: Context -> (Text, DataType) -> Text renderType context (name, dataType) = typeIntro <> renderData name <> renderT dataType where- renderT (Leaf (BaseScalar _)) = renderCon name <> "Int Int" <> defineTypeClass "SCALAR" <> renderGQLScalar name- renderT (Leaf (CustomScalar _)) = renderCon name <> "Int Int" <> defineTypeClass "SCALAR" <> renderGQLScalar name- renderT (Leaf (LeafEnum DataTyCon {typeData})) = unionType typeData <> defineTypeClass "ENUM"- renderT (Union DataTyCon {typeData}) = renderUnion name typeData <> defineTypeClass "UNION"- renderT (InputObject DataTyCon {typeData}) =+ renderT (DataScalar _) = renderCon name <> "Int Int" <> defineTypeClass "SCALAR" <> renderGQLScalar name+ renderT (DataEnum DataTyCon {typeData}) = unionType typeData <> defineTypeClass "ENUM"+ renderT (DataUnion DataTyCon {typeData}) = renderUnion name typeData <> defineTypeClass "UNION"+ renderT (DataInputObject DataTyCon {typeData}) = renderCon name <> renderObject renderInputField typeData <> defineTypeClass "INPUT_OBJECT"- renderT (InputUnion _) = "\n -- Error: Input Union Not Supported"- renderT (OutputObject DataTyCon {typeData}) =+ renderT (DataInputUnion _) = "\n -- Error: Input Union Not Supported"+ renderT (DataObject DataTyCon {typeData}) = renderCon name <> renderObject (renderField context) typeData <> defineTypeClass "OBJECT" ---------------------------------------------------------------------------------------------------------- typeIntro = "\n\n---- GQL " <> name <> " ------------------------------- \n"
src/Data/Morpheus/Rendering/Haskell/Values.hs view
@@ -13,8 +13,8 @@ -- MORPHEUS import Data.Morpheus.Rendering.Haskell.Terms (Context (..), Scope (..), renderAssignment, renderCon, renderEqual, renderReturn, renderSet, renderUnionCon)-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataLeaf (..),- DataTyCon (..), DataTypeLib (..), TypeAlias (..), WrapperD (..))+import Data.Morpheus.Types.Internal.Data (DataField (..), DataType (..), DataTyCon (..),+ DataTypeLib (..), TypeAlias (..), WrapperD (..)) renderRootResolver :: Context -> DataTypeLib -> Text renderRootResolver _ DataTypeLib {mutation, subscription} = renderSignature <> renderBody <> "\n\n"@@ -37,16 +37,15 @@ maybeRes (Just (name, _)) = "resolve" <> name maybeRes Nothing = "return ()" -renderResolver :: Context -> (Text, DataFullType) -> Text+renderResolver :: Context -> (Text, DataType) -> Text renderResolver Context {scope, pubSub = (channel, content)} (name, dataType) = renderSig dataType where- renderSig (Leaf BaseScalar {}) = defFunc <> renderReturn <> "$ " <> renderCon name <> "0 0"- renderSig (Leaf CustomScalar {}) = defFunc <> renderReturn <> "$ " <> renderCon name <> "0 0"- renderSig (Leaf (LeafEnum DataTyCon {typeData})) = defFunc <> renderReturn <> renderCon (head typeData)- renderSig (Union DataTyCon {typeData}) = defFunc <> renderUnionCon name typeCon <> " <$> " <> "resolve" <> typeCon+ renderSig DataScalar {} = defFunc <> renderReturn <> "$ " <> renderCon name <> "0 0"+ renderSig (DataEnum DataTyCon {typeData}) = defFunc <> renderReturn <> renderCon (head typeData)+ renderSig (DataUnion DataTyCon {typeData}) = defFunc <> renderUnionCon name typeCon <> " <$> " <> "resolve" <> typeCon where typeCon = aliasTyCon $ fieldType $ head typeData- renderSig (OutputObject DataTyCon {typeData}) = defFunc <> renderReturn <> renderCon name <> renderObjFields+ renderSig (DataObject DataTyCon {typeData}) = defFunc <> renderReturn <> renderCon name <> renderObjFields where renderObjFields = renderResObject (map renderFieldRes typeData) renderFieldRes (key, DataField {fieldType = TypeAlias {aliasWrappers, aliasTyCon}}) =
src/Data/Morpheus/Rendering/RenderGQL.hs view
@@ -16,10 +16,9 @@ import Data.Text.Lazy.Encoding (encodeUtf8) -- MORPHEUS-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataKind (..), DataLeaf (..),- DataTyCon (..), DataTypeLib, DataTypeWrapper (..), Key,- TypeAlias (..), WrapperD (..), allDataTypes, isDefaultTypeName,- toGQLWrapper)+import Data.Morpheus.Types.Internal.Data (DataField (..), DataTyCon (..), DataType (..), DataTypeLib,+ DataTypeWrapper (..), Key, TypeAlias (..), WrapperD (..),+ allDataTypes, isDefaultTypeName, toGQLWrapper) import Data.Morpheus.Types.Internal.Value (convertToJSONName) renderGraphQLDocument :: DataTypeLib -> ByteString@@ -43,21 +42,22 @@ instance RenderGQL TypeAlias where render TypeAlias {aliasTyCon, aliasWrappers} = renderWrapped aliasTyCon aliasWrappers -instance RenderGQL DataKind where- render (ScalarKind x) = typeName x- render (EnumKind x) = typeName x- render (ObjectKind x) = typeName x- render (UnionKind x) = typeName x+instance RenderGQL DataType where+ render (DataScalar x) = typeName x+ render (DataEnum x) = typeName x+ render (DataUnion x) = typeName x+ render (DataInputObject x) = typeName x+ render (DataInputUnion x) = typeName x+ render ( DataObject x) = typeName x -instance RenderGQL (Key, DataFullType) where- render (name, Leaf (BaseScalar _)) = "scalar " <> name- render (name, Leaf (CustomScalar _)) = "scalar " <> name- render (name, Leaf (LeafEnum DataTyCon {typeData})) = "enum " <> name <> renderObject id typeData- render (name, Union DataTyCon {typeData}) =+instance RenderGQL (Key, DataType) where+ render (name, DataScalar {}) = "scalar " <> name+ render (name, DataEnum DataTyCon {typeData}) = "enum " <> name <> renderObject id typeData+ render (name, DataUnion DataTyCon {typeData}) = "union " <> name <> " =\n " <> intercalate ("\n" <> renderIndent <> "| ") (map (render . fieldType) typeData)- render (name, InputObject DataTyCon {typeData}) = "input " <> name <> render typeData- render (name, InputUnion DataTyCon {typeData}) = "input " <> name <> render (mapKeys typeData)- render (name, OutputObject DataTyCon {typeData}) = "type " <> name <> render typeData+ render (name, DataInputObject DataTyCon {typeData}) = "input " <> name <> render typeData+ render (name, DataInputUnion DataTyCon {typeData}) = "input " <> name <> render (mapKeys typeData)+ render (name, DataObject DataTyCon {typeData}) = "type " <> name <> render typeData mapKeys :: [DataField] -> [(Text, DataField)] mapKeys = map (\x -> (fieldName x, x))
src/Data/Morpheus/Rendering/RenderIntrospection.hs view
@@ -8,6 +8,7 @@ , createObjectType ) where +import Control.Monad.Fail (MonadFail) import Data.Semigroup ((<>)) import Data.Text (Text, unpack) @@ -15,10 +16,9 @@ -- Morpheus import Data.Morpheus.Schema.TypeKind (TypeKind (..))-import Data.Morpheus.Types.Internal.Data (DataField (..), DataField, DataFullType (..), DataLeaf (..),- DataObject, DataTyCon (..), DataTypeKind (..), DataTypeLib,- DataTypeWrapper (..), DataUnion, TypeAlias (..), kindOf,- lookupDataType, toGQLWrapper)+import Data.Morpheus.Types.Internal.Data (DataField (..), DataObject, DataTyCon (..), DataType (..),+ DataTypeKind (..), DataTypeLib, DataTypeWrapper (..), DataUnion,+ TypeAlias (..), kindOf, lookupDataType, toGQLWrapper) import Data.Morpheus.Types.Internal.Value (convertToJSONName) constRes :: Applicative m => a -> b -> m a@@ -27,24 +27,21 @@ type Result m a = DataTypeLib -> m a class RenderSchema a b where- render :: Monad m => (Text, a) -> DataTypeLib -> m (b m)+ render :: (Monad m, MonadFail m) => (Text, a) -> DataTypeLib -> m (b m) -instance RenderSchema DataFullType S__Type where- render (name, Leaf leaf) = render (name, leaf)- render (name, InputObject iObject) = renderInputObject (name, iObject)- render (name, OutputObject object') = typeFromObject (name, object')+instance RenderSchema DataType S__Type where+ render (key, DataScalar DataTyCon {typeDescription}) =+ constRes $ createLeafType SCALAR key typeDescription Nothing+ render (key, DataEnum DataTyCon {typeDescription, typeData}) =+ constRes $ createLeafType ENUM key typeDescription (Just $ map createEnumValue typeData)+ render (name, DataInputObject iObject) = renderInputObject (name, iObject)+ render (name, DataObject object') = typeFromObject (name, object') where typeFromObject (key, DataTyCon {typeData, typeDescription}) lib = createObjectType key typeDescription <$> (Just <$> traverse (`render` lib) (filter (not . fieldHidden . snd) typeData))- render (name, Union union') = const $ pure $ typeFromUnion (name, union')- render (name, InputUnion inpUnion') = renderInputUnion (name, inpUnion')--instance RenderSchema DataLeaf S__Type where- render (key, BaseScalar DataTyCon {typeDescription}) _ = pure $ createLeafType SCALAR key typeDescription Nothing- render (key, CustomScalar DataTyCon {typeDescription}) _ = pure $ createLeafType SCALAR key typeDescription Nothing- render (key, LeafEnum DataTyCon {typeDescription, typeData}) _ =- pure $ createLeafType ENUM key typeDescription (Just $ map createEnumValue typeData)+ render (name, DataUnion union') = const $ pure $ typeFromUnion (name, union')+ render (name, DataInputUnion inpUnion') = renderInputUnion (name, inpUnion') instance RenderSchema DataField S__Field where render (key, field@DataField {fieldType = TypeAlias {aliasTyCon}, fieldArgs}) lib = do@@ -69,26 +66,26 @@ wrapByTypeWrapper ListType = wrapAs LIST wrapByTypeWrapper NonNullType = wrapAs NON_NULL -lookupKind :: Monad m => Text -> Result m DataTypeKind+lookupKind :: (Monad m, MonadFail m) => Text -> Result m DataTypeKind lookupKind name lib = case lookupDataType name lib of Nothing -> fail $ unpack ("Kind Not Found: " <> name) Just value -> pure (kindOf value) -inputValueFromArg :: Monad m => (Text, DataField) -> Result m (S__InputValue m)+inputValueFromArg :: (Monad m,MonadFail m) => (Text, DataField) -> Result m (S__InputValue m) inputValueFromArg (key, input) = fmap (createInputValueWith key) . createInputObjectType input -createInputObjectType :: Monad m => DataField -> Result m (S__Type m)+createInputObjectType :: (Monad m, MonadFail m) => DataField -> Result m (S__Type m) createInputObjectType field@DataField {fieldType = TypeAlias {aliasTyCon}} lib = do kind <- renderTypeKind <$> lookupKind aliasTyCon lib pure $ wrap field $ createType kind aliasTyCon Nothing $ Just [] -renderInputObject :: Monad m => (Text, DataObject) -> Result m (S__Type m)+renderInputObject :: (Monad m, MonadFail m) => (Text, DataObject) -> Result m (S__Type m) renderInputObject (key, DataTyCon {typeData, typeDescription}) lib = do fields <- traverse (`inputValueFromArg` lib) typeData pure $ createInputObject key typeDescription fields -renderInputUnion :: Monad m => (Text, DataUnion) -> Result m (S__Type m)+renderInputUnion :: (Monad m, MonadFail m) => (Text, DataUnion) -> Result m (S__Type m) renderInputUnion (key', DataTyCon {typeData, typeDescription}) lib = createInputObject key' typeDescription <$> traverse createField typeData where
src/Data/Morpheus/Types.hs view
@@ -24,13 +24,16 @@ , QUERY , MUTATION , SUBSCRIPTION+ , liftEitherM+ , liftM ) where import Data.Morpheus.Types.GQLScalar (GQLScalar (parseValue, serialize)) import Data.Morpheus.Types.GQLType (GQLType (KIND, description)) import Data.Morpheus.Types.ID (ID (..)) import Data.Morpheus.Types.Internal.Data (MUTATION, QUERY, SUBSCRIPTION)-import Data.Morpheus.Types.Internal.Resolver (Event (..), GQLRootResolver (..), PureOperation, Resolver (..))+import Data.Morpheus.Types.Internal.Resolver (Event (..), GQLRootResolver (..), PureOperation, Resolver (..),+ liftEitherM, liftM) import Data.Morpheus.Types.Internal.Value (ScalarValue (..)) import Data.Morpheus.Types.IO (GQLRequest (..), GQLResponse (..)) import Data.Morpheus.Types.Types (Undefined (..))
src/Data/Morpheus/Types/Internal/Data.hs view
@@ -21,9 +21,7 @@ , DataArguments , DataField(..) , DataTyCon(..)- , DataLeaf(..)- , DataKind(..)- , DataFullType(..)+ , DataType(..) , DataTypeLib(..) , DataTypeWrapper(..) , DataValidator(..)@@ -61,6 +59,7 @@ , SUBSCRIPTION , Name , Description+ , isEntNode ) where import Data.Semigroup ((<>))@@ -234,42 +233,35 @@ , typeData :: a } deriving (Show) -data DataLeaf- = BaseScalar DataScalar- | CustomScalar DataScalar- | LeafEnum DataEnum- deriving (Show)---- DATA KIND-data DataKind- = ScalarKind DataScalar- | EnumKind DataEnum- | ObjectKind DataObject- | UnionKind DataUnion- deriving (Show)- data RawDataType- = FinalDataType DataFullType+ = FinalDataType DataType | Interface DataObject | Implements { implementsInterfaces :: [Key] , unImplements :: DataObject } deriving (Show) -data DataFullType- = Leaf DataLeaf- | InputObject DataObject- | OutputObject DataObject- | Union DataUnion- | InputUnion DataUnion+isEntNode :: DataType -> Bool+isEntNode DataScalar {} = True+isEntNode DataEnum {} = True+isEntNode _ = False++data DataType+ = DataScalar DataScalar+ | DataEnum DataEnum+ | DataInputObject DataObject+ | DataObject DataObject+ | DataUnion DataUnion+ | DataInputUnion DataUnion deriving (Show) data DataTypeLib = DataTypeLib- { leaf :: [(Key, DataLeaf)]+ { scalar :: [(Key, DataScalar)]+ , enum :: [(Key, DataEnum)] , inputObject :: [(Key, DataObject)] , object :: [(Key, DataObject)] , union :: [(Key, DataUnion)] , inputUnion :: [(Key, DataUnion)]- , query :: (Key, DataObject)+ , query :: (Key, DataObject) , mutation :: Maybe (Key, DataObject) , subscription :: Maybe (Key, DataObject) } deriving (Show)@@ -277,7 +269,8 @@ initTypeLib :: (Key, DataObject) -> DataTypeLib initTypeLib query = DataTypeLib- { leaf = []+ { scalar = []+ , enum = [] , inputObject = [] , query = query , object = []@@ -287,50 +280,50 @@ , subscription = Nothing } -allDataTypes :: DataTypeLib -> [(Key, DataFullType)]-allDataTypes (DataTypeLib leaf' inputObject' object' union' inputUnion' query' mutation' subscription') =- packType OutputObject query' :- fromMaybeType mutation' ++- fromMaybeType subscription' ++- map (packType Leaf) leaf' ++- map (packType InputObject) inputObject' ++- map (packType InputUnion) inputUnion' ++ map (packType OutputObject) object' ++ map (packType Union) union'+allDataTypes :: DataTypeLib -> [(Key, DataType)]+allDataTypes DataTypeLib { scalar, enum , inputObject, object, union, inputUnion, query, mutation, subscription } =+ packType DataObject query :+ fromMaybeType mutation +++ fromMaybeType subscription +++ map (packType DataScalar) scalar +++ map (packType DataEnum) enum +++ map (packType DataInputObject) inputObject +++ map (packType DataInputUnion) inputUnion ++ map (packType DataObject) object ++ map (packType DataUnion) union where packType f (x, y) = (x, f y)- fromMaybeType :: Maybe (Key, DataObject) -> [(Key, DataFullType)]- fromMaybeType (Just (key', dataType')) = [(key', OutputObject dataType')]+ fromMaybeType :: Maybe (Key, DataObject) -> [(Key, DataType)]+ fromMaybeType (Just (key', dataType')) = [(key', DataObject dataType')] fromMaybeType Nothing = [] -lookupDataType :: Key -> DataTypeLib -> Maybe DataFullType+lookupDataType :: Key -> DataTypeLib -> Maybe DataType lookupDataType name lib = name `lookup` allDataTypes lib -kindOf :: DataFullType -> DataTypeKind-kindOf (Leaf (BaseScalar _)) = KindScalar-kindOf (Leaf (CustomScalar _)) = KindScalar-kindOf (Leaf (LeafEnum _)) = KindEnum-kindOf (InputObject _) = KindInputObject-kindOf (OutputObject _) = KindObject Nothing-kindOf (Union _) = KindUnion-kindOf (InputUnion _) = KindInputUnion+kindOf :: DataType -> DataTypeKind+kindOf (DataScalar _) = KindScalar+kindOf (DataEnum _) = KindEnum+kindOf (DataInputObject _) = KindInputObject+kindOf (DataObject _) = KindObject Nothing+kindOf (DataUnion _) = KindUnion+kindOf (DataInputUnion _) = KindInputUnion -fromDataType :: (DataTyCon () -> v) -> DataFullType -> v-fromDataType f (Leaf (BaseScalar dt)) = f dt {typeData = ()}-fromDataType f (Leaf (CustomScalar dt)) = f dt {typeData = ()}-fromDataType f (Leaf (LeafEnum dt)) = f dt {typeData = ()}-fromDataType f (Union dt) = f dt {typeData = ()}-fromDataType f (InputObject dt) = f dt {typeData = ()}-fromDataType f (InputUnion dt) = f dt {typeData = ()}-fromDataType f (OutputObject dt) = f dt {typeData = ()}+fromDataType :: (DataTyCon () -> v) -> DataType -> v+fromDataType f (DataScalar dt) = f dt {typeData = ()}+fromDataType f (DataEnum dt) = f dt {typeData = ()}+fromDataType f (DataUnion dt) = f dt {typeData = ()}+fromDataType f (DataInputObject dt) = f dt {typeData = ()}+fromDataType f (DataInputUnion dt) = f dt {typeData = ()}+fromDataType f (DataObject dt) = f dt {typeData = ()} isTypeDefined :: Key -> DataTypeLib -> Maybe DataFingerprint isTypeDefined name lib = fromDataType typeFingerprint <$> lookupDataType name lib -defineType :: (Key, DataFullType) -> DataTypeLib -> DataTypeLib-defineType (key', Leaf type') lib = lib {leaf = (key', type') : leaf lib}-defineType (key', InputObject type') lib = lib {inputObject = (key', type') : inputObject lib}-defineType (key', OutputObject type') lib = lib {object = (key', type') : object lib}-defineType (key', Union type') lib = lib {union = (key', type') : union lib}-defineType (key', InputUnion type') lib = lib {inputUnion = (key', type') : inputUnion lib}+defineType :: (Key, DataType) -> DataTypeLib -> DataTypeLib+defineType (key', DataScalar type') lib = lib {scalar = (key', type') : scalar lib}+defineType (key', DataEnum type') lib = lib {enum = (key', type') : enum lib}+defineType (key', DataInputObject type') lib = lib {inputObject = (key', type') : inputObject lib}+defineType (key', DataObject type') lib = lib {object = (key', type') : object lib}+defineType (key', DataUnion type') lib = lib {union = (key', type') : union lib}+defineType (key', DataInputUnion type') lib = lib {inputUnion = (key', type') : inputUnion lib} toNullableField :: DataField -> DataField toNullableField dataField
src/Data/Morpheus/Types/Internal/Resolver.hs view
@@ -17,9 +17,7 @@ , Event(..) , GQLRootResolver(..) , UnSubResolver- , GQLFail(..) , ResponseT- , failResolveT , Resolver(..) , ResolvingStrategy(..) , MapGraphQLT(..)@@ -28,18 +26,19 @@ , toResponseRes , withObject , Resolving(..)+ , liftM+ , liftEitherM ) where +import Control.Monad.Fail (MonadFail (..)) import Control.Monad.Trans.Except (ExceptT (..), runExceptT, withExceptT) import Data.Maybe (fromMaybe) import Data.Semigroup ((<>))-import Data.Text (pack, unpack) -- MORPHEUS import Data.Morpheus.Error.Selection (resolverError, subfieldsNotSelected) import Data.Morpheus.Types.Internal.AST.Selection (Selection (..), SelectionRec (..), SelectionSet, ValidSelection)-import Data.Morpheus.Types.Internal.Base (Message) import Data.Morpheus.Types.Internal.Data (Key, MUTATION, OperationType, QUERY, SUBSCRIPTION) import Data.Morpheus.Types.Internal.Stream (Channel (..), Event (..), ResponseEvent (..), ResponseStream, StreamChannel, StreamState (..),@@ -52,26 +51,20 @@ withObject f (_, Selection {selectionRec = SelectionSet selection}) = f selection withObject _ (key, Selection {selectionPosition}) = Fail $ subfieldsNotSelected key "" selectionPosition -class Monad m =>- GQLFail (t :: (* -> *) -> * -> *) m- where- gqlFail :: Monad m => Message -> t m a- toSuccess :: Monad m => (Message -> b) -> (a -> b) -> t m a -> t m b--instance Monad m => GQLFail (ExceptT String) m where- gqlFail = ExceptT . pure . Left . unpack- toSuccess fFail fSuc (ExceptT value) = ExceptT $ pure . mapCases <$> value- where- mapCases (Right x) = fSuc x- mapCases (Left x) = fFail $ pack $ show x+liftM :: (PureOperation o, Monad m) => m a -> Resolver o m e a+liftM = liftEither . fmap pure +liftEitherM :: (PureOperation o, Monad m) => m (Either String a) -> Resolver o m e a+liftEitherM = liftEither ---------------------------------------------------------------------------------------- type ResolveT = ExceptT GQLErrors type ResponseT m e = ResolveT (ResponseStream m e) +instance Monad m => MonadFail (Resolver QUERY m e) where+ fail = FailedResolver+ -- -- Recursive Resolver- newtype RecResolver m a b = RecResolver { unRecResolver :: a -> ResolveT m b }@@ -126,6 +119,7 @@ pure (f1 <*> res1) -- GADTResolver+--------------------------------------------------------------- data Resolver (o::OperationType) (m :: * -> * ) event value where FailedResolver :: { unFailedResolver :: String } -> Resolver o m event value QueryResolver:: { unQueryResolver :: ExceptT String m value } -> Resolver QUERY m event value@@ -149,7 +143,7 @@ -- GADTResolver Applicative instance (PureOperation o ,Monad m) => Applicative (Resolver o m e) where- pure = pureRes+ pure = liftEither . pure . pure ------------------------------------- _ <*> (FailedResolver mErrors) = FailedResolver mErrors (FailedResolver mErrors) <*> _ = FailedResolver mErrors@@ -170,22 +164,22 @@ -- Pure Operation class PureOperation (o::OperationType) where- pureRes :: Monad m => a -> Resolver o m event a+ liftEither :: Monad m => m (Either String a) -> Resolver o m event a pureGraphQLT :: Monad m => a -> ResolvingStrategy o m event a eitherGraphQLT :: Monad m => Validation a -> ResolvingStrategy o m event a instance PureOperation QUERY where- pureRes = QueryResolver . pure+ liftEither = QueryResolver . ExceptT pureGraphQLT = QueryResolving . pure eitherGraphQLT = QueryResolving . ExceptT . pure instance PureOperation MUTATION where- pureRes = MutResolver [] . pure+ liftEither = MutResolver [] . ExceptT pureGraphQLT = MutationResolving . pure eitherGraphQLT = MutationResolving . ExceptT . pure instance PureOperation SUBSCRIPTION where- pureRes = SubResolver [] . const . pure+ liftEither = SubResolver [] . const . liftEither pureGraphQLT = SubscriptionResolving . pure . pure eitherGraphQLT = SubscriptionResolving . fmap pure . ExceptT . pure @@ -257,10 +251,6 @@ type family UnSubResolver (a :: * -> *) :: (* -> *) type instance UnSubResolver (Resolver SUBSCRIPTION m e) = Resolver QUERY m e----------------------------------------------------------------------failResolveT :: Monad m => GQLErrors -> ResolveT m a-failResolveT = ExceptT . pure . Left ------------------------------------------------------------------- -- | GraphQL Root resolver, also the interpreter generates a GQL schema from it.
src/Data/Morpheus/Types/Internal/TH.hs view
@@ -8,7 +8,7 @@ liftMaybeText :: Maybe Text -> ExpQ liftMaybeText (Just x) = appE (conE 'Just) (liftText x)-liftMaybeText Nothing = conE 'Nothing+liftMaybeText Nothing = conE 'Nothing liftText :: Text -> ExpQ liftText x = appE (varE 'pack) (lift (unpack x))@@ -40,3 +40,8 @@ -- "User" -> ["name","id"] -> (User name id) destructRecord :: String -> [String] -> PatQ destructRecord conName fields = conP (mkName conName) (map (varP . mkName) fields)++typeInstanceDec :: Name -> Type -> Type -> Dec+typeInstanceDec typeFamily arg res = TySynInstD typeFamily (TySynEqn [arg] res)+-- : TODO after th 2.15.0.0+-- typeInstanceDec typeFamily arg res = TySynInstD (TySynEqn Nothing (AppT (ConT typeFamily) arg) res)
src/Data/Morpheus/Validation/Document/Validation.hs view
@@ -10,25 +10,25 @@ -- Morpheus import Data.Morpheus.Error.Document.Interface (ImplementsError (..), partialImplements, unknownInterface) import Data.Morpheus.Rendering.RenderGQL (RenderGQL (..))-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataObject, DataTyCon (..),+import Data.Morpheus.Types.Internal.Data (DataField (..), DataType (..), DataObject, DataTyCon (..), Key, RawDataType (..), TypeAlias (..), isWeaker, isWeaker) import Data.Morpheus.Types.Internal.Validation (Validation) -validatePartialDocument :: [(Key, RawDataType)] -> Validation [(Key, DataFullType)]+validatePartialDocument :: [(Key, RawDataType)] -> Validation [(Key, DataType)] validatePartialDocument lib = catMaybes <$> traverse validateType lib where- validateType :: (Key, RawDataType) -> Validation (Maybe (Key, DataFullType))+ validateType :: (Key, RawDataType) -> Validation (Maybe (Key, DataType)) validateType (name, FinalDataType x) = pure $ Just (name, x) validateType (name, Implements interfaces object) = asTuple name <$> object `mustImplement` interfaces validateType _ = pure Nothing ----------------------------------- asTuple name x = Just (name, x) ------------------------------------ mustImplement :: DataObject -> [Key] -> Validation DataFullType+ mustImplement :: DataObject -> [Key] -> Validation DataType mustImplement object interfaceKey = do interface <- traverse getInterfaceByKey interfaceKey case concatMap (mustBeSubset object) interface of- [] -> pure $ OutputObject object+ [] -> pure $ DataObject object errors -> Left $ partialImplements (typeName object) errors ------------------------------- mustBeSubset :: DataObject -> DataObject -> [(Key, Key, ImplementsError)]
src/Data/Morpheus/Validation/Internal/Utils.hs view
@@ -12,7 +12,7 @@ import Data.List ((\\)) import Data.Morpheus.Error.Variable (unknownType) import Data.Morpheus.Types.Internal.Base (EnhancedKey (..), Key, Position, enhanceKeyWithNull)-import Data.Morpheus.Types.Internal.Data (DataKind (..), DataLeaf (..), DataObject, DataTypeLib (..))+import Data.Morpheus.Types.Internal.Data (DataObject, DataType (..), DataTypeLib (..)) import Data.Morpheus.Types.Internal.Validation (Validation) import qualified Data.Set as S import Data.Text (Text)@@ -36,19 +36,19 @@ Nothing -> Left error' Just field -> pure field -getInputType :: Text -> DataTypeLib -> GenError error DataKind-getInputType typeName' lib error' =- case lookup typeName' (inputObject lib) of- Just x -> pure (ObjectKind x)+getInputType :: Text -> DataTypeLib -> GenError error DataType+getInputType name lib gqlError =+ case lookup name (inputObject lib) of+ Just x -> pure (DataInputObject x) Nothing ->- case lookup typeName' (inputUnion lib) of- Just x -> pure (UnionKind x)+ case lookup name (inputUnion lib) of+ Just x -> pure (DataInputUnion x) Nothing ->- case lookup typeName' (leaf lib) of- Nothing -> Left error'- Just (BaseScalar x) -> pure (ScalarKind x)- Just (CustomScalar x) -> pure (ScalarKind x)- Just (LeafEnum x) -> pure (EnumKind x)+ case lookup name (scalar lib) of+ Just x -> pure (DataScalar x)+ Nothing -> case lookup name (enum lib) of+ Just x -> pure (DataEnum x)+ Nothing -> Left gqlError existsObjectType :: Position -> Text -> DataTypeLib -> Validation DataObject existsObjectType position' typeName' lib = lookupType error' (object lib) typeName'
src/Data/Morpheus/Validation/Internal/Value.hs view
@@ -11,20 +11,20 @@ -- MORPHEUS import Data.Morpheus.Error.Input (InputError (..), InputValidation, Prop (..)) import Data.Morpheus.Rendering.RenderGQL (renderWrapped)-import Data.Morpheus.Types.Internal.Data (DataField (..), DataKind (..), DataTyCon (..),+import Data.Morpheus.Types.Internal.Data (DataField (..), DataTyCon (..), DataType (..), 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 -> (Key, Value) -> InputValidation Value+validateInputValue :: DataTypeLib -> [Prop] -> [WrapperD] -> DataType -> (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+ throwError :: [WrapperD] -> DataType -> Value -> InputValidation Value+ throwError wrappers datatype value = Left $ UnexpectedType prop' (renderWrapped datatype wrappers) value Nothing -- VALIDATION- validate :: [WrapperD] -> DataKind -> (Key, Value) -> InputValidation Value+ validate :: [WrapperD] -> DataType -> (Key, Value) -> InputValidation Value -- Validate Null. value = null ? validate wrappers tName (_, Null) | isNullable wrappers = return Null@@ -36,7 +36,7 @@ validateElement element' = validateInputValue lib prop' wrappers type' (key', element') {-- 2. VALIDATE TYPES, all wrappers are already Processed --} {-- VALIDATE OBJECT--}- validate [] (ObjectKind DataTyCon {typeData = parentFields'}) (_, Object fields) =+ validate [] (DataInputObject DataTyCon {typeData = parentFields'}) (_, Object fields) = Object <$> mapM validateField fields where validateField (_name, value) = do@@ -53,18 +53,18 @@ getField = lookupField _name parentFields' (UnknownField prop' _name) -- VALIDATE INPUT UNION -- TODO: Validate Union- validate [] (UnionKind DataTyCon {typeData}) (_, Object fields) = return (Object fields)+ validate [] (DataInputUnion DataTyCon {typeData}) (_, Object fields) = return (Object fields) {-- VALIDATE SCALAR --}- validate [] (EnumKind DataTyCon {typeData = tags', typeName = name'}) (_, value') =+ validate [] (DataEnum DataTyCon {typeData = tags', typeName = name'}) (_, value') = validateEnum (UnexpectedType prop' name' value' Nothing) tags' value' {-- VALIDATE ENUM --}- validate [] (ScalarKind DataTyCon {typeName = name', typeData = DataValidator {validateValue = validator'}}) (_, value') =+ validate [] (DataScalar DataTyCon {typeName = name', typeData = DataValidator {validateValue = validator'}}) (_, value') = case validator' value' of Right _ -> return value' Left "" -> Left $ UnexpectedType prop' name' value' Nothing Left errorMessage -> Left $ UnexpectedType prop' name' value' (Just errorMessage) {-- 3. THROW ERROR: on invalid values --}- validate wrappers' type' (_, value') = throwError wrappers' type' value'+ validate wrappers datatype (_, value) = throwError wrappers datatype value validateEnum :: error -> [Key] -> Value -> Either error Value validateEnum error' tags' (Enum enumValue) =
src/Data/Morpheus/Validation/Query/Selection.hs view
@@ -21,9 +21,9 @@ RawSelectionSet) import Data.Morpheus.Types.Internal.AST.Selection (Selection (..), SelectionRec (..), SelectionSet) import Data.Morpheus.Types.Internal.Base (EnhancedKey (..))-import Data.Morpheus.Types.Internal.Data (DataField (..), DataFullType (..), DataObject,+import Data.Morpheus.Types.Internal.Data (DataField (..), DataType (..), DataObject, DataTyCon (..), DataTypeLib (..), TypeAlias (..),- allDataTypes)+ allDataTypes, isEntNode) import Data.Morpheus.Types.Internal.Validation (Validation) import Data.Morpheus.Validation.Internal.Utils (checkNameCollision, lookupType) import Data.Morpheus.Validation.Query.Arguments (validateArguments)@@ -119,7 +119,7 @@ validateSelection (key', RawSelectionSet fullRawSelection@Selection { selectionRec = rawSelection, selectionPosition }) = do (dataField, dataType, arguments) <- getValidationData key' fullRawSelection case dataType of- Union _ -> do+ DataUnion _ -> do (categories, __typename) <- clusterTypes mapM (validateCluster __typename) categories >>= returnSelection arguments . UnionSelection where clusterTypes = do@@ -133,7 +133,7 @@ validateCluster sysSelection' (type', frags') = do selection' <- __validate type' (concatMap fragmentSelection frags') return (typeName type', sysSelection' ++ selection')- OutputObject _ -> do+ DataObject _ -> do fieldType' <- lookupFieldAsSelectionSet selectionPosition key' lib dataField __validate fieldType' rawSelection >>= returnSelection arguments . SelectionSet _ -> Left $ hasNoSubfields key' (aliasTyCon $fieldType dataField) selectionPosition@@ -152,9 +152,9 @@ isLeaf datatype dataField pure [( key , rawSelection { selectionArguments , selectionRec = SelectionField })] where- isLeaf (Leaf _) _ = Right ()- isLeaf _ DataField {fieldType = TypeAlias {aliasTyCon}} =- Left $ subfieldsNotSelected key aliasTyCon selectionPosition+ isLeaf dataType DataField {fieldType = TypeAlias {aliasTyCon}}+ | isEntNode dataType = Right ()+ | otherwise = Left $ subfieldsNotSelected key aliasTyCon selectionPosition validateSelection (_, Spread reference') = resolveSpread fragments' [typeName'] reference' >>= validateFragment validateSelection (_, InlineFragment fragment') = castFragmentType Nothing (fragmentPosition fragment') [typeName'] fragment' >>= validateFragment
src/Data/Morpheus/Validation/Query/Variable.hs view
@@ -20,7 +20,7 @@ RawSelection (..), RawSelectionSet, Reference (..), Selection (..)) import Data.Morpheus.Types.Internal.Base (EnhancedKey (..), Position)-import Data.Morpheus.Types.Internal.Data (DataKind, DataTypeLib)+import Data.Morpheus.Types.Internal.Data (DataType, DataTypeLib) import Data.Morpheus.Types.Internal.Validation (Validation) import Data.Morpheus.Types.Internal.Value (Value (..)) import Data.Morpheus.Types.Types (Variables)@@ -28,7 +28,7 @@ import Data.Morpheus.Validation.Internal.Value (validateInputValue) import Data.Morpheus.Validation.Query.Fragment (getFragment) -getVariableType :: Text -> Position -> DataTypeLib -> Validation DataKind+getVariableType :: Text -> Position -> DataTypeLib -> Validation DataType getVariableType type' position' lib' = getInputType type' lib' error' where error' = unknownType type' position'
test/Rendering/TestSchemaRendering.hs view
@@ -12,8 +12,8 @@ -- TODO: better Test testSchemaRendering :: TestTree-testSchemaRendering = testCase "Test Rendering" $ assertEqual "test schema Rendering" schema expected+testSchemaRendering = testCase "Test Rendering" $ assertEqual "test schema Rendering" expected schema 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!"+ "type Query { \n user: User!\n testUnion: TestUnion\n}\n\nscalar TestScalar\n\nenum TestEnum { \n EnumA\n EnumB\n EnumC\n}\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!"