Top level API

graphql-api.cabal

@@ -71,7 +71,7 @@ test-suite graphql-api-doctests
     , doctest
   other-modules:
       ASTTests
-      Examples.FileSystem
+      Examples.InputObject
       Examples.UnionExample
       OrderedMapTests
       Spec
@@ -106,7 +106,7 @@ test-suite graphql-api-tests
   other-modules:
       ASTTests
       Doctests
-      Examples.FileSystem
+      Examples.InputObject
       Examples.UnionExample
       OrderedMapTests
       TypeApiTests

src/GraphQL.hs

@@ -1,19 +1,26 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 -- | Interface for GraphQL API.
 --
 -- __Note__: This module is highly subject to change. We're still figuring
 -- where to draw the lines and what to expose.
 module GraphQL
   ( QueryError
-  , SelectionSet
+  , Response(..)
   , VariableValues
   , Value
-  , getOperation
   , compileQuery
+  , executeQuery
+  , interpretQuery
+  , interpretAnonymousQuery
   ) 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
@@ -31,8 +38,14 @@ import GraphQL.Internal.Validation
   , getSelectionSet
   , VariableValue
   )
-import GraphQL.Internal.Output (GraphQLError(..))
-import GraphQL.Value (Value)
+import GraphQL.Internal.Output
+  ( GraphQLError(..)
+  , Error(..)
+  , 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 +58,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 +69,61 @@ 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 -- ^ 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))
+    Right operation ->
+      toResult <$> buildResolver @m @api handler operation
+  where
+    toResult (Result errors result) =
+      case result of
+        -- TODO: Prevent this at compile time.
+        ValueObject object ->
+          case NonEmpty.nonEmpty errors of
+            Nothing -> Success object
+            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 -- ^ 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 [] :| []))
+    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 -- ^ 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.
 compileQuery :: Text -> Either QueryError (QueryDocument VariableValue)
@@ -66,10 +136,7 @@ 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 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

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
 --
 -- <https://facebook.github.io/graphql/#sec-Executing-Requests>
@@ -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

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

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)
@@ -20,32 +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 qualified GraphQL.Internal.Encoder as Encode
--- >>> import GraphQL.Value (valueToAST)
+-- >>> import Data.Aeson (encode)
+-- >>> import GraphQL.Value.ToValue (ToValue(..))
 
 -- | 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}) }")
-
--- | Show that example replacement works
+-- >>> response <- example "{ description(dogStuff: {toy: \"bone\", likesTreats: true}) }"
+-- >>> putStrLn $ encode $ toValue response
+-- {"data":{"description":"likes treats and their favorite toy is a bone"}}
 --
--- >>> (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 <- example "{ description }"
+-- >>> putStrLn $ encode $ toValue response
+-- {"data":{"description":"their favorite toy is a shoe"}}
+example :: Text -> IO Response
+example = interpretAnonymousQuery @Query root

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 } } }"