prescientmoon/graphql
1
0
Fork 0
forked from OSS/graphql
Code Pull Requests Activity

Merge Trans and Type.Out modules

Browse Source
This commit is contained in:
Eugen Wissner
2020-07-02 07:33:03 +02:00
parent 8b164c4844
commit 2f4310268a
10 changed files with 112 additions and 114 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
.gitignore vendored
View File

@@ -12,3 +12,5 @@ cabal.project.local
# GHC
*.hi
*.o
/docs/tutorial/tutorial

6
CHANGELOG.md
View File

@@ -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.

6
README.md
View File

@@ -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

49
docs/tutorial/tutorial.lhs
View File

@@ -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

12
src/Language/GraphQL/Execute/Execution.hs
View File

@@ -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

73
src/Language/GraphQL/Trans.hs
View File

@@ -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

3
src/Language/GraphQL/Type.hs
View File

@@ -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

72
src/Language/GraphQL/Type/Out.hs
View File

@@ -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

2
tests/Test/StarWars/Data.hs
View File

@@ -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

1
tests/Test/StarWars/Schema.hs
View File

@@ -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