diff options
| -rw-r--r-- | CHANGELOG.md | 19 | ||||
| -rw-r--r-- | README.md | 4 | ||||
| -rw-r--r-- | docs/tutorial/tutorial.lhs | 7 | ||||
| -rw-r--r-- | graphql.cabal | 4 | ||||
| -rw-r--r-- | package.yaml | 2 | ||||
| -rwxr-xr-x | semaphoreci.sh | 3 | ||||
| -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 | ||||
| -rw-r--r-- | stack.yaml | 2 | ||||
| -rw-r--r-- | tests/Language/GraphQL/ParserSpec.hs | 14 | ||||
| -rw-r--r-- | tests/Test/StarWars/Data.hs | 9 | ||||
| -rw-r--r-- | tests/Test/StarWars/Schema.hs | 32 |
19 files changed, 242 insertions, 123 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md index efdf1c6..2094038 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/docs/tutorial/tutorial.lhs b/docs/tutorial/tutorial.lhs index a4943c6..d017ddd 100644 --- a/docs/tutorial/tutorial.lhs +++ b/docs/tutorial/tutorial.lhs @@ -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 diff --git a/graphql.cabal b/graphql.cabal index b8d699e..74a6cf1 100644 --- a/graphql.cabal +++ b/graphql.cabal @@ -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 diff --git a/package.yaml b/package.yaml index 000fdf9..eb45953 100644 --- a/package.yaml +++ b/package.yaml @@ -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 diff --git a/semaphoreci.sh b/semaphoreci.sh index f77ac75..309798a 100755 --- a/semaphoreci.sh +++ b/semaphoreci.sh @@ -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() { 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 @@ -1,4 +1,4 @@ -resolver: lts-14.0 +resolver: lts-14.5 packages: - '.' extra-deps: [] diff --git a/tests/Language/GraphQL/ParserSpec.hs b/tests/Language/GraphQL/ParserSpec.hs index c412c85..6425ea5 100644 --- a/tests/Language/GraphQL/ParserSpec.hs +++ b/tests/Language/GraphQL/ParserSpec.hs @@ -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 diff --git a/tests/Test/StarWars/Data.hs b/tests/Test/StarWars/Data.hs index 55ff207..6a514c5 100644 --- a/tests/Test/StarWars/Data.hs +++ b/tests/Test/StarWars/Data.hs @@ -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 diff --git a/tests/Test/StarWars/Schema.hs b/tests/Test/StarWars/Schema.hs index 101bbdf..f516f2a 100644 --- a/tests/Test/StarWars/Schema.hs +++ b/tests/Test/StarWars/Schema.hs @@ -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 |