Release 0.5.0.1

These functions are from Language.GraphQL.Schema.
There are actually only two generic types in GraphQL: Scalars and objects.
Enum is a scalar value. According to the specification enums may be
serailized to strings. And in the current implementation they used
untyped strings anyway, so there is no point to have differently named
functions with the same implementation as their scalar counterparts.

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

README.md

@@ -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
+compile-time magic. It focuses on flexibility instead, so other solutions can
-solutions can be built on top of it.
+be built on top of it.
 
 ## State of the work
 

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

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

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

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() {

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 qualified Language.GraphQL.Schema as Schema
+import Text.Megaparsec (parse)
 
-import Language.GraphQL.Error
+-- | If the text parses correctly as a @GraphQL@ query the query is
-
+-- executed using the given 'Schema.Resolver's.
--- | Takes a 'Schema' and text representing a @GraphQL@ request document.
+graphql :: MonadIO m
---   If the text parses correctly as a @GraphQL@ query the query is
+    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
---   executed according to the given 'Schema'.
+    -> T.Text -- ^ Text representing a @GraphQL@ request document.
---
+    -> m Aeson.Value -- ^ Response.
---   Returns the response as an @Aeson.@'Aeson.Value'.
-graphql :: MonadIO m => Schema m -> T.Text -> m Aeson.Value
 graphql = flip graphqlSubs $ const Nothing
 
--- | Takes a 'Schema', a variable substitution function and text
+-- | If the text parses correctly as a @GraphQL@ query the substitution is
---   representing a @GraphQL@ request document.  If the text parses
+-- applied to the query and the query is then executed using to the given
---   correctly as a @GraphQL@ query the substitution is applied to the
+-- 'Schema.Resolver's.
---   query and the query is then executed according to the given 'Schema'.
+graphqlSubs :: MonadIO m
---
+    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
---   Returns the response as an @Aeson.@'Aeson.Value'.
+    -> Schema.Subs -- ^ Variable substitution function.
-graphqlSubs :: MonadIO m => Schema m -> Subs -> T.Text -> m Aeson.Value
+    -> T.Text -- ^ Text representing a @GraphQL@ request document.
-graphqlSubs schema f =
+    -> m Aeson.Value -- ^ Response.
-    either parseError (execute schema f)
+graphqlSubs schema f
+    = either parseError (execute schema f)
     . parse document ""

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
+-- | Single selection element.
-               | SelectionFragmentSpread FragmentSpread
+data Selection
-               | SelectionInlineFragment InlineFragment
+    = SelectionField          Field
-                 deriving (Eq,Show)
+    | SelectionFragmentSpread FragmentSpread
+    | SelectionInlineFragment InlineFragment
+    deriving (Eq, Show)
 
 -- * Field
 
-data Field = Field (Maybe Alias) Name Arguments Directives SelectionSetOpt
+-- | GraphQL field.
-             deriving (Eq,Show)
+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 =
+-- | Fragment definition.
-  FragmentDefinition FragmentName TypeCondition Directives SelectionSet
+data FragmentDefinition
-  deriving (Eq,Show)
+    = 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)

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)
+-- | GraphQL has 3 operation types: queries, mutations and subscribtions.
-               | Mutation (Maybe Text) (NonEmpty Field)
+--
-                 deriving (Eq,Show)
+-- 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
+-- | Represents accordingly typed GraphQL values.
-           -- GraphQL Float is double precision
+data Value
-           | ValueFloat Double
+    = ValueInt Int32
-           | ValueString Text
+    -- GraphQL Float is double precision
-           | ValueBoolean Bool
+    | ValueFloat Double
-           | ValueNull
+    | ValueString Text
-           | ValueEnum Name
+    | ValueBoolean Bool
-           | ValueList [Value]
+    | ValueNull
-           | ValueObject [ObjectField]
+    | ValueEnum Name
-             deriving (Eq,Show)
+    | 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)

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

src/Language/GraphQL/Execute.hs

@@ -1,7 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
--- | This module provides the function to execute a @GraphQL@ request --
+-- | This module provides functions to execute a @GraphQL@ request.
---   according to a 'Schema'.
 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
+-- | The substitution is applied to the document, and the resolvers are applied
---   @GraphQL@ 'document'. The substitution is applied to the document using
+-- to the resulting fields.
---  'rootFields', and the 'Schema''s resolvers are applied to the resulting fields.
 --
---   Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
+-- Returns the result of the query against the schema wrapped in a /data/
---   errors wrapped in an /errors/ field.
+-- field, or errors wrapped in an /errors/ field.
 execute :: MonadIO m
-    => Schema m
+    => NonEmpty (Schema.Resolver m) -- ^ Resolvers.
-    -> Schema.Subs
+    -> Schema.Subs -- ^ Variable substitution function.
-    -> AST.Document
+    -> 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'),
+-- | The substitution is applied to the document, and the resolvers are applied
---   and a @GraphQL@ 'document'. The substitution is applied to the document using
+-- to the resulting fields. The operation name can be used if the document
---  'rootFields', and the 'Schema''s resolvers are applied to the resulting fields.
+-- defines multiple root operations.
 --
---   Returns the result of the query against the 'Schema' wrapped in a /data/ field, or
+-- Returns the result of the query against the schema wrapped in a /data/
---   errors wrapped in an /errors/ field.
+-- field, or errors wrapped in an /errors/ field.
 executeWithName :: MonadIO m
-    => Schema m
+    => NonEmpty (Schema.Resolver m) -- ^ Resolvers
-    -> Text
+    -> Text -- ^ Operation name.
-    -> Schema.Subs
+    -> Schema.Subs -- ^ Variable substitution function.
-    -> AST.Document
+    -> 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)

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
 

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

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.
+{-# DEPRECATED enum "Use scalar instead" #-}
---   Used in place of a 'scalar' when the possible responses are easily enumerable.
 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
 

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

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-14.0
+resolver: lts-14.5
 packages:
 - '.'
 extra-deps: []

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

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 :: Int -> Maybe (Wrapping Text)
-getEpisode 4 = pure "NEWHOPE"
+getEpisode 4 = pure $ Named "NEWHOPE"
-getEpisode 5 = pure "EMPIRE"
+getEpisode 5 = pure $ Named "EMPIRE"
-getEpisode 6 = pure "JEDI"
+getEpisode 6 = pure $ Named "JEDI"
 getEpisode _ = empty

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 Data.List.NonEmpty (NonEmpty(..))
-import Language.GraphQL.Schema ( Schema
+import Data.Maybe (catMaybes)
-                               , Resolver
-                               , Argument(..)
-                               , Value(..)
-                               )
 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
+  [Schema.Argument "episode" (Schema.ValueEnum "NEWHOPE")] -> character $ getHero 4
-  [Argument "episode" (ValueEnum "EMPIRE" )] -> character $ getHero 5
+  [Schema.Argument "episode" (Schema.ValueEnum "EMPIRE" )] -> character $ getHero 5
-  [Argument "episode" (ValueEnum "JEDI"   )] -> character $ getHero 6
+  [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