Compare commits
6 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | 721cbaee17 | |
Eugen Wissner | 1704022e74 | |
Eugen Wissner | 63d4de485d | |
Eugen Wissner | 22313d05df | |
Eugen Wissner | c1943c1979 | |
Eugen Wissner | 5175586def |
19
CHANGELOG.md
19
CHANGELOG.md
|
@ -1,6 +1,24 @@
|
|||
# Change Log
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## [0.5.0.1] - 2019-09-10
|
||||
### Added
|
||||
- Minimal documentation for all public symbols.
|
||||
|
||||
### Deprecated
|
||||
- `Language.GraphQL.AST.FragmentName`. Replaced with Language.GraphQL.AST.Name.
|
||||
- `Language.GraphQL.Execute.Schema` - It is not a schema (at least not a
|
||||
complete one), but a resolver list, and the resolvers should be provided by
|
||||
the user separately, because the schema can originate from a GraphQL
|
||||
document. `Schema` name should be free to provide a data type for the real
|
||||
schema later.
|
||||
- `Language.GraphQL.Schema`: `enum`, `enumA`, `wrappedEnum` and `wrappedEnumA`.
|
||||
There are actually only two generic types in GraphQL: Scalars and objects.
|
||||
Enum is a scalar value.
|
||||
|
||||
### Fixed
|
||||
- Parsing block string values.
|
||||
|
||||
## [0.5.0.0] - 2019-08-14
|
||||
### Added
|
||||
- `executeWithName` executes an operation with the given name.
|
||||
|
@ -70,6 +88,7 @@ All notable changes to this project will be documented in this file.
|
|||
### Added
|
||||
- Data types for the GraphQL language.
|
||||
|
||||
[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
|
||||
[0.5.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.4.0.0...v0.5.0.0
|
||||
[0.4.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.3...v0.4.0.0
|
||||
[0.3]: https://github.com/caraus-ecms/graphql/compare/v0.2.1...v0.3
|
||||
|
|
|
@ -8,8 +8,8 @@ GraphQL implementation in Haskell.
|
|||
|
||||
This implementation is relatively low-level by design, it doesn't provide any
|
||||
mappings between the GraphQL types and Haskell's type system and avoids
|
||||
compile-time magic. It focuses on flexibility instead instead, so other
|
||||
solutions can be built on top of it.
|
||||
compile-time magic. It focuses on flexibility instead, so other solutions can
|
||||
be built on top of it.
|
||||
|
||||
## State of the work
|
||||
|
||||
|
|
|
@ -24,7 +24,6 @@ Since this file is a literate haskell file, we start by importing some dependenc
|
|||
> import Data.Time (getCurrentTime)
|
||||
>
|
||||
> import Language.GraphQL
|
||||
> import Language.GraphQL.Schema (Schema)
|
||||
> import qualified Language.GraphQL.Schema as Schema
|
||||
> import Language.GraphQL.Trans (ActionT(..))
|
||||
>
|
||||
|
@ -37,7 +36,7 @@ example from [graphql.js](https://github.com/graphql/graphql-js).
|
|||
|
||||
First we build a GraphQL schema.
|
||||
|
||||
> schema1 :: Schema IO
|
||||
> schema1 :: NonEmpty (Schema.Resolver IO)
|
||||
> schema1 = hello :| []
|
||||
>
|
||||
> hello :: Schema.Resolver IO
|
||||
|
@ -67,7 +66,7 @@ returning
|
|||
|
||||
For this example, we're going to be using time.
|
||||
|
||||
> schema2 :: Schema IO
|
||||
> schema2 :: NonEmpty (Schema.Resolver IO)
|
||||
> schema2 = time :| []
|
||||
>
|
||||
> time :: Schema.Resolver IO
|
||||
|
@ -127,7 +126,7 @@ This will fail
|
|||
|
||||
Now that we have two resolvers, we can define a schema which uses them both.
|
||||
|
||||
> schema3 :: Schema IO
|
||||
> schema3 :: NonEmpty (Schema.Resolver IO)
|
||||
> schema3 = hello :| [time]
|
||||
>
|
||||
> query3 :: Text
|
||||
|
|
|
@ -4,10 +4,10 @@ cabal-version: 1.12
|
|||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 6598c2424405b7a92a4672ad7d1a4e8ad768ea47bf3ed0c3c5ae51bac8730301
|
||||
-- hash: 0b3b2cb6ec02a4eeaee98d4c003d4cbe68ab81fde1810b06b0b6eeb61010298c
|
||||
|
||||
name: graphql
|
||||
version: 0.5.0.0
|
||||
version: 0.5.0.1
|
||||
synopsis: Haskell GraphQL implementation
|
||||
description: This package provides a rudimentary parser for the <https://graphql.github.io/graphql-spec/June2018/ GraphQL> language.
|
||||
category: Language
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
name: graphql
|
||||
version: 0.5.0.0
|
||||
version: 0.5.0.1
|
||||
synopsis: Haskell GraphQL implementation
|
||||
description:
|
||||
This package provides a rudimentary parser for the
|
||||
|
|
|
@ -19,7 +19,8 @@ test() {
|
|||
}
|
||||
|
||||
test_docs() {
|
||||
$STACK --no-terminal ghc -- -Wall -fno-code docs/tutorial/tutorial.lhs
|
||||
$STACK --no-terminal ghc -- -Wall -Werror -fno-code docs/tutorial/tutorial.lhs
|
||||
$STACK --no-terminal haddock --no-haddock-deps
|
||||
}
|
||||
|
||||
setup_lint() {
|
||||
|
|
|
@ -5,32 +5,31 @@ module Language.GraphQL
|
|||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import qualified Data.Text as T
|
||||
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Text.Megaparsec (parse)
|
||||
|
||||
import Data.List.NonEmpty (NonEmpty)
|
||||
import qualified Data.Text as T
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Execute
|
||||
import Language.GraphQL.Parser
|
||||
import Language.GraphQL.Schema
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import Text.Megaparsec (parse)
|
||||
|
||||
import Language.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 :: MonadIO m => Schema m -> T.Text -> m Aeson.Value
|
||||
-- | If the text parses correctly as a @GraphQL@ query the query is
|
||||
-- executed using the given 'Schema.Resolver's.
|
||||
graphql :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||
-> T.Text -- ^ Text representing a @GraphQL@ request document.
|
||||
-> m Aeson.Value -- ^ Response.
|
||||
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 :: MonadIO m => Schema m -> Subs -> T.Text -> m Aeson.Value
|
||||
graphqlSubs schema f =
|
||||
either parseError (execute schema f)
|
||||
-- | If the text parses correctly as a @GraphQL@ query the substitution is
|
||||
-- applied to the query and the query is then executed using to the given
|
||||
-- 'Schema.Resolver's.
|
||||
graphqlSubs :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> T.Text -- ^ Text representing a @GraphQL@ request document.
|
||||
-> m Aeson.Value -- ^ Response.
|
||||
graphqlSubs schema f
|
||||
= either parseError (execute schema f)
|
||||
. parse document ""
|
||||
|
|
|
@ -39,63 +39,82 @@ import Language.GraphQL.AST.Core ( Alias
|
|||
|
||||
-- * Document
|
||||
|
||||
-- | GraphQL document.
|
||||
type Document = NonEmpty Definition
|
||||
|
||||
-- * Operations
|
||||
|
||||
-- | Top-level definition of a document, either an operation or a fragment.
|
||||
data Definition = DefinitionOperation OperationDefinition
|
||||
| DefinitionFragment FragmentDefinition
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Operation definition.
|
||||
data OperationDefinition = OperationSelectionSet SelectionSet
|
||||
| OperationDefinition OperationType
|
||||
(Maybe Name)
|
||||
VariableDefinitions
|
||||
Directives
|
||||
SelectionSet
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data OperationType = Query | Mutation deriving (Eq,Show)
|
||||
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
|
||||
--
|
||||
-- Currently only queries and mutations are supported.
|
||||
data OperationType = Query | Mutation deriving (Eq, Show)
|
||||
|
||||
-- * SelectionSet
|
||||
-- * Selections
|
||||
|
||||
-- | "Top-level" selection, selection on a operation.
|
||||
type SelectionSet = NonEmpty Selection
|
||||
|
||||
type SelectionSetOpt = [Selection]
|
||||
|
||||
data Selection = SelectionField Field
|
||||
| SelectionFragmentSpread FragmentSpread
|
||||
| SelectionInlineFragment InlineFragment
|
||||
deriving (Eq,Show)
|
||||
-- | Single selection element.
|
||||
data Selection
|
||||
= SelectionField Field
|
||||
| SelectionFragmentSpread FragmentSpread
|
||||
| SelectionInlineFragment InlineFragment
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Field
|
||||
|
||||
data Field = Field (Maybe Alias) Name Arguments Directives SelectionSetOpt
|
||||
deriving (Eq,Show)
|
||||
-- | GraphQL field.
|
||||
data Field
|
||||
= Field (Maybe Alias) Name Arguments Directives SelectionSetOpt
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Arguments
|
||||
|
||||
-- | Argument list.
|
||||
type Arguments = [Argument]
|
||||
|
||||
-- | Argument.
|
||||
data Argument = Argument Name Value deriving (Eq,Show)
|
||||
|
||||
-- * Fragments
|
||||
|
||||
data FragmentSpread = FragmentSpread Name Directives deriving (Eq,Show)
|
||||
-- | Fragment spread.
|
||||
data FragmentSpread = FragmentSpread Name Directives deriving (Eq, Show)
|
||||
|
||||
-- | Inline fragment.
|
||||
data InlineFragment = InlineFragment (Maybe TypeCondition) Directives SelectionSet
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data FragmentDefinition =
|
||||
FragmentDefinition FragmentName TypeCondition Directives SelectionSet
|
||||
deriving (Eq,Show)
|
||||
-- | Fragment definition.
|
||||
data FragmentDefinition
|
||||
= FragmentDefinition Name TypeCondition Directives SelectionSet
|
||||
deriving (Eq, Show)
|
||||
|
||||
{-# DEPRECATED FragmentName "Use Name instead" #-}
|
||||
type FragmentName = Name
|
||||
|
||||
-- | Type condition.
|
||||
type TypeCondition = Name
|
||||
|
||||
-- * Input values
|
||||
|
||||
-- | Input value.
|
||||
data Value = ValueVariable Name
|
||||
| ValueInt Int32
|
||||
| ValueFloat Double
|
||||
|
@ -107,28 +126,38 @@ data Value = ValueVariable Name
|
|||
| ValueObject [ObjectField]
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Key-value pair.
|
||||
--
|
||||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
||||
|
||||
-- * Variables
|
||||
|
||||
-- | Variable definition list.
|
||||
type VariableDefinitions = [VariableDefinition]
|
||||
|
||||
-- | Variable definition.
|
||||
data VariableDefinition = VariableDefinition Name Type (Maybe Value)
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Input types
|
||||
|
||||
-- | Type representation.
|
||||
data Type = TypeNamed Name
|
||||
| TypeList Type
|
||||
| TypeNonNull NonNullType
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
-- | Helper type to represent Non-Null types and lists of such types.
|
||||
data NonNullType = NonNullTypeNamed Name
|
||||
| NonNullTypeList Type
|
||||
deriving (Eq,Show)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- * Directives
|
||||
|
||||
-- | Directive list.
|
||||
type Directives = [Directive]
|
||||
|
||||
data Directive = Directive Name [Argument] deriving (Eq,Show)
|
||||
-- | Directive.
|
||||
data Directive = Directive Name [Argument] deriving (Eq, Show)
|
||||
|
|
|
@ -19,30 +19,84 @@ import Data.Text (Text)
|
|||
-- | Name
|
||||
type Name = Text
|
||||
|
||||
-- | GraphQL document is a non-empty list of operations.
|
||||
type Document = NonEmpty Operation
|
||||
|
||||
data Operation = Query (Maybe Text) (NonEmpty Field)
|
||||
| Mutation (Maybe Text) (NonEmpty Field)
|
||||
deriving (Eq,Show)
|
||||
-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
|
||||
--
|
||||
-- Currently only queries and mutations are supported.
|
||||
data Operation
|
||||
= Query (Maybe Text) (NonEmpty Field)
|
||||
| Mutation (Maybe Text) (NonEmpty Field)
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq,Show)
|
||||
-- | A single GraphQL field.
|
||||
--
|
||||
-- Only required property of a field, is its name. Optionally it can also have
|
||||
-- an alias, arguments or a list of subfields.
|
||||
--
|
||||
-- Given the following query:
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- zuck: user(id: 4) {
|
||||
-- id
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- * "user", "id" and "name" are field names.
|
||||
-- * "user" has two subfields, "id" and "name".
|
||||
-- * "zuck" is an alias for "user". "id" and "name" have no aliases.
|
||||
-- * "id: 4" is an argument for "name". "id" and "name don't have any
|
||||
-- arguments.
|
||||
data Field = Field (Maybe Alias) Name [Argument] [Field] deriving (Eq, Show)
|
||||
|
||||
-- | Alternative field name.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- smallPic: profilePic(size: 64)
|
||||
-- bigPic: profilePic(size: 1024)
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "smallPic" and "bigPic" are aliases for the same field, "profilePic",
|
||||
-- used to distinquish between profile pictures with different arguments
|
||||
-- (sizes).
|
||||
type Alias = Name
|
||||
|
||||
data Argument = Argument Name Value deriving (Eq,Show)
|
||||
-- | Single argument.
|
||||
--
|
||||
-- @
|
||||
-- {
|
||||
-- user(id: 4) {
|
||||
-- name
|
||||
-- }
|
||||
-- }
|
||||
-- @
|
||||
--
|
||||
-- Here "id" is an argument for the field "user" and its value is 4.
|
||||
data Argument = Argument Name Value deriving (Eq, Show)
|
||||
|
||||
data Value = ValueInt Int32
|
||||
-- GraphQL Float is double precision
|
||||
| ValueFloat Double
|
||||
| ValueString Text
|
||||
| ValueBoolean Bool
|
||||
| ValueNull
|
||||
| ValueEnum Name
|
||||
| ValueList [Value]
|
||||
| ValueObject [ObjectField]
|
||||
deriving (Eq,Show)
|
||||
-- | Represents accordingly typed GraphQL values.
|
||||
data Value
|
||||
= ValueInt Int32
|
||||
-- GraphQL Float is double precision
|
||||
| ValueFloat Double
|
||||
| ValueString Text
|
||||
| ValueBoolean Bool
|
||||
| ValueNull
|
||||
| ValueEnum Name
|
||||
| ValueList [Value]
|
||||
| ValueObject [ObjectField]
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance IsString Value where
|
||||
fromString = ValueString . fromString
|
||||
|
||||
data ObjectField = ObjectField Name Value deriving (Eq,Show)
|
||||
-- | Key-value pair.
|
||||
--
|
||||
-- A list of 'ObjectField's represents a GraphQL object type.
|
||||
data ObjectField = ObjectField Name Value deriving (Eq, Show)
|
||||
|
|
|
@ -18,7 +18,8 @@ import qualified Language.GraphQL.Schema as Schema
|
|||
-- empty list is returned.
|
||||
type Fragmenter = Core.Name -> [Core.Field]
|
||||
|
||||
-- TODO: Replace Maybe by MonadThrow with CustomError
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: Schema.Subs -> Full.Document -> Maybe Core.Document
|
||||
document subs doc = operations subs fr ops
|
||||
where
|
||||
|
|
|
@ -1,7 +1,6 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module provides the function to execute a @GraphQL@ request --
|
||||
-- according to a 'Schema'.
|
||||
-- | This module provides functions to execute a @GraphQL@ request.
|
||||
module Language.GraphQL.Execute
|
||||
( execute
|
||||
, executeWithName
|
||||
|
@ -9,51 +8,53 @@ module Language.GraphQL.Execute
|
|||
|
||||
import Control.Monad.IO.Class (MonadIO)
|
||||
import qualified Data.Aeson as Aeson
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Language.GraphQL.AST as AST
|
||||
import qualified Language.GraphQL.AST.Core as AST.Core
|
||||
import qualified Language.GraphQL.AST.Transform as Transform
|
||||
import Language.GraphQL.Error
|
||||
import Language.GraphQL.Schema (Schema)
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
|
||||
-- | 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.
|
||||
-- | The substitution is applied to the document, and the 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.
|
||||
-- Returns the result of the query against the schema wrapped in a /data/
|
||||
-- field, or errors wrapped in an /errors/ field.
|
||||
execute :: MonadIO m
|
||||
=> Schema m
|
||||
-> Schema.Subs
|
||||
-> AST.Document
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> AST.Document -- @GraphQL@ document.
|
||||
-> m Aeson.Value
|
||||
execute schema subs doc =
|
||||
maybe transformError (document schema Nothing) $ Transform.document subs doc
|
||||
where
|
||||
transformError = return $ singleError "Schema transformation error."
|
||||
|
||||
-- | Takes a 'Schema', operation name, 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.
|
||||
-- | The substitution is applied to the document, and the resolvers are applied
|
||||
-- to the resulting fields. The operation name can be used if the document
|
||||
-- defines multiple root operations.
|
||||
--
|
||||
-- Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
|
||||
-- errors wrapped in an /errors/ field.
|
||||
-- Returns the result of the query against the schema wrapped in a /data/
|
||||
-- field, or errors wrapped in an /errors/ field.
|
||||
executeWithName :: MonadIO m
|
||||
=> Schema m
|
||||
-> Text
|
||||
-> Schema.Subs
|
||||
-> AST.Document
|
||||
=> NonEmpty (Schema.Resolver m) -- ^ Resolvers
|
||||
-> Text -- ^ Operation name.
|
||||
-> Schema.Subs -- ^ Variable substitution function.
|
||||
-> AST.Document -- ^ @GraphQL@ Document.
|
||||
-> m Aeson.Value
|
||||
executeWithName schema name subs doc =
|
||||
maybe transformError (document schema $ Just name) $ Transform.document subs doc
|
||||
where
|
||||
transformError = return $ singleError "Schema transformation error."
|
||||
|
||||
document :: MonadIO m => Schema m -> Maybe Text -> AST.Core.Document -> m Aeson.Value
|
||||
document :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m)
|
||||
-> Maybe Text
|
||||
-> AST.Core.Document
|
||||
-> m Aeson.Value
|
||||
document schema Nothing (op :| []) = operation schema op
|
||||
document schema (Just name) operations = case NE.dropWhile matchingName operations of
|
||||
[] -> return $ singleError
|
||||
|
@ -65,7 +66,10 @@ document schema (Just name) operations = case NE.dropWhile matchingName operatio
|
|||
matchingName _ = False
|
||||
document _ _ _ = return $ singleError "Missing operation name."
|
||||
|
||||
operation :: MonadIO m => Schema m -> AST.Core.Operation -> m Aeson.Value
|
||||
operation :: MonadIO m
|
||||
=> NonEmpty (Schema.Resolver m)
|
||||
-> AST.Core.Operation
|
||||
-> m Aeson.Value
|
||||
operation schema (AST.Core.Query _ flds)
|
||||
= runCollectErrs (Schema.resolve (NE.toList schema) (NE.toList flds))
|
||||
operation schema (AST.Core.Mutation _ flds)
|
||||
|
|
|
@ -71,6 +71,8 @@ type Parser = Parsec Void T.Text
|
|||
ignoredCharacters :: Parser ()
|
||||
ignoredCharacters = space1 <|> skipSome (char ',')
|
||||
|
||||
-- | Parser that skips comments and meaningless characters, whitespaces and
|
||||
-- commas.
|
||||
spaceConsumer :: Parser ()
|
||||
spaceConsumer = Lexer.space ignoredCharacters comment empty
|
||||
|
||||
|
|
|
@ -16,6 +16,7 @@ import Text.Megaparsec ( lookAhead
|
|||
, (<?>)
|
||||
)
|
||||
|
||||
-- | Parser for the GraphQL documents.
|
||||
document :: Parser Document
|
||||
document = unicodeBOM >> spaceConsumer >> lexeme (manyNE definition)
|
||||
|
||||
|
@ -93,7 +94,7 @@ fragmentDefinition = FragmentDefinition
|
|||
<*> opt directives
|
||||
<*> selectionSet
|
||||
|
||||
fragmentName :: Parser FragmentName
|
||||
fragmentName :: Parser Name
|
||||
fragmentName = but (symbol "on") *> name
|
||||
|
||||
typeCondition :: Parser TypeCondition
|
||||
|
@ -107,8 +108,8 @@ value = ValueVariable <$> variable
|
|||
<|> ValueInt <$> integer
|
||||
<|> ValueBoolean <$> booleanValue
|
||||
<|> ValueNull <$ symbol "null"
|
||||
<|> ValueString <$> string
|
||||
<|> ValueString <$> blockString
|
||||
<|> ValueString <$> string
|
||||
<|> ValueEnum <$> try enumValue
|
||||
<|> ValueList <$> listValue
|
||||
<|> ValueObject <$> objectValue
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
-- | This module provides a representation of a @GraphQL@ Schema in addition to
|
||||
-- functions for defining and manipulating Schemas.
|
||||
-- functions for defining and manipulating schemas.
|
||||
module Language.GraphQL.Schema
|
||||
( Resolver
|
||||
, Schema
|
||||
|
@ -43,6 +43,7 @@ import Language.GraphQL.Trans
|
|||
import Language.GraphQL.Type
|
||||
import Language.GraphQL.AST.Core
|
||||
|
||||
{-# DEPRECATED Schema "Use NonEmpty (Resolver m) instead" #-}
|
||||
-- | A GraphQL schema.
|
||||
-- @m@ is usually expected to be an instance of 'MonadIO'.
|
||||
type Schema m = NonEmpty (Resolver m)
|
||||
|
@ -110,18 +111,17 @@ wrappedScalar :: (MonadIO m, Aeson.ToJSON a)
|
|||
=> Name -> ActionT m (Wrapping a) -> Resolver m
|
||||
wrappedScalar name = wrappedScalarA name . const
|
||||
|
||||
-- | Represents one of a finite set of possible values.
|
||||
-- Used in place of a 'scalar' when the possible responses are easily enumerable.
|
||||
{-# DEPRECATED enum "Use scalar instead" #-}
|
||||
enum :: MonadIO m => Name -> ActionT m [Text] -> Resolver m
|
||||
enum name = enumA name . const
|
||||
|
||||
-- | Like 'enum' but also taking 'Argument's.
|
||||
{-# DEPRECATED enumA "Use scalarA instead" #-}
|
||||
enumA :: MonadIO m => Name -> (Arguments -> ActionT m [Text]) -> Resolver m
|
||||
enumA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
where
|
||||
resolveRight fld resolver = withField (return resolver) fld
|
||||
|
||||
-- | Like 'enum' but also taking 'Argument's and can be null or a list of enums.
|
||||
{-# DEPRECATED wrappedEnumA "Use wrappedScalarA instead" #-}
|
||||
wrappedEnumA :: MonadIO m
|
||||
=> Name -> (Arguments -> ActionT m (Wrapping [Text])) -> Resolver m
|
||||
wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
|
||||
|
@ -131,7 +131,7 @@ wrappedEnumA name f = Resolver name $ resolveFieldValue f resolveRight
|
|||
= return $ HashMap.singleton (aliasOrName fld) Aeson.Null
|
||||
resolveRight fld (List resolver) = withField (return resolver) fld
|
||||
|
||||
-- | Like 'enum' but can be null or a list of enums.
|
||||
{-# DEPRECATED wrappedEnum "Use wrappedScalar instead" #-}
|
||||
wrappedEnum :: MonadIO m => Name -> ActionT m (Wrapping [Text]) -> Resolver m
|
||||
wrappedEnum name = wrappedEnumA name . const
|
||||
|
||||
|
|
|
@ -9,6 +9,7 @@ import Control.Monad.Trans.Class (MonadTrans(..))
|
|||
import Control.Monad.Trans.Except (ExceptT)
|
||||
import Data.Text (Text)
|
||||
|
||||
-- | Monad transformer stack used by the resolvers to provide error handling.
|
||||
newtype ActionT m a = ActionT { runActionT :: ExceptT Text m a }
|
||||
|
||||
instance Functor m => Functor (ActionT m) where
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
resolver: lts-14.0
|
||||
resolver: lts-14.5
|
||||
packages:
|
||||
- '.'
|
||||
extra-deps: []
|
||||
|
|
|
@ -1,4 +1,5 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Language.GraphQL.ParserSpec
|
||||
( spec
|
||||
) where
|
||||
|
@ -11,8 +12,19 @@ import Test.Hspec ( Spec
|
|||
, shouldSatisfy
|
||||
)
|
||||
import Text.Megaparsec (parse)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Parser" $
|
||||
spec = describe "Parser" $ do
|
||||
it "accepts BOM header" $
|
||||
parse document "" "\xfeff{foo}" `shouldSatisfy` isRight
|
||||
|
||||
it "accepts block strings as argument" $
|
||||
parse document "" [r|{
|
||||
hello(text: """Argument""")
|
||||
}|] `shouldSatisfy` isRight
|
||||
|
||||
it "accepts strings as argument" $
|
||||
parse document "" [r|{
|
||||
hello(text: "Argument")
|
||||
}|] `shouldSatisfy` isRight
|
||||
|
|
|
@ -26,6 +26,7 @@ import Control.Monad.Trans.Except (throwE)
|
|||
import Data.Maybe (catMaybes)
|
||||
import Data.Text (Text)
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type
|
||||
|
||||
-- * Data
|
||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsData.js
|
||||
|
@ -190,8 +191,8 @@ getDroid' _ = empty
|
|||
getFriends :: Character -> [Character]
|
||||
getFriends char = catMaybes $ liftA2 (<|>) getDroid getHuman <$> friends char
|
||||
|
||||
getEpisode :: Alternative f => Int -> f Text
|
||||
getEpisode 4 = pure "NEWHOPE"
|
||||
getEpisode 5 = pure "EMPIRE"
|
||||
getEpisode 6 = pure "JEDI"
|
||||
getEpisode :: Int -> Maybe (Wrapping Text)
|
||||
getEpisode 4 = pure $ Named "NEWHOPE"
|
||||
getEpisode 5 = pure $ Named "EMPIRE"
|
||||
getEpisode 6 = pure $ Named "JEDI"
|
||||
getEpisode _ = empty
|
||||
|
|
|
@ -11,52 +11,48 @@ module Test.StarWars.Schema
|
|||
import Control.Monad.Trans.Except (throwE)
|
||||
import Control.Monad.Trans.Class (lift)
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import Language.GraphQL.Schema ( Schema
|
||||
, Resolver
|
||||
, Argument(..)
|
||||
, Value(..)
|
||||
)
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Data.Maybe (catMaybes)
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import Language.GraphQL.Trans
|
||||
import Language.GraphQL.Type
|
||||
import Test.StarWars.Data
|
||||
|
||||
-- * Schema
|
||||
-- See https://github.com/graphql/graphql-js/blob/master/src/__tests__/starWarsSchema.js
|
||||
|
||||
schema :: MonadIO m => Schema m
|
||||
schema :: MonadIO m => NonEmpty (Schema.Resolver m)
|
||||
schema = hero :| [human, droid]
|
||||
|
||||
hero :: MonadIO m => Resolver m
|
||||
hero :: MonadIO m => Schema.Resolver m
|
||||
hero = Schema.objectA "hero" $ \case
|
||||
[] -> character artoo
|
||||
[Argument "episode" (ValueEnum "NEWHOPE")] -> character $ getHero 4
|
||||
[Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5
|
||||
[Argument "episode" (ValueEnum "JEDI" )] -> character $ getHero 6
|
||||
[Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4
|
||||
[Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5
|
||||
[Schema.Argument "episode" (Schema.ValueEnum "JEDI" )] -> character $ getHero 6
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
human :: MonadIO m => Resolver m
|
||||
human :: MonadIO m => Schema.Resolver m
|
||||
human = Schema.wrappedObjectA "human" $ \case
|
||||
[Argument "id" (ValueString i)] -> do
|
||||
[Schema.Argument "id" (Schema.ValueString i)] -> do
|
||||
humanCharacter <- lift $ return $ getHuman i >>= Just
|
||||
case humanCharacter of
|
||||
Nothing -> return Null
|
||||
Just e -> Named <$> character e
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
droid :: MonadIO m => Resolver m
|
||||
droid :: MonadIO m => Schema.Resolver m
|
||||
droid = Schema.objectA "droid" $ \case
|
||||
[Argument "id" (ValueString i)] -> character =<< liftIO (getDroid i)
|
||||
[Schema.Argument "id" (Schema.ValueString i)] -> character =<< liftIO (getDroid i)
|
||||
_ -> ActionT $ throwE "Invalid arguments."
|
||||
|
||||
character :: MonadIO m => Character -> ActionT m [Resolver m]
|
||||
character :: MonadIO m => Character -> ActionT m [Schema.Resolver m]
|
||||
character char = return
|
||||
[ Schema.scalar "id" $ return $ id_ char
|
||||
, Schema.scalar "name" $ return $ name char
|
||||
, Schema.wrappedObject "friends"
|
||||
$ traverse character $ List $ Named <$> getFriends char
|
||||
, Schema.enum "appearsIn" $ return $ foldMap getEpisode $ appearsIn char
|
||||
, Schema.wrappedScalar "appearsIn" $ return . List
|
||||
$ catMaybes (getEpisode <$> appearsIn char)
|
||||
, Schema.scalar "secretBackstory" $ secretBackstory char
|
||||
, Schema.scalar "homePlanet" $ return $ either mempty homePlanet char
|
||||
, Schema.scalar "__typename" $ return $ typeName char
|
||||
|
|
Loading…
Reference in New Issue