Merge branch 'all-improvements'

This adds general API documentation, a tutorial and error handling.
This commit is contained in:
Danny Navarro 2016-03-15 14:02:34 +01:00
commit 77853b17ae
15 changed files with 710 additions and 49 deletions

View File

@ -1,6 +1,7 @@
-- | This module provides the functions to parse and execute @GraphQL@ queries.
module Data.GraphQL where module Data.GraphQL where
import Control.Applicative (Alternative, empty) import Control.Applicative (Alternative)
import Data.Text (Text) import Data.Text (Text)
@ -11,10 +12,23 @@ import Data.GraphQL.Execute
import Data.GraphQL.Parser import Data.GraphQL.Parser
import Data.GraphQL.Schema import Data.GraphQL.Schema
import Data.GraphQL.Error
-- | Takes a 'Schema' and text representing a @GraphQL@ request document.
-- If the text parses correctly as a @GraphQL@ query the query is
-- executed according to the given 'Schema'.
--
-- Returns the response as an @Aeson.@'Aeson.Value'.
graphql :: (Alternative m, Monad m) => Schema m -> Text -> m Aeson.Value graphql :: (Alternative m, Monad m) => Schema m -> Text -> m Aeson.Value
graphql = flip graphqlSubs $ const Nothing graphql = flip graphqlSubs $ const Nothing
-- | Takes a 'Schema', a variable substitution function and text
-- representing a @GraphQL@ request document. If the text parses
-- correctly as a @GraphQL@ query the substitution is applied to the
-- query and the query is then executed according to the given 'Schema'.
--
-- Returns the response as an @Aeson.@'Aeson.Value'.
graphqlSubs :: (Alternative m, Monad m) => Schema m -> Subs -> Text -> m Aeson.Value graphqlSubs :: (Alternative m, Monad m) => Schema m -> Subs -> Text -> m Aeson.Value
graphqlSubs schema f = graphqlSubs schema f =
either (const empty) (execute schema f) either parseError (execute schema f)
. Attoparsec.parseOnly document . Attoparsec.parseOnly document

View File

@ -1,3 +1,6 @@
-- | This module defines an abstract syntax tree for the @GraphQL@ language based on
-- <https://facebook.github.io/graphql/ Facebook's GraphQL Specification>.
module Data.GraphQL.AST where module Data.GraphQL.AST where
import Data.Int (Int32) import Data.Int (Int32)
@ -39,11 +42,26 @@ data Selection = SelectionField Field
| SelectionInlineFragment InlineFragment | SelectionInlineFragment InlineFragment
deriving (Eq,Show) deriving (Eq,Show)
-- | A 'SelectionSet' is primarily composed of 'Field's. A 'Field' describes one
-- discrete piece of information available to request within a 'SelectionSet'.
--
-- Some 'Field's describe complex data or relationships to other data. In
-- order to further explore this data, a 'Field' may itself contain a
-- 'SelectionSet', allowing for deeply nested requests. All @GraphQL@ operations
-- must specify their 'Selection's down to 'Field's which return scalar values to
-- ensure an unambiguously shaped response.
--
-- <https://facebook.github.io/graphql/#sec-Language.Query-Document.Fields Field Specification>
data Field = Field Alias Name [Argument] [Directive] SelectionSet data Field = Field Alias Name [Argument] [Directive] SelectionSet
deriving (Eq,Show) deriving (Eq,Show)
type Alias = Name type Alias = Name
-- | 'Field's are conceptually functions which return values, and occasionally accept
-- 'Argument's which alter their behavior. These 'Argument's often map directly to
-- function arguments within a @GraphQL@ servers implementation.
--
-- <https://facebook.github.io/graphql/#sec-Language.Query-Document.Arguments Argument Specification>
data Argument = Argument Name Value deriving (Eq,Show) data Argument = Argument Name Value deriving (Eq,Show)
-- * Fragments -- * Fragments
@ -63,6 +81,15 @@ type TypeCondition = NamedType
-- * Values -- * Values
-- | 'Field' and 'Directive' 'Arguments' accept input values of various literal
-- primitives; input values can be scalars, enumeration values, lists, or input
-- objects.
--
-- If not defined as constant (for example, in 'DefaultValue'), input values
-- can be specified as a 'Variable'. List and inputs objects may also contain
-- 'Variable's (unless defined to be constant).
--
-- <https://facebook.github.io/graphql/#sec-Input-Values Input Value Specification>
data Value = ValueVariable Variable data Value = ValueVariable Variable
| ValueInt Int32 | ValueInt Int32
-- GraphQL Float is double precison -- GraphQL Float is double precison

View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | This module defines a printer for the @GraphQL@ language.
module Data.GraphQL.Encoder where module Data.GraphQL.Encoder where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)

63
Data/GraphQL/Error.hs Normal file
View File

@ -0,0 +1,63 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Data.GraphQL.Error (
parseError,
CollectErrsT,
addErr,
addErrMsg,
runCollectErrs,
joinErrs,
errWrap
) where
import qualified Data.Aeson as Aeson
import Data.Text (Text, pack)
import Control.Arrow ((&&&))
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative (Applicative, pure)
import Data.Foldable (Foldable, concatMap)
import Prelude hiding (concatMap)
#endif
-- | Wraps a parse error into a list of errors.
parseError :: Applicative f => String -> f Aeson.Value
parseError s =
pure $ Aeson.object [("errors", Aeson.toJSON [makeErrorMsg $ pack s])]
-- | A wrapper for an 'Applicative' to pass error messages around.
type CollectErrsT f a = f (a,[Aeson.Value])
-- | Takes a (wrapped) list (foldable functor) of values and errors,
-- joins the values into a list and concatenates the errors.
joinErrs
:: (Functor m, Functor f, Foldable f)
=> m (f (a,[Aeson.Value])) -> CollectErrsT m (f a)
joinErrs = fmap $ fmap fst &&& concatMap snd
-- | Wraps the given 'Applicative' to handle errors
errWrap :: Functor f => f a -> f (a, [Aeson.Value])
errWrap = fmap (flip (,) [])
-- | Adds an error to the list of errors.
addErr :: Functor f => Aeson.Value -> CollectErrsT f a -> CollectErrsT f a
addErr v = (fmap . fmap) (v :)
makeErrorMsg :: Text -> Aeson.Value
makeErrorMsg s = Aeson.object [("message",Aeson.toJSON s)]
-- | Convenience function for just wrapping an error message.
addErrMsg :: Functor f => Text -> CollectErrsT f a -> CollectErrsT f a
addErrMsg = addErr . makeErrorMsg
-- | Runs the given query, but collects the errors into an error
-- list which is then sent back with the data.
runCollectErrs :: Functor f => CollectErrsT f Aeson.Value -> f Aeson.Value
runCollectErrs = fmap finalD
where
finalD (dat,errs) =
Aeson.object
$ if null errs
then [("data",dat)]
else [("data",dat),("errors",Aeson.toJSON $ reverse errs)]

View File

@ -1,4 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
-- | This module provides the function to execute a @GraphQL@ request --
-- according to a 'Schema'.
module Data.GraphQL.Execute (execute) where module Data.GraphQL.Execute (execute) where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
@ -13,16 +15,32 @@ import Data.GraphQL.AST
import Data.GraphQL.Schema (Schema(..)) import Data.GraphQL.Schema (Schema(..))
import qualified Data.GraphQL.Schema as Schema import qualified Data.GraphQL.Schema as Schema
execute import Data.GraphQL.Error
:: Alternative f
=> Schema.Schema f -> Schema.Subs -> Document -> f Aeson.Value
execute (Schema resolvs) subs = Schema.resolvers resolvs . rootFields subs
-- | Takes a 'Schema', a variable substitution function ('Schema.Subs'), and a
-- @GraphQL@ 'document'. The substitution is applied to the document using
-- 'rootFields', and the 'Schema''s resolvers are applied to the resulting fields.
--
-- Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
-- errors wrapped in an /errors/ field.
execute :: Alternative f
=> Schema.Schema f -> Schema.Subs -> Document -> f Aeson.Value
execute (Schema resolvs) subs doc = runCollectErrs res
where res = Schema.resolvers resolvs $ rootFields subs doc
-- | Takes a variable substitution function and a @GraphQL@ document.
-- If the document contains one query (and no other definitions)
-- it applies the substitution to the query's set of selections
-- and then returns their fields.
rootFields :: Schema.Subs -> Document -> [Field] rootFields :: Schema.Subs -> Document -> [Field]
rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) = rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) =
Schema.fields $ substitute subs <$> sels Schema.fields $ substitute subs <$> sels
rootFields _ _ = [] rootFields _ _ = []
-- | Takes a variable substitution function and a selection. If the
-- selection is a field it applies the substitution to the field's
-- arguments using 'subsArg', and recursively applies the substitution to
-- the arguments of fields nested in the primary field.
substitute :: Schema.Subs -> Selection -> Selection substitute :: Schema.Subs -> Selection -> Selection
substitute subs (SelectionField (Field alias name args directives sels)) = substitute subs (SelectionField (Field alias name args directives sels)) =
SelectionField $ Field SelectionField $ Field
@ -35,6 +53,9 @@ substitute subs (SelectionField (Field alias name args directives sels)) =
substitute _ sel = sel substitute _ sel = sel
-- TODO: Support different value types -- TODO: Support different value types
-- | Takes a variable substitution function and an argument. If the
-- argument's value is a variable the substitution is applied to the
-- variable's name.
subsArg :: Schema.Subs -> Argument -> Maybe Argument subsArg :: Schema.Subs -> Argument -> Maybe Argument
subsArg subs (Argument n (ValueVariable (Variable v))) = subsArg subs (Argument n (ValueVariable (Variable v))) =
Argument n . ValueString <$> subs v Argument n . ValueString <$> subs v

View File

@ -1,5 +1,6 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
-- | This module defines a parser for @GraphQL@ request documents.
module Data.GraphQL.Parser where module Data.GraphQL.Parser where
import Prelude hiding (takeWhile) import Prelude hiding (takeWhile)

View File

@ -1,5 +1,8 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
-- | This module provides a representation of a @GraphQL@ Schema in addition to
-- functions for defining and manipulating Schemas.
module Data.GraphQL.Schema module Data.GraphQL.Schema
( Schema(..) ( Schema(..)
, Resolver , Resolver
@ -21,14 +24,16 @@ module Data.GraphQL.Schema
) where ) where
#if !MIN_VERSION_base(4,8,0) #if !MIN_VERSION_base(4,8,0)
import Control.Applicative (pure, (<|>)) import Control.Applicative (pure)
import Control.Arrow (first)
import Data.Foldable (foldMap) import Data.Foldable (foldMap)
import Data.Traversable (traverse) import Data.Traversable (traverse)
import Data.Monoid (Monoid(mempty,mappend)) import Data.Monoid (Monoid(mempty,mappend))
#else #else
import Data.Bifunctor (first)
import Data.Monoid (Alt(Alt,getAlt)) import Data.Monoid (Alt(Alt,getAlt))
#endif #endif
import Control.Applicative (Alternative, empty) import Control.Applicative (Alternative((<|>), empty))
import Data.Maybe (catMaybes) import Data.Maybe (catMaybes)
import Data.Foldable (fold) import Data.Foldable (fold)
@ -36,77 +41,105 @@ import qualified Data.Aeson as Aeson
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T (null) import qualified Data.Text as T (null, unwords)
import Data.GraphQL.AST import Data.GraphQL.AST
import Data.GraphQL.Error
-- | A GraphQL schema.
-- @f@ is usually expected to be an instance of 'Alternative'.
data Schema f = Schema [Resolver f] data Schema f = Schema [Resolver f]
type Resolver f = Field -> f Aeson.Object -- | Resolves a 'Field' into an @Aeson.@'Aeson.Object' with error information
-- (or 'empty'). @f@ is usually expected to be an instance of 'Alternative'.
type Resolver f = Field -> CollectErrsT f Aeson.Object
-- | Variable substitution function.
type Subs = Text -> Maybe Text type Subs = Text -> Maybe Text
-- | Create a named 'Resolver' from a list of 'Resolver's.
object :: Alternative f => Text -> [Resolver f] -> Resolver f object :: Alternative f => Text -> [Resolver f] -> Resolver f
object name resolvs = objectA name $ \case object name resolvs = objectA name $ \case
[] -> resolvs [] -> resolvs
_ -> empty _ -> empty
-- | Like 'object' but also taking 'Argument's.
objectA objectA
:: Alternative f :: Alternative f
=> Text -> ([Argument] -> [Resolver f]) -> Resolver f => Text -> ([Argument] -> [Resolver f]) -> Resolver f
objectA name f fld@(Field _ _ args _ sels) = objectA name f fld@(Field _ _ args _ sels) =
withField name (resolvers (f args) $ fields sels) fld withField name (resolvers (f args) $ fields sels) fld
-- | A scalar represents a primitive value, like a string or an integer.
scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f scalar :: (Alternative f, Aeson.ToJSON a) => Text -> a -> Resolver f
scalar name s = scalarA name $ \case scalar name s = scalarA name $ \case
[] -> pure s [] -> pure s
_ -> empty _ -> empty
-- | Like 'scalar' but also taking 'Argument's.
scalarA scalarA
:: (Alternative f, Aeson.ToJSON a) :: (Alternative f, Aeson.ToJSON a)
=> Text -> ([Argument] -> f a) -> Resolver f => Text -> ([Argument] -> f a) -> Resolver f
scalarA name f fld@(Field _ _ args _ []) = withField name (f args) fld scalarA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld
scalarA _ _ _ = empty scalarA _ _ _ = empty
-- | Like 'object' but taking lists of 'Resolver's instead of a single list.
array :: Alternative f => Text -> [[Resolver f]] -> Resolver f array :: Alternative f => Text -> [[Resolver f]] -> Resolver f
array name resolvs = arrayA name $ \case array name resolvs = arrayA name $ \case
[] -> resolvs [] -> resolvs
_ -> empty _ -> empty
-- | Like 'array' but also taking 'Argument's.
arrayA arrayA
:: Alternative f :: Alternative f
=> Text -> ([Argument] -> [[Resolver f]]) -> Resolver f => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f
arrayA name f fld@(Field _ _ args _ sels) = arrayA name f fld@(Field _ _ args _ sels) =
withField name (traverse (flip resolvers $ fields sels) $ f args) fld withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ f args) fld
-- | Represents one of a finite set of possible values.
-- Used in place of a 'scalar' when the possible responses are easily enumerable.
enum :: Alternative f => Text -> f [Text] -> Resolver f enum :: Alternative f => Text -> f [Text] -> Resolver f
enum name enums = enumA name $ \case enum name enums = enumA name $ \case
[] -> enums [] -> enums
_ -> empty _ -> empty
-- | Like 'enum' but also taking 'Argument's.
enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f
enumA name f fld@(Field _ _ args _ []) = withField name (f args) fld enumA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld
enumA _ _ _ = empty enumA _ _ _ = empty
-- | Helper function to facilitate 'Argument' handling.
withField withField
:: (Alternative f, Aeson.ToJSON a) :: (Alternative f, Aeson.ToJSON a)
=> Text -> f a -> Field -> f (HashMap Text Aeson.Value) => Text -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value)
withField name f (Field alias name' _ _ _) = withField name f (Field alias name' _ _ _) =
if name == name' if name == name'
then fmap (HashMap.singleton aliasOrName . Aeson.toJSON) f then fmap (first $ HashMap.singleton aliasOrName . Aeson.toJSON) f
else empty else empty
where where
aliasOrName = if T.null alias then name' else alias aliasOrName = if T.null alias then name' else alias
resolvers :: Alternative f => [Resolver f] -> [Field] -> f Aeson.Value -- | Takes a list of 'Resolver's and a list of 'Field's and applies each
-- 'Resolver' to each 'Field'. Resolves into a value containing the
-- resolved 'Field', or a null value and error information.
resolvers :: Alternative f => [Resolver f] -> [Field] -> CollectErrsT f Aeson.Value
resolvers resolvs = resolvers resolvs =
fmap (Aeson.toJSON . fold) fmap (first Aeson.toJSON . fold)
. traverse (\fld -> getAlt $ foldMap (Alt . ($ fld)) resolvs) . traverse (\fld -> getAlt (foldMap (Alt . ($ fld)) resolvs) <|> errmsg fld)
where
errmsg (Field alias name _ _ _) = addErrMsg msg $ (errWrap . pure) val
where
val = HashMap.singleton aliasOrName Aeson.Null
msg = T.unwords ["field", name, "not resolved."]
aliasOrName = if T.null alias then name else alias
-- | Checks whether the given 'Selection' contains a 'Field' and
-- returns the 'Field' if so, else returns 'Nothing'.
field :: Selection -> Maybe Field field :: Selection -> Maybe Field
field (SelectionField x) = Just x field (SelectionField x) = Just x
field _ = Nothing field _ = Nothing
-- | Returns a list of the 'Field's contained in the given 'SelectionSet'.
fields :: SelectionSet -> [Field] fields :: SelectionSet -> [Field]
fields = catMaybes . fmap field fields = catMaybes . fmap field

4
docs/tutorial/Makefile Normal file
View File

@ -0,0 +1,4 @@
default:
pandoc -f markdown+lhs+yaml_metadata_block --highlight-style=haddock -S -c "https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css" --section-divs -c tutorial.css --toc --standalone -t html5 -o tutorial.html tutorial.lhs
pandoc -f markdown+lhs+yaml_metadata_block --highlight-style=haddock --toc --standalone -t rst -o tutorial.rst tutorial.lhs
pandoc -f markdown+lhs+yaml_metadata_block --highlight-style=haddock --toc --standalone -t latex -o tutorial.pdf tutorial.lhs

View File

@ -0,0 +1,3 @@
body {
padding: 0 20px;
}

165
docs/tutorial/tutorial.html Normal file
View File

@ -0,0 +1,165 @@
<!DOCTYPE html>
<html>
<head>
<meta charset="utf-8">
<meta name="generator" content="pandoc">
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes">
<title>GraphQL Haskell Tutorial</title>
<style type="text/css">code{white-space: pre;}</style>
<style type="text/css">
div.sourceCode { overflow-x: auto; }
table.sourceCode, tr.sourceCode, td.lineNumbers, td.sourceCode {
margin: 0; padding: 0; vertical-align: baseline; border: none; }
table.sourceCode { width: 100%; line-height: 100%; }
td.lineNumbers { text-align: right; padding-right: 4px; padding-left: 4px; color: #aaaaaa; border-right: 1px solid #aaaaaa; }
td.sourceCode { padding-left: 5px; }
code > span.kw { color: #0000ff; } /* Keyword */
code > span.ch { color: #008080; } /* Char */
code > span.st { color: #008080; } /* String */
code > span.co { color: #008000; } /* Comment */
code > span.ot { color: #ff4000; } /* Other */
code > span.al { color: #ff0000; } /* Alert */
code > span.er { color: #ff0000; font-weight: bold; } /* Error */
code > span.wa { color: #008000; font-weight: bold; } /* Warning */
code > span.cn { } /* Constant */
code > span.sc { color: #008080; } /* SpecialChar */
code > span.vs { color: #008080; } /* VerbatimString */
code > span.ss { color: #008080; } /* SpecialString */
code > span.im { } /* Import */
code > span.va { } /* Variable */
code > span.cf { color: #0000ff; } /* ControlFlow */
code > span.op { } /* Operator */
code > span.bu { } /* BuiltIn */
code > span.ex { } /* Extension */
code > span.pp { color: #ff4000; } /* Preprocessor */
code > span.do { color: #008000; } /* Documentation */
code > span.an { color: #008000; } /* Annotation */
code > span.cv { color: #008000; } /* CommentVar */
code > span.at { } /* Attribute */
code > span.in { color: #008000; } /* Information */
</style>
<link rel="stylesheet" href="https://maxcdn.bootstrapcdn.com/bootstrap/3.3.6/css/bootstrap.min.css">
<link rel="stylesheet" href="tutorial.css">
<!--[if lt IE 9]>
<script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
<![endif]-->
</head>
<body>
<header>
<h1 class="title">GraphQL Haskell Tutorial</h1>
</header>
<nav id="TOC">
<ul>
<li><a href="#getting-started">Getting started</a><ul>
<li><a href="#first-example">First example</a></li>
<li><a href="#monadic-actions">Monadic actions</a></li>
<li><a href="#errors">Errors</a></li>
<li><a href="#combining-resolvers">Combining resolvers</a></li>
</ul></li>
<li><a href="#further-examples">Further examples</a></li>
</ul>
</nav>
<section id="getting-started" class="level2">
<h2>Getting started</h2>
<p>Welcome to graphql-haskell!</p>
<p>We have written a small tutorial to help you (and ourselves) understand the graphql package.</p>
<p>Since this file is a literate haskell file, we start by importing some dependencies.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">{-# LANGUAGE OverloadedStrings #-}</span>
<span class="ot">{-# LANGUAGE LambdaCase #-}</span>
<span class="kw">module</span> <span class="dt">Main</span> <span class="kw">where</span>
<span class="kw">import </span><span class="dt">Prelude</span> <span class="kw">hiding</span> (empty, putStrLn)
<span class="kw">import </span><span class="dt">Data.GraphQL</span>
<span class="kw">import </span><span class="dt">Data.GraphQL.Schema</span>
<span class="kw">import qualified</span> <span class="dt">Data.GraphQL.Schema</span> <span class="kw">as</span> <span class="dt">Schema</span>
<span class="kw">import </span><span class="dt">Control.Applicative</span>
<span class="kw">import </span><span class="dt">Data.Text</span> <span class="kw">hiding</span> (empty)
<span class="kw">import </span><span class="dt">Data.Aeson</span>
<span class="kw">import </span><span class="dt">Data.ByteString.Lazy.Char8</span> (putStrLn)
<span class="kw">import </span><span class="dt">Data.Time</span>
<span class="kw">import </span><span class="dt">Debug.Trace</span></code></pre></div>
<section id="first-example" class="level3">
<h3>First example</h3>
<p>Now, as our first example, we are going to look at the example from <a href="https://github.com/graphql/graphql-js">graphql.js</a>.</p>
<p>First we build a GraphQL schema.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">schema1 ::</span> <span class="dt">Alternative</span> f <span class="ot">=&gt;</span> <span class="dt">Schema</span> f
schema1 <span class="fu">=</span> <span class="dt">Schema</span> [hello]
<span class="ot">hello ::</span> <span class="dt">Alternative</span> f <span class="ot">=&gt;</span> <span class="dt">Resolver</span> f
hello <span class="fu">=</span> Schema.scalar <span class="st">&quot;hello&quot;</span> (<span class="st">&quot;it&#39;s me&quot;</span><span class="ot"> ::</span> <span class="dt">Text</span>)</code></pre></div>
<p>This defines a simple schema with one type and one field, that resolves to a fixed value.</p>
<p>Next we define our query.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">query1 ::</span> <span class="dt">Text</span>
query1 <span class="fu">=</span> <span class="st">&quot;{ hello }&quot;</span></code></pre></div>
<p>To run the query, we call the <code>graphql</code> with the schema and the query.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">main1 ::</span> <span class="dt">IO</span> ()
main1 <span class="fu">=</span> putStrLn <span class="fu">=&lt;&lt;</span> encode <span class="fu">&lt;$&gt;</span> graphql schema1 query1</code></pre></div>
<p>This runs the query by fetching the one field defined, returning</p>
<p><code>{&quot;data&quot; : {&quot;hello&quot;:&quot;it's me&quot;}}</code></p>
</section>
<section id="monadic-actions" class="level3">
<h3>Monadic actions</h3>
<p>For this example, were going to be using time.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">schema2 ::</span> <span class="dt">Schema</span> <span class="dt">IO</span>
schema2 <span class="fu">=</span> <span class="dt">Schema</span> [time]
<span class="ot">time ::</span> <span class="dt">Resolver</span> <span class="dt">IO</span>
time <span class="fu">=</span> Schema.scalarA <span class="st">&quot;time&quot;</span> <span class="fu">$</span> \<span class="kw">case</span>
[] <span class="ot">-&gt;</span> <span class="kw">do</span> t <span class="ot">&lt;-</span> getCurrentTime
return <span class="fu">$</span> show t
_ <span class="ot">-&gt;</span> empty</code></pre></div>
<p>This defines a simple schema with one type and one field, which resolves to the current time.</p>
<p>Next we define our query.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">query2 ::</span> <span class="dt">Text</span>
query2 <span class="fu">=</span> <span class="st">&quot;{ time }&quot;</span>
<span class="ot">main2 ::</span> <span class="dt">IO</span> ()
main2 <span class="fu">=</span> putStrLn <span class="fu">=&lt;&lt;</span> encode <span class="fu">&lt;$&gt;</span> graphql schema2 query2</code></pre></div>
<p>This runs the query, returning the current time</p>
<p><code>{&quot;data&quot;: {&quot;time&quot;:&quot;2016-03-08 23:28:14.546899 UTC&quot;}}</code></p>
</section>
<section id="errors" class="level3">
<h3>Errors</h3>
<p>Errors are handled according to the spec, with fields that cause erros being resolved to <code>null</code>, and an error being added to the error list.</p>
<p>An example of this is the following query:</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">queryShouldFail ::</span> <span class="dt">Text</span>
queryShouldFail <span class="fu">=</span> <span class="st">&quot;{ boyhowdy }&quot;</span></code></pre></div>
<p>Since there is no <code>boyhowdy</code> field in our schema, it will not resolve, and the query will fail, as we can see in the following example.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">mainShouldFail ::</span> <span class="dt">IO</span> ()
mainShouldFail <span class="fu">=</span> <span class="kw">do</span>
r <span class="ot">&lt;-</span> graphql schema1 query1
putStrLn <span class="fu">$</span> encode r
putStrLn <span class="st">&quot;This will fail&quot;</span>
r <span class="ot">&lt;-</span> graphql schema1 queryShouldFail
putStrLn <span class="fu">$</span> encode r</code></pre></div>
<p>This outputs:</p>
<pre><code>{&quot;data&quot;: {&quot;hello&quot;: &quot;it&#39;s me&quot;}}
This will fail
{&quot;data&quot;: {&quot;boyhowdy&quot;: null}, &quot;errors&quot;:[{&quot;message&quot;: &quot;the field boyhowdy did not resolve.&quot;}]}</code></pre>
</section>
<section id="combining-resolvers" class="level3">
<h3>Combining resolvers</h3>
<p>Now that we have two resolvers, we can define a schema which uses them both.</p>
<div class="sourceCode"><pre class="sourceCode literate haskell"><code class="sourceCode haskell"><span class="ot">schema3 ::</span> <span class="dt">Schema</span> <span class="dt">IO</span>
schema3 <span class="fu">=</span> <span class="dt">Schema</span> [hello, time]
<span class="ot">query3 ::</span> <span class="dt">Text</span>
query3 <span class="fu">=</span> <span class="st">&quot;query timeAndHello { time hello }&quot;</span>
<span class="ot">main3 ::</span> <span class="dt">IO</span> ()
main3 <span class="fu">=</span> putStrLn <span class="fu">=&lt;&lt;</span> encode <span class="fu">&lt;$&gt;</span> graphql schema3 query3</code></pre></div>
<p>This queries for both time and hello, returning</p>
<p><code>{ &quot;data&quot;: {&quot;hello&quot;:&quot;it's me&quot;,&quot;time&quot;:&quot;2016-03-08 23:29:11.62108 UTC&quot;}}</code></p>
<p>Notice that we can name our queries, as we did with <code>timeAndHello</code>. Since we have only been using single queries, we can use the shorthand <code>{ time hello}</code>, as we have been doing in the previous examples.</p>
<p>In GraphQL there can only be one operation per query.</p>
</section>
</section>
<section id="further-examples" class="level2">
<h2>Further examples</h2>
<p>More examples on queries and a more complex schema can be found in the test directory, in the <a href="../../tests/Test/StarWars">Test.StarWars</a> module. This includes a more complex schema, and more complex queries.</p>
</section>
</body>
</html>

150
docs/tutorial/tutorial.lhs Normal file
View File

@ -0,0 +1,150 @@
---
title: GraphQL Haskell Tutorial
---
== Getting started ==
Welcome to graphql-haskell!
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.
> {-# LANGUAGE OverloadedStrings #-}
> {-# LANGUAGE LambdaCase #-}
> module Main where
>
> import Prelude hiding (empty, putStrLn)
> import Data.GraphQL
> import Data.GraphQL.Schema
> import qualified Data.GraphQL.Schema as Schema
>
> import Control.Applicative
> import Data.Text hiding (empty)
> import Data.Aeson
> import Data.ByteString.Lazy.Char8 (putStrLn)
>
> import Data.Time
>
> import Debug.Trace
=== First example ===
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.
> schema1 :: Alternative f => Schema f
> schema1 = Schema [hello]
>
> hello :: Alternative f => Resolver f
> hello = Schema.scalar "hello" ("it's me" :: Text)
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 = putStrLn =<< encode <$> graphql schema1 query1
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.
> schema2 :: Schema IO
> schema2 = Schema [time]
>
> time :: Resolver IO
> time = Schema.scalarA "time" $ \case
> [] -> do t <- getCurrentTime
> return $ show t
> _ -> empty
This defines a simple schema with one type and one field,
which resolves to the current time.
Next we define our query.
> query2 :: Text
> query2 = "{ time }"
>
> main2 :: IO ()
> main2 = putStrLn =<< encode <$> graphql schema2 query2
This runs the query, returning the current time
```{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}```
=== 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.
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.
> mainShouldFail :: IO ()
> mainShouldFail = do
> r <- graphql schema1 query1
> putStrLn $ encode r
> putStrLn "This will fail"
> r <- graphql schema1 queryShouldFail
> putStrLn $ encode r
>
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.
> schema3 :: Schema IO
> schema3 = Schema [hello, time]
>
> query3 :: Text
> query3 = "query timeAndHello { time hello }"
>
> main3 :: IO ()
> main3 = putStrLn =<< encode <$> graphql schema3 query3
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.
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.

BIN
docs/tutorial/tutorial.pdf Normal file

Binary file not shown.

176
docs/tutorial/tutorial.rst Normal file
View File

@ -0,0 +1,176 @@
========================
GraphQL Haskell Tutorial
========================
.. contents::
:depth: 3
..
Getting started
===============
Welcome to graphql-haskell!
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.
.. code:: haskell
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
module Main where
import Prelude hiding (empty, putStrLn)
import Data.GraphQL
import Data.GraphQL.Schema
import qualified Data.GraphQL.Schema as Schema
import Control.Applicative
import Data.Text hiding (empty)
import Data.Aeson
import Data.ByteString.Lazy.Char8 (putStrLn)
import Data.Time
import Debug.Trace
First example
-------------
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.
.. code:: haskell
schema1 :: Alternative f => Schema f
schema1 = Schema [hello]
hello :: Alternative f => Resolver f
hello = Schema.scalar "hello" ("it's me" :: Text)
This defines a simple schema with one type and one field, that resolves
to a fixed value.
Next we define our query.
.. code:: haskell
query1 :: Text
query1 = "{ hello }"
To run the query, we call the ``graphql`` with the schema and the query.
.. code:: haskell
main1 :: IO ()
main1 = putStrLn =<< encode <$> graphql schema1 query1
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.
.. code:: haskell
schema2 :: Schema IO
schema2 = Schema [time]
time :: Resolver IO
time = Schema.scalarA "time" $ \case
[] -> do t <- getCurrentTime
return $ show t
_ -> empty
This defines a simple schema with one type and one field, which resolves
to the current time.
Next we define our query.
.. code:: haskell
query2 :: Text
query2 = "{ time }"
main2 :: IO ()
main2 = putStrLn =<< encode <$> graphql schema2 query2
This runs the query, returning the current time
``{"data": {"time":"2016-03-08 23:28:14.546899 UTC"}}``
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.
An example of this is the following query:
.. code:: haskell
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.
.. code:: haskell
mainShouldFail :: IO ()
mainShouldFail = do
r <- graphql schema1 query1
putStrLn $ encode r
putStrLn "This will fail"
r <- graphql schema1 queryShouldFail
putStrLn $ encode r
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.
.. code:: haskell
schema3 :: Schema IO
schema3 = Schema [hello, time]
query3 :: Text
query3 = "query timeAndHello { time hello }"
main3 :: IO ()
main3 = putStrLn =<< encode <$> graphql schema3 query3
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.
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.

View File

@ -16,6 +16,7 @@ build-type: Simple
cabal-version: >=1.10 cabal-version: >=1.10
tested-with: GHC == 7.8.4, GHC == 7.10.3 tested-with: GHC == 7.8.4, GHC == 7.10.3
extra-source-files: README.md CHANGELOG.md stack.yaml extra-source-files: README.md CHANGELOG.md stack.yaml
docs/tutorial/tutorial.lhs
data-files: tests/data/*.graphql data-files: tests/data/*.graphql
tests/data/*.min.graphql tests/data/*.min.graphql
@ -28,10 +29,11 @@ library
Data.GraphQL.Execute Data.GraphQL.Execute
Data.GraphQL.Schema Data.GraphQL.Schema
Data.GraphQL.Parser Data.GraphQL.Parser
build-depends: base >= 4.7 && < 5, Data.GraphQL.Error
text >= 0.11.3.1, build-depends: aeson >= 0.7.0.3,
aeson >= 0.7.0.3,
attoparsec >= 0.10.4.0, attoparsec >= 0.10.4.0,
base >= 4.7 && < 5,
text >= 0.11.3.1,
unordered-containers >= 0.2.5.0 unordered-containers >= 0.2.5.0
test-suite tasty test-suite tasty
@ -44,15 +46,15 @@ test-suite tasty
Test.StarWars.Data Test.StarWars.Data
Test.StarWars.Schema Test.StarWars.Schema
Test.StarWars.QueryTests Test.StarWars.QueryTests
build-depends: base >= 4.6 && <5, build-depends: aeson >= 0.7.0.3,
aeson >= 0.7.0.3,
text >= 0.11.3.1,
attoparsec >= 0.10.4.0, attoparsec >= 0.10.4.0,
base >= 4.6 && <5,
graphql,
raw-strings-qq >= 1.1, raw-strings-qq >= 1.1,
tasty >= 0.10, tasty >= 0.10,
tasty-hunit >= 0.9, tasty-hunit >= 0.9,
unordered-containers >= 0.2.5.0, text >= 0.11.3.1,
graphql unordered-containers >= 0.2.5.0
source-repository head source-repository head
type: git type: git

View File

@ -2,7 +2,7 @@
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
module Test.StarWars.QueryTests (test) where module Test.StarWars.QueryTests (test) where
import qualified Data.Aeson as Aeson (Value) import qualified Data.Aeson as Aeson (Value(Null), toJSON)
import Data.Aeson (object, (.=)) import Data.Aeson (object, (.=))
import Data.Text (Text) import Data.Text (Text)
import Text.RawString.QQ (r) import Text.RawString.QQ (r)
@ -28,7 +28,7 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object ["hero" .= object ["id" .= ("2001" :: Text)]] $ object [ "data" .= object ["hero" .= object ["id" .= ("2001" :: Text)]]]
, testCase "R2-D2 ID and friends" . testQuery , testCase "R2-D2 ID and friends" . testQuery
[r| query HeroNameAndFriendsQuery { [r| query HeroNameAndFriendsQuery {
hero { hero {
@ -40,7 +40,7 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"hero" .= object [ "hero" .= object [
"id" .= ("2001" :: Text) "id" .= ("2001" :: Text)
, "name" .= ("R2-D2" :: Text) , "name" .= ("R2-D2" :: Text)
@ -50,7 +50,7 @@ test = testGroup "Star Wars Query Tests"
, object ["name" .= ("Leia Organa" :: Text)] , object ["name" .= ("Leia Organa" :: Text)]
] ]
] ]
] ]]
] ]
, testGroup "Nested Queries" , testGroup "Nested Queries"
[ testCase "R2-D2 friends" . testQuery [ testCase "R2-D2 friends" . testQuery
@ -67,7 +67,7 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"hero" .= object [ "hero" .= object [
"name" .= ("R2-D2" :: Text) "name" .= ("R2-D2" :: Text)
, "friends" .= [ , "friends" .= [
@ -102,7 +102,7 @@ test = testGroup "Star Wars Query Tests"
] ]
] ]
] ]
] ]]
, testCase "Luke ID" . testQuery , testCase "Luke ID" . testQuery
[r| query FetchLukeQuery { [r| query FetchLukeQuery {
human(id: "1000") { human(id: "1000") {
@ -110,12 +110,12 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"human" .= object [ "human" .= object [
"name" .= ("Luke Skywalker" :: Text) "name" .= ("Luke Skywalker" :: Text)
] ]
] ]
] ]]
, testCase "Luke ID with variable" . testQueryParams , testCase "Luke ID with variable" . testQueryParams
(\v -> if v == "someId" (\v -> if v == "someId"
then Just "1000" then Just "1000"
@ -126,9 +126,9 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"human" .= object ["name" .= ("Luke Skywalker" :: Text)] "human" .= object ["name" .= ("Luke Skywalker" :: Text)]
] ]]
, testCase "Han ID with variable" . testQueryParams , testCase "Han ID with variable" . testQueryParams
(\v -> if v == "someId" (\v -> if v == "someId"
then Just "1002" then Just "1002"
@ -139,10 +139,10 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"human" .= object ["name" .= ("Han Solo" :: Text)] "human" .= object ["name" .= ("Han Solo" :: Text)]
] ]]
, testCase "Invalid ID" $ testFailParams , testCase "Invalid ID" . testQueryParams
(\v -> if v == "id" (\v -> if v == "id"
then Just "Not a valid ID" then Just "Not a valid ID"
else Nothing) else Nothing)
@ -151,13 +151,14 @@ test = testGroup "Star Wars Query Tests"
name name
} }
} }
|] |] $ object ["data" .= object ["human" .= object ["name" .= Aeson.Null]],
"errors" .= (Aeson.toJSON [object ["message" .= ("field name not resolved." :: Text)]])]
-- TODO: This test is directly ported from `graphql-js`, however do we want -- TODO: This test is directly ported from `graphql-js`, however do we want
-- to mimic the same behavior? Is this part of the spec? Once proper -- to mimic the same behavior? Is this part of the spec? Once proper
-- exceptions are implemented this test might no longer be meaningful. -- exceptions are implemented this test might no longer be meaningful.
-- If the same behavior needs to be replicated, should it be implemented -- If the same behavior needs to be replicated, should it be implemented
-- when defining the `Schema` or when executing? -- when defining the `Schema` or when executing?
-- $ object ["human" .= Aeson.Null] -- $ object [ "data" .= object ["human" .= Aeson.Null] ]
, testCase "Luke aliased" . testQuery , testCase "Luke aliased" . testQuery
[r| query FetchLukeAliased { [r| query FetchLukeAliased {
luke: human(id: "1000") { luke: human(id: "1000") {
@ -165,11 +166,11 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"luke" .= object [ "luke" .= object [
"name" .= ("Luke Skywalker" :: Text) "name" .= ("Luke Skywalker" :: Text)
] ]
] ]]
, testCase "R2-D2 ID and friends aliased" . testQuery , testCase "R2-D2 ID and friends aliased" . testQuery
[r| query HeroNameAndFriendsQuery { [r| query HeroNameAndFriendsQuery {
hero { hero {
@ -181,7 +182,7 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"hero" .= object [ "hero" .= object [
"id" .= ("2001" :: Text) "id" .= ("2001" :: Text)
, "name" .= ("R2-D2" :: Text) , "name" .= ("R2-D2" :: Text)
@ -191,7 +192,7 @@ test = testGroup "Star Wars Query Tests"
, object ["friendName" .= ("Leia Organa" :: Text)] , object ["friendName" .= ("Leia Organa" :: Text)]
] ]
] ]
] ]]
, testCase "Luke and Leia aliased" . testQuery , testCase "Luke and Leia aliased" . testQuery
[r| query FetchLukeAndLeiaAliased { [r| query FetchLukeAndLeiaAliased {
luke: human(id: "1000") { luke: human(id: "1000") {
@ -202,14 +203,14 @@ test = testGroup "Star Wars Query Tests"
} }
} }
|] |]
$ object [ $ object [ "data" .= object [
"luke" .= object [ "luke" .= object [
"name" .= ("Luke Skywalker" :: Text) "name" .= ("Luke Skywalker" :: Text)
] ]
, "leia" .= object [ , "leia" .= object [
"name" .= ("Leia Organa" :: Text) "name" .= ("Leia Organa" :: Text)
] ]
] ]]
] ]
testQuery :: Text -> Aeson.Value -> Assertion testQuery :: Text -> Aeson.Value -> Assertion
@ -221,5 +222,5 @@ testQuery q expected = graphql schema q @?= Just expected
testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion
testQueryParams f q expected = graphqlSubs schema f q @?= Just expected testQueryParams f q expected = graphqlSubs schema f q @?= Just expected
testFailParams :: Subs -> Text -> Assertion -- testFailParams :: Subs -> Text -> Assertion
testFailParams f q = graphqlSubs schema f q @?= Nothing -- testFailParams f q = graphqlSubs schema f q @?= Nothing