diff options
| -rw-r--r-- | .gitignore | 2 | ||||
| -rw-r--r-- | CHANGELOG.md | 6 | ||||
| -rw-r--r-- | README.md | 6 | ||||
| -rw-r--r-- | docs/tutorial/tutorial.lhs | 49 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute/Execution.hs | 12 | ||||
| -rw-r--r-- | src/Language/GraphQL/Trans.hs | 73 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type.hs | 3 | ||||
| -rw-r--r-- | src/Language/GraphQL/Type/Out.hs | 72 | ||||
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 2 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 1 |
10 files changed, 112 insertions, 114 deletions
@@ -12,3 +12,5 @@ cabal.project.local # GHC *.hi +*.o +/docs/tutorial/tutorial diff --git a/CHANGELOG.md b/CHANGELOG.md index 5f3907c..52abf77 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -11,8 +11,10 @@ and this project adheres to - `AST` reexports `AST.Parser`. ## Changed -- `Trans.ActionT` is renamed to `ResolverT`. Since `Type.Out.Resolver` has gone - it is a better name for GraphQL resolvers. +- `Trans.ActionT` has become to `Type.Out.ResolverT`. Since `Type.Out.Resolver` + has gone it is a better name for GraphQL resolvers. +- All code from `Trans` is moved to `Type.Out` and exported by `Type` and + `Type.Out`. - `AST.Core` contained only `Arguments` which was moved to `Type.Definition`. `AST` provides now only functionality related to parsing and encoding, as it should be. @@ -13,9 +13,9 @@ be built on top of it. ## State of the work -For now this only provides a parser and a printer for the GraphQL query -language and allows to execute queries and mutations without the schema -validation step. But the idea is to be a Haskell port of +For now this only provides a parser and a printer for the GraphQL query language +and allows to execute queries and mutations using the given schema, but without +the validation step. But the idea is to be a Haskell port of [`graphql-js`](https://github.com/graphql/graphql-js). For the list of currently missing features see issues marked as diff --git a/docs/tutorial/tutorial.lhs b/docs/tutorial/tutorial.lhs index 2c6e877..06494a2 100644 --- a/docs/tutorial/tutorial.lhs +++ b/docs/tutorial/tutorial.lhs @@ -7,9 +7,11 @@ title: GraphQL Haskell Tutorial Welcome to graphql-haskell! -We have written a small tutorial to help you (and ourselves) understand the graphql package. +We have written a small tutorial to help you (and ourselves) understand the +graphql package. -Since this file is a literate haskell file, we start by importing some dependencies. +Since this file is a literate haskell file, we start by importing some +dependencies. > {-# LANGUAGE OverloadedStrings #-} > module Main where @@ -23,16 +25,16 @@ Since this file is a literate haskell file, we start by importing some dependenc > import Data.Time (getCurrentTime) > > import Language.GraphQL -> import Language.GraphQL.Trans > import Language.GraphQL.Type > import qualified Language.GraphQL.Type.Out as Out > > import Prelude hiding (putStrLn) + === First example === -Now, as our first example, we are going to look at the -example from [graphql.js](https://github.com/graphql/graphql-js). +Now, as our first example, we are going to look at the example from +[graphql.js](https://github.com/graphql/graphql-js). First we build a GraphQL schema. @@ -49,26 +51,24 @@ First we build a GraphQL schema. > hello :: ResolverT IO Value > hello = pure $ String "it's me" -This defines a simple schema with one type and one field, that resolves to a fixed value. +This defines a simple schema with one type and one field, that resolves to a +fixed value. Next we define our query. > query1 :: Text > query1 = "{ hello }" - To run the query, we call the `graphql` with the schema and the query. > main1 :: IO () > main1 = graphql schema1 query1 >>= putStrLn . encode -This runs the query by fetching the one field defined, -returning +This runs the query by fetching the one field defined, returning ```{"data" : {"hello":"it's me"}}``` - === Monadic actions === For this example, we're going to be using time. @@ -88,8 +88,8 @@ For this example, we're going to be using time. > t <- liftIO getCurrentTime > pure $ String $ Text.pack $ show t -This defines a simple schema with one type and one field, -which resolves to the current time. +This defines a simple schema with one type and one field, which resolves to the +current time. Next we define our query. @@ -106,35 +106,29 @@ This runs the query, returning the current time === Errors === -Errors are handled according to the spec, -with fields that cause erros being resolved to `null`, -and an error being added to the error list. +Errors are handled according to the spec, with fields that cause erros being +resolved to `null`, and an error being added to the error list. An example of this is the following query: > queryShouldFail :: Text > queryShouldFail = "{ boyhowdy }" -Since there is no `boyhowdy` field in our schema, it will not resolve, -and the query will fail, as we can see in the following example. +Since there is no `boyhowdy` field in our schema, it will not resolve, and the +query will fail, as we can see in the following example. > mainShouldFail :: IO () > mainShouldFail = do -> success <- graphql schema1 query1 -> putStrLn $ encode success -> putStrLn "This will fail" > failure <- graphql schema1 queryShouldFail > putStrLn $ encode failure -> This outputs: ``` -{"data": {"hello": "it's me"}} -This will fail {"data": {"boyhowdy": null}, "errors":[{"message": "the field boyhowdy did not resolve."}]} ``` + === Combining resolvers === Now that we have two resolvers, we can define a schema which uses them both. @@ -158,15 +152,18 @@ This queries for both time and hello, returning ```{ "data": {"hello":"it's me","time":"2016-03-08 23:29:11.62108 UTC"}}``` -Notice that we can name our queries, as we did with `timeAndHello`. Since we have only been using single queries, we can use the shorthand `{ time hello}`, as we have been doing in the previous examples. +Notice that we can name our queries, as we did with `timeAndHello`. Since we +have only been using single queries, we can use the shorthand `{ time hello }`, +as we have been doing in the previous examples. In GraphQL there can only be one operation per query. == Further examples == -More examples on queries and a more complex schema can be found in the test directory, -in the [Test.StarWars](../../tests/Test/StarWars) module. This includes a more complex schema, and more complex queries. +More examples on queries and a more complex schema can be found in the test +directory, in the [Test.StarWars](../../tests/Test/StarWars) module. This +includes a more complex schema, and more complex queries. > main :: IO () > main = main1 >> main2 >> mainShouldFail >> main3 diff --git a/src/Language/GraphQL/Execute/Execution.hs b/src/Language/GraphQL/Execute/Execution.hs index 5e53311..2b12c43 100644 --- a/src/Language/GraphQL/Execute/Execution.hs +++ b/src/Language/GraphQL/Execute/Execution.hs @@ -22,7 +22,6 @@ import Language.GraphQL.AST (Name) import Language.GraphQL.Error import Language.GraphQL.Execute.Coerce import qualified Language.GraphQL.Execute.Transform as Transform -import Language.GraphQL.Trans import qualified Language.GraphQL.Type as Type import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out @@ -32,12 +31,15 @@ import Prelude hiding (null) resolveFieldValue :: Monad m => Type.Value -> Type.Subs - -> ResolverT m a + -> Type.ResolverT m a -> m (Either Text a) resolveFieldValue result args = - flip runReaderT (Context {arguments = Type.Arguments args, values = result}) - . runExceptT - . runResolverT + flip runReaderT context . runExceptT . Type.runResolverT + where + context = Type.Context + { Type.arguments = Type.Arguments args + , Type.values = result + } collectFields :: Monad m => Out.ObjectType m diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs deleted file mode 100644 index a55ac49..0000000 --- a/src/Language/GraphQL/Trans.hs +++ /dev/null @@ -1,73 +0,0 @@ --- | Monad transformer stack used by the @GraphQL@ resolvers. -module Language.GraphQL.Trans - ( argument - , ResolverT(..) - , Context(..) - ) where - -import Control.Applicative (Alternative(..)) -import Control.Monad (MonadPlus(..)) -import Control.Monad.IO.Class (MonadIO(..)) -import Control.Monad.Trans.Class (MonadTrans(..)) -import Control.Monad.Trans.Except (ExceptT) -import Control.Monad.Trans.Reader (ReaderT, asks) -import qualified Data.HashMap.Strict as HashMap -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import Language.GraphQL.AST (Name) -import Language.GraphQL.Type.Definition -import Prelude hiding (lookup) - --- | Resolution context holds resolver arguments. -data Context = Context - { arguments :: Arguments - , values :: Value - } - --- | Monad transformer stack used by the resolvers to provide error handling --- and resolution context (resolver arguments). --- --- Resolves a 'Field' into a 'Value' with error information (if an error has --- occurred). @m@ is an arbitrary monad, usually 'IO'. --- --- Resolving a field can result in a leaf value or an object, which is --- represented as a list of nested resolvers, used to resolve the fields of that --- object. -newtype ResolverT m a = ResolverT - { runResolverT :: ExceptT Text (ReaderT Context m) a - } - -instance Functor m => Functor (ResolverT m) where - fmap f = ResolverT . fmap f . runResolverT - -instance Monad m => Applicative (ResolverT m) where - pure = ResolverT . pure - (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x - -instance Monad m => Monad (ResolverT m) where - return = pure - (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f - -instance MonadTrans ResolverT where - lift = ResolverT . lift . lift - -instance MonadIO m => MonadIO (ResolverT m) where - liftIO = lift . liftIO - -instance Monad m => Alternative (ResolverT m) where - empty = ResolverT empty - (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y - -instance Monad m => MonadPlus (ResolverT m) where - mzero = empty - mplus = (<|>) - --- | Retrieves an argument by its name. If the argument with this name couldn't --- be found, returns 'Null' (i.e. the argument is assumed to --- be optional then). -argument :: Monad m => Name -> ResolverT m Value -argument argumentName = do - argumentValue <- ResolverT $ lift $ asks $ lookup . arguments - pure $ fromMaybe Null argumentValue - where - lookup (Arguments argumentMap) = HashMap.lookup argumentName argumentMap diff --git a/src/Language/GraphQL/Type.hs b/src/Language/GraphQL/Type.hs index 5dfd622..0a30924 100644 --- a/src/Language/GraphQL/Type.hs +++ b/src/Language/GraphQL/Type.hs @@ -2,10 +2,13 @@ module Language.GraphQL.Type ( In.InputField(..) , In.InputObjectType(..) + , Out.Context(..) , Out.Field(..) , Out.InterfaceType(..) , Out.ObjectType(..) + , Out.ResolverT(..) , Out.UnionType(..) + , Out.argument , module Language.GraphQL.Type.Definition , module Language.GraphQL.Type.Schema ) where diff --git a/src/Language/GraphQL/Type/Out.hs b/src/Language/GraphQL/Type/Out.hs index 0f14ce8..97107ca 100644 --- a/src/Language/GraphQL/Type/Out.hs +++ b/src/Language/GraphQL/Type/Out.hs @@ -2,16 +2,20 @@ {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ViewPatterns #-} --- | Output types and values. +-- | Output types and values, monad transformer stack used by the @GraphQL@ +-- resolvers. -- -- This module is intended to be imported qualified, to avoid name clashes -- with 'Language.GraphQL.Type.In'. module Language.GraphQL.Type.Out - ( Field(..) + ( Context(..) + , Field(..) , InterfaceType(..) , ObjectType(..) + , ResolverT(..) , Type(..) , UnionType(..) + , argument , isNonNullType , pattern EnumBaseType , pattern InterfaceBaseType @@ -21,10 +25,17 @@ module Language.GraphQL.Type.Out , pattern UnionBaseType ) where +import Control.Applicative (Alternative(..)) +import Control.Monad (MonadPlus(..)) +import Control.Monad.IO.Class (MonadIO(..)) +import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Reader (ReaderT, asks) import Data.HashMap.Strict (HashMap) +import qualified Data.HashMap.Strict as HashMap +import Data.Maybe (fromMaybe) import Data.Text (Text) import Language.GraphQL.AST (Name) -import Language.GraphQL.Trans import Language.GraphQL.Type.Definition import qualified Language.GraphQL.Type.In as In @@ -157,3 +168,58 @@ isNonNullType (NonNullInterfaceType _) = True isNonNullType (NonNullUnionType _) = True isNonNullType (NonNullListType _) = True isNonNullType _ = False + +-- | Resolution context holds resolver arguments. +data Context = Context + { arguments :: Arguments + , values :: Value + } + +-- | Monad transformer stack used by the resolvers to provide error handling +-- and resolution context (resolver arguments). +-- +-- Resolves a 'Field' into a 'Value' with error information (if an error has +-- occurred). @m@ is an arbitrary monad, usually 'IO'. +-- +-- Resolving a field can result in a leaf value or an object, which is +-- represented as a list of nested resolvers, used to resolve the fields of that +-- object. +newtype ResolverT m a = ResolverT + { runResolverT :: ExceptT Text (ReaderT Context m) a + } + +instance Functor m => Functor (ResolverT m) where + fmap f = ResolverT . fmap f . runResolverT + +instance Monad m => Applicative (ResolverT m) where + pure = ResolverT . pure + (ResolverT f) <*> (ResolverT x) = ResolverT $ f <*> x + +instance Monad m => Monad (ResolverT m) where + return = pure + (ResolverT action) >>= f = ResolverT $ action >>= runResolverT . f + +instance MonadTrans ResolverT where + lift = ResolverT . lift . lift + +instance MonadIO m => MonadIO (ResolverT m) where + liftIO = lift . liftIO + +instance Monad m => Alternative (ResolverT m) where + empty = ResolverT empty + (ResolverT x) <|> (ResolverT y) = ResolverT $ x <|> y + +instance Monad m => MonadPlus (ResolverT m) where + mzero = empty + mplus = (<|>) + +-- | Retrieves an argument by its name. If the argument with this name couldn't +-- be found, returns 'Null' (i.e. the argument is assumed to +-- be optional then). +argument :: Monad m => Name -> ResolverT m Value +argument argumentName = do + argumentValue <- ResolverT $ lift $ asks $ lookupArgument . arguments + pure $ fromMaybe Null argumentValue + where + lookupArgument (Arguments argumentMap) = + HashMap.lookup argumentName argumentMap diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index d0806f9..dacd0cd 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -21,7 +21,7 @@ import Control.Applicative (Alternative(..), liftA2) import Control.Monad.Trans.Except (throwE) import Data.Maybe (catMaybes) import Data.Text (Text) -import Language.GraphQL.Trans +import Language.GraphQL.Type -- * Data -- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 0b5971b..cf18eca 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -11,7 +11,6 @@ import Data.Functor.Identity (Identity) import qualified Data.HashMap.Strict as HashMap import Data.Maybe (catMaybes) import Data.Text (Text) -import Language.GraphQL.Trans import Language.GraphQL.Type import qualified Language.GraphQL.Type.In as In import qualified Language.GraphQL.Type.Out as Out |