diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Language/GraphQL.hs | 43 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST.hs | 67 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Core.hs | 86 | ||||
| -rw-r--r-- | src/Language/GraphQL/AST/Transform.hs | 3 | ||||
| -rw-r--r-- | src/Language/GraphQL/Execute.hs | 50 | ||||
| -rw-r--r-- | src/Language/GraphQL/Lexer.hs | 2 | ||||
| -rw-r--r-- | src/Language/GraphQL/Parser.hs | 5 | ||||
| -rw-r--r-- | src/Language/GraphQL/Schema.hs | 12 | ||||
| -rw-r--r-- | src/Language/GraphQL/Trans.hs | 1 |
9 files changed, 180 insertions, 89 deletions
diff --git a/src/Language/GraphQL.hs b/src/Language/GraphQL.hs index 7ac08d7..c33eb95 100644 --- a/src/Language/GraphQL.hs +++ b/src/Language/GraphQL.hs @@ -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 Language.GraphQL.Error +import qualified Language.GraphQL.Schema as Schema +import Text.Megaparsec (parse) --- | 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 "" diff --git a/src/Language/GraphQL/AST.hs b/src/Language/GraphQL/AST.hs index 667e4d7..8f40c10 100644 --- a/src/Language/GraphQL/AST.hs +++ b/src/Language/GraphQL/AST.hs @@ -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) diff --git a/src/Language/GraphQL/AST/Core.hs b/src/Language/GraphQL/AST/Core.hs index 87dced9..977153f 100644 --- a/src/Language/GraphQL/AST/Core.hs +++ b/src/Language/GraphQL/AST/Core.hs @@ -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) diff --git a/src/Language/GraphQL/AST/Transform.hs b/src/Language/GraphQL/AST/Transform.hs index 63a2c72..99e0f3e 100644 --- a/src/Language/GraphQL/AST/Transform.hs +++ b/src/Language/GraphQL/AST/Transform.hs @@ -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 diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs index 5a815b8..9228dd5 100644 --- a/src/Language/GraphQL/Execute.hs +++ b/src/Language/GraphQL/Execute.hs @@ -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) diff --git a/src/Language/GraphQL/Lexer.hs b/src/Language/GraphQL/Lexer.hs index 8ca03bf..dc000b5 100644 --- a/src/Language/GraphQL/Lexer.hs +++ b/src/Language/GraphQL/Lexer.hs @@ -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 diff --git a/src/Language/GraphQL/Parser.hs b/src/Language/GraphQL/Parser.hs index dac15c2..5ae71b2 100644 --- a/src/Language/GraphQL/Parser.hs +++ b/src/Language/GraphQL/Parser.hs @@ -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 diff --git a/src/Language/GraphQL/Schema.hs b/src/Language/GraphQL/Schema.hs index 08b52ce..428b80e 100644 --- a/src/Language/GraphQL/Schema.hs +++ b/src/Language/GraphQL/Schema.hs @@ -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 diff --git a/src/Language/GraphQL/Trans.hs b/src/Language/GraphQL/Trans.hs index 5ca72e9..d92aea7 100644 --- a/src/Language/GraphQL/Trans.hs +++ b/src/Language/GraphQL/Trans.hs @@ -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 |