From b74278cd19d900d1397e35b85f7b80d70cd574f2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matth=C3=ADas=20P=C3=A1ll=20Gissurarson?= Date: Wed, 9 Mar 2016 01:07:57 +0100 Subject: [PATCH 1/3] Added a tutorial, based on graphql-js and servant documentation. --- docs/tutorial/Makefile | 4 + docs/tutorial/tutorial.css | 3 + docs/tutorial/tutorial.lhs | 150 +++++++++++++++++++++++++++++++ docs/tutorial/tutorial.rst | 176 +++++++++++++++++++++++++++++++++++++ 4 files changed, 333 insertions(+) create mode 100644 docs/tutorial/Makefile create mode 100644 docs/tutorial/tutorial.css create mode 100644 docs/tutorial/tutorial.lhs create mode 100644 docs/tutorial/tutorial.rst 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.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.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. From d1953891029a71115ee572b7b3798072cbaf2ea8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Matth=C3=ADas=20P=C3=A1ll=20Gissurarson?= Date: Sat, 12 Mar 2016 00:59:51 +0100 Subject: [PATCH 2/3] Added exception handling with Alternative constraint according to spec. --- Data/GraphQL.hs | 7 +++- Data/GraphQL/Error.hs | 62 +++++++++++++++++++++++++++++++ Data/GraphQL/Execute.hs | 18 +++++++-- Data/GraphQL/Schema.hs | 30 +++++++++------ graphql.cabal | 17 +++++---- tests/Test/StarWars/QueryTests.hs | 47 +++++++++++------------ 6 files changed, 133 insertions(+), 48 deletions(-) create mode 100644 Data/GraphQL/Error.hs diff --git a/Data/GraphQL.hs b/Data/GraphQL.hs index 2da8a46..a2796ae 100644 --- a/Data/GraphQL.hs +++ b/Data/GraphQL.hs @@ -1,6 +1,6 @@ module Data.GraphQL where -import Control.Applicative (Alternative, empty) +import Control.Applicative (Alternative) import Data.Text (Text) @@ -11,10 +11,13 @@ import Data.GraphQL.Execute import Data.GraphQL.Parser import Data.GraphQL.Schema +import Data.GraphQL.Error + graphql :: (Alternative m, Monad m) => Schema m -> Text -> m Aeson.Value graphql = flip graphqlSubs $ const Nothing + 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/Error.hs b/Data/GraphQL/Error.hs new file mode 100644 index 0000000..25632b4 --- /dev/null +++ b/Data/GraphQL/Error.hs @@ -0,0 +1,62 @@ +{-# 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 functor, for passing around error messages. +type CollectErrsT f a = f (a,[Aeson.Value]) + +-- | Takes a (wrapped) list (foldable functor) of values and errors and +-- 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 computation, 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..e5998e9 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} module Data.GraphQL.Execute (execute) where #if !MIN_VERSION_base(4,8,0) @@ -13,10 +14,19 @@ 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 substitution and a GraphQL document. + The substition 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 a "errors field". +-} +execute :: Alternative m + => Schema.Schema m -> Schema.Subs -> Document -> m Aeson.Value +execute (Schema resolvs) subs doc = runCollectErrs res + where res = Schema.resolvers resolvs $ rootFields subs doc + rootFields :: Schema.Subs -> Document -> [Field] rootFields subs (Document [DefinitionOperation (Query (Node _varDefs _ _ sels))]) = diff --git a/Data/GraphQL/Schema.hs b/Data/GraphQL/Schema.hs index 1c45af2..345984c 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} module Data.GraphQL.Schema ( Schema(..) @@ -28,7 +29,7 @@ import Data.Monoid (Monoid(mempty,mappend)) #else import Data.Monoid (Alt(Alt,getAlt)) #endif -import Control.Applicative (Alternative, empty) +import Control.Applicative (Alternative(..)) import Data.Maybe (catMaybes) import Data.Foldable (fold) @@ -36,13 +37,16 @@ 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 Control.Arrow import Data.GraphQL.AST +import Data.GraphQL.Error data Schema f = Schema [Resolver f] -type Resolver f = Field -> f Aeson.Object +type Resolver f = Field -> CollectErrsT f Aeson.Object type Subs = Text -> Maybe Text @@ -65,7 +69,7 @@ scalar name s = scalarA name $ \case 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 array :: Alternative f => Text -> [[Resolver f]] -> Resolver f @@ -77,7 +81,7 @@ 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 enum :: Alternative f => Text -> f [Text] -> Resolver f enum name enums = enumA name $ \case @@ -85,23 +89,27 @@ enum name enums = enumA name $ \case _ -> empty 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 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 +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 field :: Selection -> Maybe Field field (SelectionField x) = Just x diff --git a/graphql.cabal b/graphql.cabal index 18c78fa..4b3cc38 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -28,10 +28,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 +45,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 From 61d6af777897d918decc0ab8ef6456e05fccbe7b Mon Sep 17 00:00:00 2001 From: solrun Date: Wed, 9 Mar 2016 01:15:46 +0100 Subject: [PATCH 3/3] Added documentation of functions and modules and included tutorial.lhs. --- Data/GraphQL.hs | 14 +++++++++++++- Data/GraphQL/AST.hs | 39 +++++++++++++++++++++++++++++++++++++++ Data/GraphQL/Encoder.hs | 2 ++ Data/GraphQL/Execute.hs | 20 ++++++++++++++++---- Data/GraphQL/Parser.hs | 2 ++ Data/GraphQL/Schema.hs | 25 +++++++++++++++++++++++++ graphql.cabal | 1 + 7 files changed, 98 insertions(+), 5 deletions(-) diff --git a/Data/GraphQL.hs b/Data/GraphQL.hs index a2796ae..a5dac4d 100644 --- a/Data/GraphQL.hs +++ b/Data/GraphQL.hs @@ -1,3 +1,6 @@ +-- | The module Data.GraphQl provides the +-- functions graphql and graphqlSubs to parse +-- and execute GraphQL queries. module Data.GraphQL where import Control.Applicative (Alternative) @@ -13,10 +16,19 @@ import Data.GraphQL.Schema import Data.GraphQL.Error +-- | graphql 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 to the query wrapped in an Aeson.Value. graphql :: (Alternative m, Monad m) => Schema m -> Text -> m Aeson.Value graphql = flip graphqlSubs $ const Nothing - +-- | graphqlsubs takes in a schema, a substitution 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 to the query wrapped in an Aeson.Value. graphqlSubs :: (Alternative m, Monad m) => Schema m -> Subs -> Text -> m Aeson.Value graphqlSubs schema f = either parseError (execute schema f) diff --git a/Data/GraphQL/AST.hs b/Data/GraphQL/AST.hs index 2703a5b..5fdd146 100644 --- a/Data/GraphQL/AST.hs +++ b/Data/GraphQL/AST.hs @@ -1,3 +1,8 @@ +{- | This module defines an + abstract syntax tree for the GraphQL language, based on + . +-} + module Data.GraphQL.AST where import Data.Int (Int32) @@ -39,11 +44,33 @@ data Selection = SelectionField Field | SelectionInlineFragment InlineFragment deriving (Eq,Show) +{- | + + A selection set is primarily composed of fields. + A field describes one discrete piece of information + available to request within a selection set. + + Some fields describe complex data or relationships to other data. + In order to further explore this data, a field may itself contain + a selection set, allowing for deeply nested requests. + All GraphQL operations must specify their selections down to + fields which return scalar values to ensure an unambiguously + shaped response. + +-} data Field = Field Alias Name [Argument] [Directive] SelectionSet deriving (Eq,Show) type Alias = Name +{- | + + Fields are conceptually functions which return values, + and occasionally accept arguments which alter their behavior. + These arguments often map directly to function arguments within a + GraphQL server’s implementation. + +-} data Argument = Argument Name Value deriving (Eq,Show) -- * Fragments @@ -63,6 +90,18 @@ 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 + variables (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..6245bb0 100644 --- a/Data/GraphQL/Encoder.hs +++ b/Data/GraphQL/Encoder.hs @@ -1,5 +1,7 @@ {-# 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/Execute.hs b/Data/GraphQL/Execute.hs index e5998e9..a0436f6 100644 --- a/Data/GraphQL/Execute.hs +++ b/Data/GraphQL/Execute.hs @@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} +-- | This module provides the function execute which executes a GraphQL +-- request according to a given GraphQL schema. module Data.GraphQL.Execute (execute) where #if !MIN_VERSION_base(4,8,0) @@ -22,17 +23,25 @@ import Data.GraphQL.Error Returns the result of the query against the schema wrapped in a "data" field, or errors wrapped in a "errors field". -} -execute :: Alternative m - => Schema.Schema m -> Schema.Subs -> Document -> m Aeson.Value +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 - +-- | rootFields takes in a substitution 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 _ _ = [] +-- | substitute takes in a substitution 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 @@ -45,6 +54,9 @@ substitute subs (SelectionField (Field alias name args directives sels)) = substitute _ sel = sel -- TODO: Support different value types +-- | subsArg takes in a substitution 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..ed9df80 100644 --- a/Data/GraphQL/Parser.hs +++ b/Data/GraphQL/Parser.hs @@ -1,5 +1,7 @@ {-# 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 345984c..0a30eb9 100644 --- a/Data/GraphQL/Schema.hs +++ b/Data/GraphQL/Schema.hs @@ -1,6 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE LambdaCase #-} +-- | This module provides the type Schema, +-- representing a GraphQL schema, and functions for defining +-- a schema. module Data.GraphQL.Schema ( Schema(..) , Resolver @@ -44,54 +47,70 @@ import Control.Arrow import Data.GraphQL.AST import Data.GraphQL.Error +-- | Schema represents a GraphQL schema. +-- f usually has to be an instance of Alternative. data Schema f = Schema [Resolver f] +-- | Resolver resolves a field in to a wrapped Aeson.Object with error information +-- (or empty). The wrapped f usually has to be an instance of Alternative. type Resolver f = Field -> CollectErrsT f Aeson.Object +-- | Subs represents a substitution. type Subs = Text -> Maybe Text +-- | Objects represent a list of named fields, each of which +-- yield a value of a specific type. object :: Alternative f => Text -> [Resolver f] -> Resolver f object name resolvs = objectA name $ \case [] -> resolvs _ -> empty +-- | Fields can accept arguments to further specify the return value. 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 +-- | Arguments can be used to further specify a scalar's return value. scalarA :: (Alternative f, Aeson.ToJSON a) => Text -> ([Argument] -> f a) -> Resolver f scalarA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld scalarA _ _ _ = empty +-- | Arrays are like objects but have an array of resolvers instead of a list. array :: Alternative f => Text -> [[Resolver f]] -> Resolver f array name resolvs = arrayA name $ \case [] -> resolvs _ -> empty +-- | Arguments can be used to further specify an array's return values. arrayA :: Alternative f => Text -> ([Argument] -> [[Resolver f]]) -> Resolver f arrayA name f fld@(Field _ _ args _ sels) = withField name (joinErrs $ traverse (flip resolvers $ fields sels) $ f args) fld +-- | An enum 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 +-- | Arguments can be used to further specify an enum's return values. enumA :: Alternative f => Text -> ([Argument] -> f [Text]) -> Resolver f enumA name f fld@(Field _ _ args _ []) = withField name (errWrap $ f args) fld enumA _ _ _ = empty +-- | Used to implement a resolver with arguments. withField :: (Alternative f, Aeson.ToJSON a) => Text -> CollectErrsT f a -> Field -> CollectErrsT f (HashMap Text Aeson.Value) @@ -102,6 +121,9 @@ withField name f (Field alias name' _ _ _) = where aliasOrName = if T.null alias then name' else alias +-- | resolvers takes a list of resolvers and a list of fields, +-- 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 (first Aeson.toJSON . fold) @@ -111,10 +133,13 @@ resolvers resolvs = 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 fields contained in the given selection set. fields :: SelectionSet -> [Field] fields = catMaybes . fmap field diff --git a/graphql.cabal b/graphql.cabal index 4b3cc38..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