diff --git a/Data/GraphQL.hs b/Data/GraphQL.hs index 2da8a46..dfe9362 100644 --- a/Data/GraphQL.hs +++ b/Data/GraphQL.hs @@ -1,6 +1,7 @@ +-- | This module provides the functions to parse and execute @GraphQL@ queries. module Data.GraphQL where -import Control.Applicative (Alternative, empty) +import Control.Applicative (Alternative) import Data.Text (Text) @@ -11,10 +12,23 @@ import Data.GraphQL.Execute import Data.GraphQL.Parser 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 = 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 schema f = - either (const empty) (execute schema f) + either parseError (execute schema f) . Attoparsec.parseOnly document diff --git a/Data/GraphQL/AST.hs b/Data/GraphQL/AST.hs index 2703a5b..99eaa79 100644 --- a/Data/GraphQL/AST.hs +++ b/Data/GraphQL/AST.hs @@ -1,3 +1,6 @@ +-- | This module defines an abstract syntax tree for the @GraphQL@ language based on +-- . + module Data.GraphQL.AST where import Data.Int (Int32) @@ -39,11 +42,26 @@ data Selection = SelectionField Field | SelectionInlineFragment InlineFragment 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. +-- +-- data Field = Field Alias Name [Argument] [Directive] SelectionSet deriving (Eq,Show) 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@ server’s implementation. +-- +-- data Argument = Argument Name Value deriving (Eq,Show) -- * Fragments @@ -63,6 +81,15 @@ type TypeCondition = NamedType -- * 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). +-- +-- data Value = ValueVariable Variable | ValueInt Int32 -- GraphQL Float is double precison diff --git a/Data/GraphQL/Encoder.hs b/Data/GraphQL/Encoder.hs index 2b7e239..86f090b 100644 --- a/Data/GraphQL/Encoder.hs +++ b/Data/GraphQL/Encoder.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +-- | This module defines a printer for the @GraphQL@ language. module Data.GraphQL.Encoder where #if !MIN_VERSION_base(4,8,0) diff --git a/Data/GraphQL/Error.hs b/Data/GraphQL/Error.hs new file mode 100644 index 0000000..74f08e4 --- /dev/null +++ b/Data/GraphQL/Error.hs @@ -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)] diff --git a/Data/GraphQL/Execute.hs b/Data/GraphQL/Execute.hs index 47d1d03..86887ff 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -1,4 +1,6 @@ {-# LANGUAGE CPP #-} +-- | This module provides the function to execute a @GraphQL@ request -- +-- according to a 'Schema'. module Data.GraphQL.Execute (execute) where #if !MIN_VERSION_base(4,8,0) @@ -13,16 +15,32 @@ import Data.GraphQL.AST import Data.GraphQL.Schema (Schema(..)) import qualified Data.GraphQL.Schema as Schema -execute - :: Alternative f - => Schema.Schema f -> Schema.Subs -> Document -> f Aeson.Value -execute (Schema resolvs) subs = Schema.resolvers resolvs . rootFields subs +import Data.GraphQL.Error +-- | 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 subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) = Schema.fields $ substitute subs <$> sels 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 subs (SelectionField (Field alias name args directives sels)) = SelectionField $ Field @@ -35,6 +53,9 @@ substitute subs (SelectionField (Field alias name args directives sels)) = substitute _ sel = sel -- 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 subs (Argument n (ValueVariable (Variable v))) = Argument n . ValueString <$> subs v diff --git a/Data/GraphQL/Parser.hs b/Data/GraphQL/Parser.hs index 6658af0..227c9a8 100644 --- a/Data/GraphQL/Parser.hs +++ b/Data/GraphQL/Parser.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} +-- | This module defines a parser for @GraphQL@ request documents. module Data.GraphQL.Parser where import Prelude hiding (takeWhile) diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 1c45af2..7966392 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -1,5 +1,8 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +-- | This module provides a representation of a @GraphQL@ Schema in addition to +-- functions for defining and manipulating Schemas. module Data.GraphQL.Schema ( Schema(..) , Resolver @@ -21,14 +24,16 @@ module Data.GraphQL.Schema ) where #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.Traversable (traverse) import Data.Monoid (Monoid(mempty,mappend)) #else +import Data.Bifunctor (first) import Data.Monoid (Alt(Alt,getAlt)) #endif -import Control.Applicative (Alternative, empty) +import Control.Applicative (Alternative((<|>), empty)) import Data.Maybe (catMaybes) import Data.Foldable (fold) @@ -36,77 +41,105 @@ import qualified Data.Aeson as Aeson import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap 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.Error +-- | A GraphQL schema. +-- @f@ is usually expected to be an instance of 'Alternative'. 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 +-- | Create a named 'Resolver' from a list of 'Resolver's. object :: Alternative f => Text -> [Resolver f] -> Resolver f object name resolvs = objectA name $ \case [] -> resolvs _ -> empty +-- | Like 'object' but also taking 'Argument's. objectA :: Alternative f => Text -> ([Argument] -> [Resolver f]) -> Resolver f objectA name f fld@(Field _ _ args _ sels) = 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 name s = scalarA name $ \case [] -> pure s _ -> empty +-- | Like 'scalar' but also taking 'Argument's. scalarA :: (Alternative f, Aeson.ToJSON a) => 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 +-- | Like 'object' but taking lists of 'Resolver's instead of a single list. array :: Alternative f => Text -> [[Resolver f]] -> Resolver f array name resolvs = arrayA name $ \case [] -> resolvs _ -> empty +-- | Like 'array' but also taking 'Argument's. arrayA :: Alternative f => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f 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 name enums = enumA name $ \case [] -> enums _ -> empty +-- | Like 'enum' but also taking 'Argument's. 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 +-- | Helper function to facilitate 'Argument' handling. withField :: (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' _ _ _) = if name == name' - then fmap (HashMap.singleton aliasOrName . Aeson.toJSON) f + then fmap (first $ HashMap.singleton aliasOrName . Aeson.toJSON) f else empty where 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 = - fmap (Aeson.toJSON . fold) - . traverse (\fld -> getAlt $ foldMap (Alt . ($ fld)) resolvs) + fmap (first Aeson.toJSON . fold) + . 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 (SelectionField x) = Just x field _ = Nothing +-- | Returns a list of the 'Field's contained in the given 'SelectionSet'. fields :: SelectionSet -> [Field] fields = catMaybes . fmap field diff --git a/docs/tutorial/Makefile b/docs/tutorial/Makefile new file mode 100644 index 0000000..04d8d71 --- /dev/null +++ b/docs/tutorial/Makefile @@ -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 diff --git a/docs/tutorial/tutorial.css b/docs/tutorial/tutorial.css new file mode 100644 index 0000000..831b73d --- /dev/null +++ b/docs/tutorial/tutorial.css @@ -0,0 +1,3 @@ +body { + padding: 0 20px; +} diff --git a/docs/tutorial/tutorial.html b/docs/tutorial/tutorial.html new file mode 100644 index 0000000..fab66c2 --- /dev/null +++ b/docs/tutorial/tutorial.html @@ -0,0 +1,165 @@ + + + + + + + GraphQL Haskell Tutorial + + + + + + + +
+

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.

+

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 module. This includes a more complex schema, and more complex queries.

+
+ + diff --git a/docs/tutorial/tutorial.lhs b/docs/tutorial/tutorial.lhs new file mode 100644 index 0000000..387d14d --- /dev/null +++ b/docs/tutorial/tutorial.lhs @@ -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. diff --git a/docs/tutorial/tutorial.pdf b/docs/tutorial/tutorial.pdf new file mode 100644 index 0000000..6295ee8 Binary files /dev/null and b/docs/tutorial/tutorial.pdf differ diff --git a/docs/tutorial/tutorial.rst b/docs/tutorial/tutorial.rst new file mode 100644 index 0000000..1c8b5ff --- /dev/null +++ b/docs/tutorial/tutorial.rst @@ -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 `__. + +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. diff --git a/graphql.cabal b/graphql.cabal index 18c78fa..22fe148 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -16,6 +16,7 @@ build-type: Simple cabal-version: >=1.10 tested-with: GHC == 7.8.4, GHC == 7.10.3 extra-source-files: README.md CHANGELOG.md stack.yaml + docs/tutorial/tutorial.lhs data-files: tests/data/*.graphql tests/data/*.min.graphql @@ -28,10 +29,11 @@ library Data.GraphQL.Execute Data.GraphQL.Schema Data.GraphQL.Parser - build-depends: base >= 4.7 && < 5, - text >= 0.11.3.1, - aeson >= 0.7.0.3, + Data.GraphQL.Error + build-depends: aeson >= 0.7.0.3, attoparsec >= 0.10.4.0, + base >= 4.7 && < 5, + text >= 0.11.3.1, unordered-containers >= 0.2.5.0 test-suite tasty @@ -44,15 +46,15 @@ test-suite tasty Test.StarWars.Data Test.StarWars.Schema Test.StarWars.QueryTests - build-depends: base >= 4.6 && <5, - aeson >= 0.7.0.3, - text >= 0.11.3.1, + build-depends: aeson >= 0.7.0.3, attoparsec >= 0.10.4.0, + base >= 4.6 && <5, + graphql, raw-strings-qq >= 1.1, tasty >= 0.10, tasty-hunit >= 0.9, - unordered-containers >= 0.2.5.0, - graphql + text >= 0.11.3.1, + unordered-containers >= 0.2.5.0 source-repository head type: git diff --git a/tests/Test/StarWars/QueryTests.hs b/tests/Test/StarWars/QueryTests.hs index ccaf481..11dd2d5 100644 --- a/tests/Test/StarWars/QueryTests.hs +++ b/tests/Test/StarWars/QueryTests.hs @@ -2,7 +2,7 @@ {-# LANGUAGE QuasiQuotes #-} 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.Text (Text) 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 [r| query HeroNameAndFriendsQuery { hero { @@ -40,7 +40,7 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "hero" .= object [ "id" .= ("2001" :: Text) , "name" .= ("R2-D2" :: Text) @@ -50,7 +50,7 @@ test = testGroup "Star Wars Query Tests" , object ["name" .= ("Leia Organa" :: Text)] ] ] - ] + ]] ] , testGroup "Nested Queries" [ testCase "R2-D2 friends" . testQuery @@ -67,7 +67,7 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "hero" .= object [ "name" .= ("R2-D2" :: Text) , "friends" .= [ @@ -102,7 +102,7 @@ test = testGroup "Star Wars Query Tests" ] ] ] - ] + ]] , testCase "Luke ID" . testQuery [r| query FetchLukeQuery { human(id: "1000") { @@ -110,12 +110,12 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "human" .= object [ "name" .= ("Luke Skywalker" :: Text) ] ] - ] + ]] , testCase "Luke ID with variable" . testQueryParams (\v -> if v == "someId" then Just "1000" @@ -126,9 +126,9 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "human" .= object ["name" .= ("Luke Skywalker" :: Text)] - ] + ]] , testCase "Han ID with variable" . testQueryParams (\v -> if v == "someId" then Just "1002" @@ -139,10 +139,10 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "human" .= object ["name" .= ("Han Solo" :: Text)] - ] - , testCase "Invalid ID" $ testFailParams + ]] + , testCase "Invalid ID" . testQueryParams (\v -> if v == "id" then Just "Not a valid ID" else Nothing) @@ -151,13 +151,14 @@ test = testGroup "Star Wars Query Tests" 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 -- to mimic the same behavior? Is this part of the spec? Once proper -- exceptions are implemented this test might no longer be meaningful. -- If the same behavior needs to be replicated, should it be implemented -- when defining the `Schema` or when executing? - -- $ object ["human" .= Aeson.Null] + -- $ object [ "data" .= object ["human" .= Aeson.Null] ] , testCase "Luke aliased" . testQuery [r| query FetchLukeAliased { luke: human(id: "1000") { @@ -165,11 +166,11 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "luke" .= object [ "name" .= ("Luke Skywalker" :: Text) ] - ] + ]] , testCase "R2-D2 ID and friends aliased" . testQuery [r| query HeroNameAndFriendsQuery { hero { @@ -181,7 +182,7 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "hero" .= object [ "id" .= ("2001" :: Text) , "name" .= ("R2-D2" :: Text) @@ -191,7 +192,7 @@ test = testGroup "Star Wars Query Tests" , object ["friendName" .= ("Leia Organa" :: Text)] ] ] - ] + ]] , testCase "Luke and Leia aliased" . testQuery [r| query FetchLukeAndLeiaAliased { luke: human(id: "1000") { @@ -202,14 +203,14 @@ test = testGroup "Star Wars Query Tests" } } |] - $ object [ + $ object [ "data" .= object [ "luke" .= object [ "name" .= ("Luke Skywalker" :: Text) ] , "leia" .= object [ "name" .= ("Leia Organa" :: Text) ] - ] + ]] ] testQuery :: Text -> Aeson.Value -> Assertion @@ -221,5 +222,5 @@ testQuery q expected = graphql schema q @?= Just expected testQueryParams :: Subs -> Text -> Aeson.Value -> Assertion testQueryParams f q expected = graphqlSubs schema f q @?= Just expected -testFailParams :: Subs -> Text -> Assertion -testFailParams f q = graphqlSubs schema f q @?= Nothing +-- testFailParams :: Subs -> Text -> Assertion +-- testFailParams f q = graphqlSubs schema f q @?= Nothing