From f85c4157f379651b652e2c0c695e6db486f79711 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 21:18:10 +0000 Subject: [PATCH 1/8] Update cabal for InputObject --- graphql-api.cabal | 2 ++ 1 file changed, 2 insertions(+) diff --git a/graphql-api.cabal b/graphql-api.cabal index 2348753..9d54293 100644 --- a/graphql-api.cabal +++ b/graphql-api.cabal @@ -72,6 +72,7 @@ test-suite graphql-api-doctests other-modules: ASTTests Examples.FileSystem + Examples.InputObject Examples.UnionExample OrderedMapTests Spec @@ -107,6 +108,7 @@ test-suite graphql-api-tests ASTTests Doctests Examples.FileSystem + Examples.InputObject Examples.UnionExample OrderedMapTests TypeApiTests From 3315cca9554a00e899f7ddab3781f9e611c34b96 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 21:17:50 +0000 Subject: [PATCH 2/8] Top-level executeQuery function --- src/GraphQL.hs | 32 +++++++++++++++++++++++++++++--- src/GraphQL/Internal/Output.hs | 7 ++++++- 2 files changed, 35 insertions(+), 4 deletions(-) diff --git a/src/GraphQL.hs b/src/GraphQL.hs index 3d82bbc..ddafda2 100644 --- a/src/GraphQL.hs +++ b/src/GraphQL.hs @@ -1,3 +1,7 @@ +{-# LANGUAGE AllowAmbiguousTypes #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE ScopedTypeVariables #-} -- | Interface for GraphQL API. -- -- __Note__: This module is highly subject to change. We're still figuring @@ -7,6 +11,7 @@ module GraphQL , SelectionSet , VariableValues , Value + , executeQuery , getOperation , compileQuery ) where @@ -31,8 +36,9 @@ import GraphQL.Internal.Validation , getSelectionSet , VariableValue ) -import GraphQL.Internal.Output (GraphQLError(..)) -import GraphQL.Value (Value) +import GraphQL.Internal.Output (GraphQLError(..), Response(..), singleError) +import GraphQL.Resolver (HasGraph(..), Result(..)) +import GraphQL.Value (Name, Value, pattern ValueObject) -- | Errors that can happen while processing a query document. data QueryError @@ -45,6 +51,8 @@ data QueryError | ValidationError ValidationErrors -- | Validated, but failed during execution. | ExecutionError ExecutionError + -- | Got a value that wasn't an object. + | NonObjectResult Value deriving (Eq, Show) instance GraphQLError QueryError where @@ -54,6 +62,24 @@ instance GraphQLError QueryError where "Validation errors:\n" <> mconcat [" " <> formatError e <> "\n" | e <- NonEmpty.toList es] formatError (ExecutionError e) = "Execution error: " <> show e + formatError (NonObjectResult v) = + "Query returned a value that is not an object: " <> show v + +-- | Execute a GraphQL query. +executeQuery :: forall api m. (HasGraph m api, Applicative m) => Handler m api -> QueryDocument VariableValue -> Maybe Name -> VariableValues -> m Response +executeQuery handler document name variables = + case getOperation document name variables of + Left e -> pure (ExecutionFailure (singleError e)) + Right operation -> + toResult <$> buildResolver @m @api handler operation + where + toResult (Result errors result) = + case result of + ValueObject object -> + case NonEmpty.nonEmpty errors of + Nothing -> Success object + Just errs -> PartialSuccess object (map toError errs) + v -> ExecutionFailure (singleError (NonObjectResult v)) -- | Turn some text into a valid query document. compileQuery :: Text -> Either QueryError (QueryDocument VariableValue) @@ -69,7 +95,7 @@ parseQuery query = first toS (parseOnly (Parser.queryDocument <* endOfInput) que -- -- TODO: Open question whether we want to export this to the end-user. If we -- do, it should probably not be in first position. -getOperation :: QueryDocument VariableValue -> Maybe AST.Name -> VariableValues -> Either QueryError (SelectionSet Value) +getOperation :: QueryDocument VariableValue -> Maybe Name -> VariableValues -> Either QueryError (SelectionSet Value) getOperation document name vars = first ExecutionError $ do op <- Execution.getOperation document name resolved <- substituteVariables op vars diff --git a/src/GraphQL/Internal/Output.hs b/src/GraphQL/Internal/Output.hs index 23ce25d..a7ec29d 100644 --- a/src/GraphQL/Internal/Output.hs +++ b/src/GraphQL/Internal/Output.hs @@ -7,10 +7,11 @@ module GraphQL.Internal.Output , Errors , Error(..) -- XXX: Maybe export helper functions rather than constructors. , GraphQLError(..) + , singleError ) where import Protolude hiding (Location, Map) -import Data.List.NonEmpty (NonEmpty) +import Data.List.NonEmpty (NonEmpty(..)) import GraphQL.Value ( Object , objectFromList @@ -83,6 +84,10 @@ instance ToValue Error where ,("locations", toValue locations) ] +-- | Make a list of errors containing a single error. +singleError :: GraphQLError e => e -> Errors +singleError e = toError e :| [] + data Location = Location Line Column deriving (Eq, Ord, Show) type Line = Int32 -- XXX: 1-indexed natural number type Column = Int32 -- XXX: 1-indexed natural number From 4b75952c6fde201a9d157f4b8c915497b9f47ec5 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 21:42:10 +0000 Subject: [PATCH 3/8] interpretQuery and interpretAnonymousQuery --- src/GraphQL.hs | 33 +++++++++++++++++++++++++++++++-- 1 file changed, 31 insertions(+), 2 deletions(-) diff --git a/src/GraphQL.hs b/src/GraphQL.hs index ddafda2..f84798e 100644 --- a/src/GraphQL.hs +++ b/src/GraphQL.hs @@ -8,17 +8,21 @@ -- where to draw the lines and what to expose. module GraphQL ( QueryError + , Response(..) , SelectionSet , VariableValues , Value + , compileQuery , executeQuery + , interpretQuery + , interpretAnonymousQuery , getOperation - , compileQuery ) where import Protolude import Data.Attoparsec.Text (parseOnly, endOfInput) +import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import qualified GraphQL.Internal.AST as AST import GraphQL.Internal.Execution @@ -36,7 +40,12 @@ import GraphQL.Internal.Validation , getSelectionSet , VariableValue ) -import GraphQL.Internal.Output (GraphQLError(..), Response(..), singleError) +import GraphQL.Internal.Output + ( GraphQLError(..) + , Error(..) + , Response(..) + , singleError + ) import GraphQL.Resolver (HasGraph(..), Result(..)) import GraphQL.Value (Name, Value, pattern ValueObject) @@ -81,6 +90,26 @@ executeQuery handler document name variables = Just errs -> PartialSuccess object (map toError errs) v -> ExecutionFailure (singleError (NonObjectResult v)) +-- | Interpet a GraphQL query. +-- +-- Compiles then executes a GraphQL query. +interpretQuery :: forall api m. (Applicative m, HasGraph m api) => Handler m api -> Text -> Maybe Name -> VariableValues -> m Response +interpretQuery handler query name variables = + case parseQuery query of + Left err -> pure (PreExecutionFailure (Error err [] :| [])) + Right parsed -> + case validate parsed of + Left errs -> pure (PreExecutionFailure (map toError errs)) + Right document -> + executeQuery @api @m handler document name variables + + +-- | Interpret an anonymous GraphQL query. +-- +-- Anonymous queries have no name and take no variables. +interpretAnonymousQuery :: forall api m. (Applicative m, HasGraph m api) => Handler m api -> Text -> m Response +interpretAnonymousQuery handler query = interpretQuery @api @m handler query Nothing mempty + -- | Turn some text into a valid query document. compileQuery :: Text -> Either QueryError (QueryDocument VariableValue) compileQuery query = do From 35c461784c6d57ce274388160a00a080ae8fcdc3 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 22:27:13 +0000 Subject: [PATCH 4/8] Update examples to use new top-level APIs --- graphql-api.cabal | 2 -- tests/Examples/FileSystem.hs | 59 ---------------------------------- tests/Examples/InputObject.hs | 36 ++++++++++----------- tests/Examples/UnionExample.hs | 53 +++++++++++++----------------- tests/Spec.hs | 2 +- 5 files changed, 40 insertions(+), 112 deletions(-) delete mode 100644 tests/Examples/FileSystem.hs diff --git a/graphql-api.cabal b/graphql-api.cabal index 9d54293..9b17436 100644 --- a/graphql-api.cabal +++ b/graphql-api.cabal @@ -71,7 +71,6 @@ test-suite graphql-api-doctests , doctest other-modules: ASTTests - Examples.FileSystem Examples.InputObject Examples.UnionExample OrderedMapTests @@ -107,7 +106,6 @@ test-suite graphql-api-tests other-modules: ASTTests Doctests - Examples.FileSystem Examples.InputObject Examples.UnionExample OrderedMapTests diff --git a/tests/Examples/FileSystem.hs b/tests/Examples/FileSystem.hs deleted file mode 100644 index 2eb526d..0000000 --- a/tests/Examples/FileSystem.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} - -module Examples.FileSystem where -import Protolude hiding (Enum) - -import GraphQL -import GraphQL.API -import GraphQL.Resolver (Handler, Result, (:<>)(..), buildResolver) -import GraphQL.Value (Value) - -import qualified System.Directory as SD - -type File = Object "File" '[] - '[ Field "name" Text - , Field "absolutePath" Text - ] - -type Directory = Object "Directory" '[] - '[ Argument "glob" (Maybe Text) :> Field "entries" (List File) - , Field "numEntries" Int32 - , Field "absolutePath" Text - ] - -type Query = Object "Query" '[] - '[ Argument "path" (Maybe Text) :> Field "root" Directory ] - - -oneFile :: FilePath -> Handler IO File -oneFile path = - pure $ pure ((toS @_ @Text) path) - :<> map (toS @_ @Text) (SD.canonicalizePath path) - -directory :: Maybe Text -> Handler IO Directory -directory Nothing = directory (Just "/") -directory (Just path) = do - paths <- SD.listDirectory (toS path) - pure $ filtered paths - :<> pure (fromIntegral (length paths)) - :<> map (toS @_ @Text) (SD.canonicalizePath (toS path)) - where - filtered :: [FilePath] -> Maybe Text -> IO [Handler IO File] - filtered paths (Just glob) = - pure $ map oneFile (filter (== (toS glob)) paths) - filtered paths Nothing = - pure $ map oneFile paths - -root :: Handler IO Query -root = do - pure directory - - -example :: IO (Result Value) -example = buildResolver @IO @Query root (query "{ root(path: \"/etc\") { entries { name } } }") - -query :: Text -> SelectionSet Value -query q = either (panic . show) identity $ do - document <- compileQuery q - getOperation document Nothing mempty diff --git a/tests/Examples/InputObject.hs b/tests/Examples/InputObject.hs index db79426..5baa566 100644 --- a/tests/Examples/InputObject.hs +++ b/tests/Examples/InputObject.hs @@ -7,8 +7,7 @@ import Protolude hiding (Enum) import GraphQL import GraphQL.API -import GraphQL.Resolver (Handler, Result(..), (:<>)(..), buildResolver, Defaultable(..)) -import GraphQL.Value (Value) +import GraphQL.Resolver (Handler, Defaultable(..)) import GraphQL.Value.FromValue (FromValue) data DogStuff = DogStuff { toy :: Text, likesTreats :: Bool } deriving (Show, Generic) @@ -26,26 +25,25 @@ root :: Handler IO Query root = pure (\dogStuff -> pure (show dogStuff)) -- $setup --- >>> import qualified GraphQL.Internal.Encoder as Encode --- >>> import GraphQL.Value (valueToAST) +-- >>> import Data.Aeson (encode) +-- >>> import GraphQL.Value.ToValue (ToValue(..)) + +-- TODO: jml thinks it's a bit confusing to have `show` output in these +-- examples. Mixing between JSON syntax and Haskell's record syntax confuses +-- the point. -- | Show input object usage -- --- >>> (Result _ result) <- example --- >>> putStrLn $ Encode.value (valueToAST result) --- {root:"DogStuff {toy = \"bone\", likesTreats = True}"} -example :: IO (Result Value) -example = buildResolver @IO @Query root (query "{ root(dogStuff: {toy: \"bone\", likesTreats: true}) }") +-- >>> response <- example +-- >>> putStrLn $ encode $ toValue response +-- {"data":{"root":"DogStuff {toy = \"bone\", likesTreats = True}"}} +example :: IO Response +example = interpretAnonymousQuery @Query root "{ root(dogStuff: {toy: \"bone\", likesTreats: true}) }" -- | Show that example replacement works -- --- >>> (Result _ result) <- exampleDefault --- >>> putStrLn $ Encode.value (valueToAST result) --- {root:"DogStuff {toy = \"shoe\", likesTreats = False}"} -exampleDefault :: IO (Result Value) -exampleDefault = buildResolver @IO @Query root (query "{ root }") - -query :: Text -> SelectionSet Value -query q = either (panic . show) identity $ do - document <- compileQuery q - getOperation document Nothing mempty +-- >>> response <- exampleDefault +-- >>> putStrLn $ encode $ toValue response +-- {"data":{"root":"DogStuff {toy = \"shoe\", likesTreats = False}"}} +exampleDefault :: IO Response +exampleDefault = interpretAnonymousQuery @Query root "{ root }" diff --git a/tests/Examples/UnionExample.hs b/tests/Examples/UnionExample.hs index 309748d..87bb0a2 100644 --- a/tests/Examples/UnionExample.hs +++ b/tests/Examples/UnionExample.hs @@ -1,19 +1,17 @@ {-# LANGUAGE DataKinds #-} module Examples.UnionExample where -import Protolude hiding (Enum) -import qualified GraphQL.Internal.Validation as Validation -import GraphQL.API -import GraphQL (compileQuery, getOperation) -import GraphQL.Resolver -import GraphQL.Value (Value) +import Protolude +import GraphQL.API (Field, List, Object, Union) +import GraphQL (Response, interpretAnonymousQuery) +import GraphQL.Resolver (Handler, (:<>)(..), unionValue) -- Slightly reduced example from the spec type MiniCat = Object "MiniCat" '[] '[Field "name" Text, Field "meowVolume" Int32] type MiniDog = Object "MiniDog" '[] '[Field "barkVolume" Int32] type CatOrDog = Union "CatOrDog" '[MiniCat, MiniDog] -type CatOrDogList = List (Union "CatOrDog" '[MiniCat, MiniDog]) +type CatOrDogList = Object "CatOrDogList" '[] '[Field "pets" (List (Union "CatOrDog" '[MiniCat, MiniDog]))] miniCat :: Text -> Handler IO MiniCat miniCat name = pure (pure name :<> pure 32) @@ -27,35 +25,28 @@ catOrDog = do unionValue @MiniCat (miniCat name) catOrDogList :: Handler IO CatOrDogList -catOrDogList = pure - [ unionValue @MiniCat (miniCat "Felix") - , unionValue @MiniCat (miniCat "Mini") - , unionValue @MiniDog miniDog - ] +catOrDogList = pure $ + pure [ unionValue @MiniCat (miniCat "Felix") + , unionValue @MiniCat (miniCat "Mini") + , unionValue @MiniDog miniDog + ] -- $setup --- >>> import qualified GraphQL.Internal.Encoder as Encode --- >>> import GraphQL.Value (valueToAST) - +-- >>> import Data.Aeson (encode) +-- >>> import GraphQL.Value.ToValue (ToValue(..)) -- | Show usage of a single unionValue -- --- >>> (Result _ result) <- exampleQuery --- >>> putStrLn $ Encode.value (valueToAST result) --- {name:"MonadicFelix",meowVolume:32} -exampleQuery :: IO (Result Value) -exampleQuery = buildResolver @IO @CatOrDog catOrDog (query "{ ... on MiniCat { name meowVolume } ... on MiniDog { barkVolume } }") +-- >>> response <- exampleQuery +-- >>> putStrLn $ encode $ toValue response +-- {"data":{"meowVolume":32,"name":"MonadicFelix"}} +exampleQuery :: IO Response +exampleQuery = interpretAnonymousQuery @CatOrDog catOrDog "{ ... on MiniCat { name meowVolume } ... on MiniDog { barkVolume } }" -- | 'unionValue' can be used in a list context -- --- >>> (Result _ result) <- exampleListQuery --- >>> putStrLn $ Encode.value (valueToAST result) --- [{name:"Felix",meowVolume:32},{name:"Mini",meowVolume:32},{barkVolume:100}] -exampleListQuery :: IO (Result Value) -exampleListQuery = buildResolver @IO @CatOrDogList catOrDogList (query "{ ... on MiniCat { name meowVolume } ... on MiniDog { barkVolume } }") - -query :: Text -> Validation.SelectionSet Value -query q = - let Right doc = compileQuery q - Right x = getOperation doc Nothing mempty - in x +-- >>> response <- exampleListQuery +-- >>> putStrLn $ encode $ toValue response +-- {"data":{"pets":[{"meowVolume":32,"name":"Felix"},{"meowVolume":32,"name":"Mini"},{"barkVolume":100}]}} +exampleListQuery :: IO Response +exampleListQuery = interpretAnonymousQuery @CatOrDogList catOrDogList "{ pets { ... on MiniCat { name meowVolume } ... on MiniDog { barkVolume } } }" diff --git a/tests/Spec.hs b/tests/Spec.hs index 93b1fa8..b94b556 100644 --- a/tests/Spec.hs +++ b/tests/Spec.hs @@ -14,8 +14,8 @@ import qualified ValidationTests import qualified ValueTests -- import examples to ensure they compile +import Examples.InputObject () import Examples.UnionExample () -import Examples.FileSystem () main :: IO () main = do From 5f7b344a7a4293cb4310f5ae7eddef1b14694a31 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 22:29:47 +0000 Subject: [PATCH 5/8] No need for two separate functions --- tests/Examples/InputObject.hs | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/tests/Examples/InputObject.hs b/tests/Examples/InputObject.hs index 5baa566..467147f 100644 --- a/tests/Examples/InputObject.hs +++ b/tests/Examples/InputObject.hs @@ -34,16 +34,12 @@ root = pure (\dogStuff -> pure (show dogStuff)) -- | Show input object usage -- --- >>> response <- example +-- >>> response <- example "{ root(dogStuff: {toy: \"bone\", likesTreats: true}) }" -- >>> putStrLn $ encode $ toValue response -- {"data":{"root":"DogStuff {toy = \"bone\", likesTreats = True}"}} -example :: IO Response -example = interpretAnonymousQuery @Query root "{ root(dogStuff: {toy: \"bone\", likesTreats: true}) }" - --- | Show that example replacement works -- --- >>> response <- exampleDefault +-- >>> response <- example "{ root }" -- >>> putStrLn $ encode $ toValue response -- {"data":{"root":"DogStuff {toy = \"shoe\", likesTreats = False}"}} -exampleDefault :: IO Response -exampleDefault = interpretAnonymousQuery @Query root "{ root }" +example :: Text -> IO Response +example = interpretAnonymousQuery @Query root From e7ca74e4e264cb92cbcb071f79edb9cbacd6b6ad Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Mon, 16 Jan 2017 23:04:37 +0000 Subject: [PATCH 6/8] Richer documentation --- src/GraphQL.hs | 28 ++++++++++++++++++++-------- tests/TypeApiTests.hs | 38 ++++++++++---------------------------- 2 files changed, 30 insertions(+), 36 deletions(-) diff --git a/src/GraphQL.hs b/src/GraphQL.hs index f84798e..ffbbb59 100644 --- a/src/GraphQL.hs +++ b/src/GraphQL.hs @@ -9,14 +9,12 @@ module GraphQL ( QueryError , Response(..) - , SelectionSet , VariableValues , Value , compileQuery , executeQuery , interpretQuery , interpretAnonymousQuery - , getOperation ) where import Protolude @@ -75,7 +73,13 @@ instance GraphQLError QueryError where "Query returned a value that is not an object: " <> show v -- | Execute a GraphQL query. -executeQuery :: forall api m. (HasGraph m api, Applicative m) => Handler m api -> QueryDocument VariableValue -> Maybe Name -> VariableValues -> m Response +executeQuery + :: forall api m. (HasGraph m api, Applicative m) + => Handler m api -- ^ Handler for the query. This links the query to the code you've written to handle it. + -> QueryDocument VariableValue -- ^ A validated query document. Build one with 'compileQuery'. + -> Maybe Name -- ^ An optional name. If 'Nothing', then executes the only operation in the query. If @Just "something"@, executes the query named @"something". + -> VariableValues -- ^ Values for variables defined in the query document. A map of 'Variable' to 'Value'. + -> m Response -- ^ The outcome of running the query. executeQuery handler document name variables = case getOperation document name variables of Left e -> pure (ExecutionFailure (singleError e)) @@ -84,6 +88,7 @@ executeQuery handler document name variables = where toResult (Result errors result) = case result of + -- TODO: Prevent this at compile time. ValueObject object -> case NonEmpty.nonEmpty errors of Nothing -> Success object @@ -93,7 +98,13 @@ executeQuery handler document name variables = -- | Interpet a GraphQL query. -- -- Compiles then executes a GraphQL query. -interpretQuery :: forall api m. (Applicative m, HasGraph m api) => Handler m api -> Text -> Maybe Name -> VariableValues -> m Response +interpretQuery + :: forall api m. (Applicative m, HasGraph m api) + => Handler m api -- ^ Handler for the query. This links the query to the code you've written to handle it. + -> Text -- ^ The text of a query document. Will be parsed and then executed. + -> Maybe Name -- ^ An optional name for the operation within document to run. If 'Nothing', execute the only operation in the document. If @Just "something"@, execute the query or mutation named @"something"@. + -> VariableValues -- ^ Values for variables defined in the query document. A map of 'Variable' to 'Value'. + -> m Response -- ^ The outcome of running the query. interpretQuery handler query name variables = case parseQuery query of Left err -> pure (PreExecutionFailure (Error err [] :| [])) @@ -107,7 +118,11 @@ interpretQuery handler query name variables = -- | Interpret an anonymous GraphQL query. -- -- Anonymous queries have no name and take no variables. -interpretAnonymousQuery :: forall api m. (Applicative m, HasGraph m api) => Handler m api -> Text -> m Response +interpretAnonymousQuery + :: forall api m. (Applicative m, HasGraph m api) + => Handler m api -- ^ Handler for the anonymous query. + -> Text -- ^ The text of the anonymous query. Should defined only a single, unnamed query operation. + -> m Response -- ^ The result of running the query. interpretAnonymousQuery handler query = interpretQuery @api @m handler query Nothing mempty -- | Turn some text into a valid query document. @@ -121,9 +136,6 @@ parseQuery :: Text -> Either Text AST.QueryDocument parseQuery query = first toS (parseOnly (Parser.queryDocument <* endOfInput) query) -- | Get an operation from a query document ready to be processed. --- --- TODO: Open question whether we want to export this to the end-user. If we --- do, it should probably not be in first position. getOperation :: QueryDocument VariableValue -> Maybe Name -> VariableValues -> Either QueryError (SelectionSet Value) getOperation document name vars = first ExecutionError $ do op <- Execution.getOperation document name diff --git a/tests/TypeApiTests.hs b/tests/TypeApiTests.hs index 6453811..1424896 100644 --- a/tests/TypeApiTests.hs +++ b/tests/TypeApiTests.hs @@ -6,10 +6,10 @@ import Protolude hiding (Enum) import Test.Tasty (TestTree) import Test.Tasty.Hspec (testSpec, describe, it, shouldBe) +import Data.Aeson (encode) import GraphQL - ( SelectionSet - , compileQuery - , getOperation + ( Response(..) + , interpretAnonymousQuery ) import GraphQL.API ( Object @@ -20,16 +20,12 @@ import GraphQL.API import GraphQL.Resolver ( Handler , ResolverError(..) - , buildResolver , (:<>)(..) - , Result(..) ) -import GraphQL.Value (Value) import qualified GraphQL.Internal.AST as AST -import Data.Aeson (encode) +import GraphQL.Internal.Output (singleError) -- Test a custom error monad --- TODO: I didn't realize that MonadThrow throws in the base monad (IO). type TMonad = ExceptT Text IO type T = Object "T" '[] '[ Field "z" Int32 , Argument "x" Int32 :> Field "t" Int32 @@ -40,31 +36,17 @@ tHandler :: Handler TMonad T tHandler = pure $ (pure 10) :<> (\tArg -> pure tArg) :<> (pure . (*2)) -getQuery :: Text -> SelectionSet Value -getQuery query = either (panic . show) identity $ do - validated <- compileQuery query - getOperation validated Nothing mempty - -runQuery :: SelectionSet Value -> IO (Either Text (Result Value)) -runQuery query = runExceptT (buildResolver @TMonad @T tHandler query) - tests :: IO TestTree tests = testSpec "TypeAPI" $ do describe "tTest" $ do it "works in a simple case" $ do - let query = getQuery "{ t(x: 12) }" - Right (Result _ r) <- runQuery query - encode r `shouldBe` "{\"t\":12}" + Right (Success object) <- runExceptT (interpretAnonymousQuery @T tHandler "{ t(x: 12) }") + encode object `shouldBe` "{\"t\":12}" it "complains about missing field" $ do - -- TODO: Apparently MonadThrow throws in the *base monad*, - -- i.e. usually IO. If we want to throw in the wrapper monad I - -- think we may need to use MonadFail?? - let wrongQuery = getQuery "{ not_a_field }" - Right (Result errs _) <- runQuery wrongQuery + Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ not_a_field }") -- TODO: jml thinks this is a really bad error message. Real problem is -- that `not_a_field` was provided. - errs `shouldBe` [ValueMissing (AST.unsafeMakeName "x")] + errs `shouldBe` singleError (ValueMissing (AST.unsafeMakeName "x")) it "complains about missing argument" $ do - let wrongQuery = getQuery "{ t }" - Right (Result errs _) <- runQuery wrongQuery - errs `shouldBe` [ValueMissing (AST.unsafeMakeName "x")] + Right (PartialSuccess _ errs) <- runExceptT (interpretAnonymousQuery @T tHandler "{ t }") + errs `shouldBe` singleError (ValueMissing (AST.unsafeMakeName "x")) From 88056e453ecf92ee5c87d101e7c4c1b6a748cd6d Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Tue, 17 Jan 2017 08:32:13 +0000 Subject: [PATCH 7/8] Update example to be more explicit about data --- tests/Examples/InputObject.hs | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/tests/Examples/InputObject.hs b/tests/Examples/InputObject.hs index 467147f..e32eca1 100644 --- a/tests/Examples/InputObject.hs +++ b/tests/Examples/InputObject.hs @@ -19,27 +19,28 @@ instance Defaultable DogStuff where defaultFor _ = Just (DogStuff "shoe" False) type Query = Object "Query" '[] - '[ Argument "dogStuff" DogStuff :> Field "root" Text ] + '[ Argument "dogStuff" DogStuff :> Field "description" Text ] root :: Handler IO Query -root = pure (\dogStuff -> pure (show dogStuff)) +root = pure description + +description :: DogStuff -> Handler IO Text +description (DogStuff toy likesTreats) + | likesTreats = pure $ "likes treats and their favorite toy is a " <> toy + | otherwise = pure $ "their favorite toy is a " <> toy -- $setup -- >>> import Data.Aeson (encode) -- >>> import GraphQL.Value.ToValue (ToValue(..)) --- TODO: jml thinks it's a bit confusing to have `show` output in these --- examples. Mixing between JSON syntax and Haskell's record syntax confuses --- the point. - -- | Show input object usage -- --- >>> response <- example "{ root(dogStuff: {toy: \"bone\", likesTreats: true}) }" +-- >>> response <- example "{ description(dogStuff: {toy: \"bone\", likesTreats: true}) }" -- >>> putStrLn $ encode $ toValue response --- {"data":{"root":"DogStuff {toy = \"bone\", likesTreats = True}"}} +-- {"data":{"description":"likes treats and their favorite toy is a bone"}} -- --- >>> response <- example "{ root }" +-- >>> response <- example "{ description }" -- >>> putStrLn $ encode $ toValue response --- {"data":{"root":"DogStuff {toy = \"shoe\", likesTreats = False}"}} +-- {"data":{"description":"their favorite toy is a shoe"}} example :: Text -> IO Response example = interpretAnonymousQuery @Query root From fb0df87ca2b9e6d6466ba977776df1d64325dd13 Mon Sep 17 00:00:00 2001 From: Jonathan Lange Date: Tue, 17 Jan 2017 08:32:51 +0000 Subject: [PATCH 8/8] Update commentary in execution --- src/GraphQL/Internal/Execution.hs | 14 +++----------- 1 file changed, 3 insertions(+), 11 deletions(-) diff --git a/src/GraphQL/Internal/Execution.hs b/src/GraphQL/Internal/Execution.hs index b7e453d..21b579c 100644 --- a/src/GraphQL/Internal/Execution.hs +++ b/src/GraphQL/Internal/Execution.hs @@ -35,16 +35,6 @@ import GraphQL.Internal.Validation , Type(..) ) --- Maybe we should have? --- --- >>> data Request = Request Schema Document (Maybe Operation) (Maybe VariableValues) InitialValue --- --- And then we can have: --- --- execute :: Request -> m Response --- --- Where 'Reponse' is from 'GraphQL.Internal.Output'. - -- | Get an operation from a GraphQL document -- -- @@ -92,7 +82,9 @@ replaceVariable vars value = allowNull (TypeNonNull _) = empty allowNull _ = pure ValueNull - +-- | An error that occurs while executing a query. Technically, +-- 'ResolverError' also falls into the same category, but is separate to help +-- our code be a bit better organized. data ExecutionError = MissingValue Variable | NoSuchOperation Name