Compare commits
9 Commits
Author | SHA1 | Date |
---|---|---|
Eugen Wissner | bdf711d69f | |
Eugen Wissner | b215e1a4a7 | |
Eugen Wissner | 1e55f17e7e | |
Eugen Wissner | 9a5d54c035 | |
Eugen Wissner | 0cbe69736b | |
Eugen Wissner | 4c0d226030 | |
Eugen Wissner | 3c1a5c800f | |
Eugen Wissner | fc9ad9c4a1 | |
Sam Nolan | def52ddc20 |
15
CHANGELOG.md
15
CHANGELOG.md
|
@ -1,6 +1,20 @@
|
|||
# Change Log
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## [0.6.1.0] - 2019-12-23
|
||||
### Fixed
|
||||
- Parsing multiple string arguments, such as
|
||||
`login(username: "username", password: "password")` would fail on the comma
|
||||
due to strings not having a space consumer.
|
||||
- Fragment spread is evaluated based on the `__typename` resolver. If the
|
||||
resolver is missing, it is assumed that the type condition is satisfied (all
|
||||
fragments are included).
|
||||
- Escaping characters during encoding.
|
||||
|
||||
### Added
|
||||
- Directive support (@skip and @include).
|
||||
- Pretifying multi-line string arguments as block strings.
|
||||
|
||||
## [0.6.0.0] - 2019-11-27
|
||||
### Changed
|
||||
- `Language.GraphQL.Encoder` moved to `Language.GraphQL.AST.Encoder`.
|
||||
|
@ -148,6 +162,7 @@ All notable changes to this project will be documented in this file.
|
|||
### Added
|
||||
- Data types for the GraphQL language.
|
||||
|
||||
[0.6.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.6.0.0...v0.6.1.0
|
||||
[0.6.0.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.1.0...v0.6.0.0
|
||||
[0.5.1.0]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.1...v0.5.1.0
|
||||
[0.5.0.1]: https://github.com/caraus-ecms/graphql/compare/v0.5.0.0...v0.5.0.1
|
||||
|
|
|
@ -1,5 +1,5 @@
|
|||
name: graphql
|
||||
version: 0.6.0.0
|
||||
version: 0.6.1.0
|
||||
synopsis: Haskell GraphQL implementation
|
||||
description:
|
||||
This package provides a rudimentary parser for the
|
||||
|
@ -37,7 +37,8 @@ dependencies:
|
|||
library:
|
||||
source-dirs: src
|
||||
other-modules:
|
||||
- Language.GraphQL.AST.Transform
|
||||
- Language.GraphQL.Execute.Transform
|
||||
- Language.GraphQL.Type.Directive
|
||||
|
||||
tests:
|
||||
tasty:
|
||||
|
|
|
@ -2,6 +2,8 @@
|
|||
module Language.GraphQL.AST.Core
|
||||
( Alias
|
||||
, Argument(..)
|
||||
, Arguments(..)
|
||||
, Directive(..)
|
||||
, Document
|
||||
, Field(..)
|
||||
, Fragment(..)
|
||||
|
@ -39,6 +41,14 @@ data Field
|
|||
-- | Single argument.
|
||||
data Argument = Argument Name Value deriving (Eq, Show)
|
||||
|
||||
-- | Argument list.
|
||||
newtype Arguments = Arguments (HashMap Name Value)
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Directive.
|
||||
data Directive = Directive Name Arguments
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | Represents fragments and inline fragments.
|
||||
data Fragment
|
||||
= Fragment TypeCondition (Seq Selection)
|
||||
|
|
|
@ -13,13 +13,17 @@ module Language.GraphQL.AST.Encoder
|
|||
, value
|
||||
) where
|
||||
|
||||
import Data.Char (ord)
|
||||
import Data.Foldable (fold)
|
||||
import Data.Monoid ((<>))
|
||||
import qualified Data.List.NonEmpty as NonEmpty (toList)
|
||||
import Data.Text.Lazy (Text)
|
||||
import qualified Data.Text.Lazy as Text.Lazy
|
||||
import Data.Text.Lazy.Builder (toLazyText)
|
||||
import Data.Text.Lazy.Builder.Int (decimal)
|
||||
import qualified Data.List.NonEmpty as NonEmpty
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import qualified Data.Text.Lazy as Lazy (Text)
|
||||
import qualified Data.Text.Lazy as Lazy.Text
|
||||
import Data.Text.Lazy.Builder (Builder)
|
||||
import qualified Data.Text.Lazy.Builder as Builder
|
||||
import Data.Text.Lazy.Builder.Int (decimal, hexadecimal)
|
||||
import Data.Text.Lazy.Builder.RealFloat (realFloat)
|
||||
import qualified Language.GraphQL.AST as Full
|
||||
|
||||
|
@ -40,17 +44,17 @@ minified :: Formatter
|
|||
minified = Minified
|
||||
|
||||
-- | Converts a 'Full.Document' into a string.
|
||||
document :: Formatter -> Full.Document -> Text
|
||||
document :: Formatter -> Full.Document -> Lazy.Text
|
||||
document formatter defs
|
||||
| Pretty _ <- formatter = Text.Lazy.intercalate "\n" encodeDocument
|
||||
| Minified <-formatter = Text.Lazy.snoc (mconcat encodeDocument) '\n'
|
||||
| Pretty _ <- formatter = Lazy.Text.intercalate "\n" encodeDocument
|
||||
| Minified <-formatter = Lazy.Text.snoc (mconcat encodeDocument) '\n'
|
||||
where
|
||||
encodeDocument = NonEmpty.toList $ definition formatter <$> defs
|
||||
|
||||
-- | Converts a 'Full.Definition' into a string.
|
||||
definition :: Formatter -> Full.Definition -> Text
|
||||
definition :: Formatter -> Full.Definition -> Lazy.Text
|
||||
definition formatter x
|
||||
| Pretty _ <- formatter = Text.Lazy.snoc (encodeDefinition x) '\n'
|
||||
| Pretty _ <- formatter = Lazy.Text.snoc (encodeDefinition x) '\n'
|
||||
| Minified <- formatter = encodeDefinition x
|
||||
where
|
||||
encodeDefinition (Full.DefinitionOperation operation)
|
||||
|
@ -58,7 +62,7 @@ definition formatter x
|
|||
encodeDefinition (Full.DefinitionFragment fragment)
|
||||
= fragmentDefinition formatter fragment
|
||||
|
||||
operationDefinition :: Formatter -> Full.OperationDefinition -> Text
|
||||
operationDefinition :: Formatter -> Full.OperationDefinition -> Lazy.Text
|
||||
operationDefinition formatter (Full.OperationSelectionSet sels)
|
||||
= selectionSet formatter sels
|
||||
operationDefinition formatter (Full.OperationDefinition Full.Query name vars dirs sels)
|
||||
|
@ -66,99 +70,106 @@ operationDefinition formatter (Full.OperationDefinition Full.Query name vars dir
|
|||
operationDefinition formatter (Full.OperationDefinition Full.Mutation name vars dirs sels)
|
||||
= "mutation " <> node formatter name vars dirs sels
|
||||
|
||||
node :: Formatter
|
||||
-> Maybe Full.Name
|
||||
-> [Full.VariableDefinition]
|
||||
-> [Full.Directive]
|
||||
-> Full.SelectionSet
|
||||
-> Text
|
||||
node :: Formatter ->
|
||||
Maybe Full.Name ->
|
||||
[Full.VariableDefinition] ->
|
||||
[Full.Directive] ->
|
||||
Full.SelectionSet ->
|
||||
Lazy.Text
|
||||
node formatter name vars dirs sels
|
||||
= Text.Lazy.fromStrict (fold name)
|
||||
= Lazy.Text.fromStrict (fold name)
|
||||
<> optempty (variableDefinitions formatter) vars
|
||||
<> optempty (directives formatter) dirs
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Text
|
||||
variableDefinitions :: Formatter -> [Full.VariableDefinition] -> Lazy.Text
|
||||
variableDefinitions formatter
|
||||
= parensCommas formatter $ variableDefinition formatter
|
||||
|
||||
variableDefinition :: Formatter -> Full.VariableDefinition -> Text
|
||||
variableDefinition :: Formatter -> Full.VariableDefinition -> Lazy.Text
|
||||
variableDefinition formatter (Full.VariableDefinition var ty dv)
|
||||
= variable var
|
||||
<> eitherFormat formatter ": " ":"
|
||||
<> type' ty
|
||||
<> maybe mempty (defaultValue formatter) dv
|
||||
|
||||
defaultValue :: Formatter -> Full.Value -> Text
|
||||
defaultValue :: Formatter -> Full.Value -> Lazy.Text
|
||||
defaultValue formatter val
|
||||
= eitherFormat formatter " = " "="
|
||||
<> value formatter val
|
||||
|
||||
variable :: Full.Name -> Text
|
||||
variable var = "$" <> Text.Lazy.fromStrict var
|
||||
variable :: Full.Name -> Lazy.Text
|
||||
variable var = "$" <> Lazy.Text.fromStrict var
|
||||
|
||||
selectionSet :: Formatter -> Full.SelectionSet -> Text
|
||||
selectionSet :: Formatter -> Full.SelectionSet -> Lazy.Text
|
||||
selectionSet formatter
|
||||
= bracesList formatter (selection formatter)
|
||||
. NonEmpty.toList
|
||||
|
||||
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Text
|
||||
selectionSetOpt :: Formatter -> Full.SelectionSetOpt -> Lazy.Text
|
||||
selectionSetOpt formatter = bracesList formatter $ selection formatter
|
||||
|
||||
selection :: Formatter -> Full.Selection -> Text
|
||||
selection formatter = Text.Lazy.append indent . f
|
||||
where
|
||||
f (Full.SelectionField x) = field incrementIndent x
|
||||
f (Full.SelectionInlineFragment x) = inlineFragment incrementIndent x
|
||||
f (Full.SelectionFragmentSpread x) = fragmentSpread incrementIndent x
|
||||
incrementIndent
|
||||
| Pretty n <- formatter = Pretty $ n + 1
|
||||
| otherwise = Minified
|
||||
indent
|
||||
| Pretty n <- formatter = Text.Lazy.replicate (fromIntegral $ n + 1) " "
|
||||
| otherwise = mempty
|
||||
indent :: (Integral a) => a -> Lazy.Text
|
||||
indent indentation = Lazy.Text.replicate (fromIntegral indentation) " "
|
||||
|
||||
field :: Formatter -> Full.Field -> Text
|
||||
field formatter (Full.Field alias name args dirs selso)
|
||||
= optempty (`Text.Lazy.append` colon) (Text.Lazy.fromStrict $ fold alias)
|
||||
<> Text.Lazy.fromStrict name
|
||||
selection :: Formatter -> Full.Selection -> Lazy.Text
|
||||
selection formatter = Lazy.Text.append indent' . encodeSelection
|
||||
where
|
||||
encodeSelection (Full.SelectionField field') = field incrementIndent field'
|
||||
encodeSelection (Full.SelectionInlineFragment fragment) =
|
||||
inlineFragment incrementIndent fragment
|
||||
encodeSelection (Full.SelectionFragmentSpread spread) =
|
||||
fragmentSpread incrementIndent spread
|
||||
incrementIndent
|
||||
| Pretty indentation <- formatter = Pretty $ indentation + 1
|
||||
| otherwise = Minified
|
||||
indent'
|
||||
| Pretty indentation <- formatter = indent $ indentation + 1
|
||||
| otherwise = ""
|
||||
|
||||
colon :: Formatter -> Lazy.Text
|
||||
colon formatter = eitherFormat formatter ": " ":"
|
||||
|
||||
field :: Formatter -> Full.Field -> Lazy.Text
|
||||
field formatter (Full.Field alias name args dirs set)
|
||||
= optempty prependAlias (fold alias)
|
||||
<> Lazy.Text.fromStrict name
|
||||
<> optempty (arguments formatter) args
|
||||
<> optempty (directives formatter) dirs
|
||||
<> selectionSetOpt'
|
||||
<> optempty selectionSetOpt' set
|
||||
where
|
||||
colon = eitherFormat formatter ": " ":"
|
||||
selectionSetOpt'
|
||||
| null selso = mempty
|
||||
| otherwise = eitherFormat formatter " " mempty <> selectionSetOpt formatter selso
|
||||
prependAlias aliasName = Lazy.Text.fromStrict aliasName <> colon formatter
|
||||
selectionSetOpt' = (eitherFormat formatter " " "" <>)
|
||||
. selectionSetOpt formatter
|
||||
|
||||
arguments :: Formatter -> [Full.Argument] -> Text
|
||||
arguments :: Formatter -> [Full.Argument] -> Lazy.Text
|
||||
arguments formatter = parensCommas formatter $ argument formatter
|
||||
|
||||
argument :: Formatter -> Full.Argument -> Text
|
||||
argument formatter (Full.Argument name v)
|
||||
= Text.Lazy.fromStrict name
|
||||
<> eitherFormat formatter ": " ":"
|
||||
<> value formatter v
|
||||
argument :: Formatter -> Full.Argument -> Lazy.Text
|
||||
argument formatter (Full.Argument name value')
|
||||
= Lazy.Text.fromStrict name
|
||||
<> colon formatter
|
||||
<> value formatter value'
|
||||
|
||||
-- * Fragments
|
||||
|
||||
fragmentSpread :: Formatter -> Full.FragmentSpread -> Text
|
||||
fragmentSpread :: Formatter -> Full.FragmentSpread -> Lazy.Text
|
||||
fragmentSpread formatter (Full.FragmentSpread name ds)
|
||||
= "..." <> Text.Lazy.fromStrict name <> optempty (directives formatter) ds
|
||||
= "..." <> Lazy.Text.fromStrict name <> optempty (directives formatter) ds
|
||||
|
||||
inlineFragment :: Formatter -> Full.InlineFragment -> Text
|
||||
inlineFragment :: Formatter -> Full.InlineFragment -> Lazy.Text
|
||||
inlineFragment formatter (Full.InlineFragment tc dirs sels)
|
||||
= "... on "
|
||||
<> Text.Lazy.fromStrict (fold tc)
|
||||
<> Lazy.Text.fromStrict (fold tc)
|
||||
<> directives formatter dirs
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
||||
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Text
|
||||
fragmentDefinition :: Formatter -> Full.FragmentDefinition -> Lazy.Text
|
||||
fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
|
||||
= "fragment " <> Text.Lazy.fromStrict name
|
||||
<> " on " <> Text.Lazy.fromStrict tc
|
||||
= "fragment " <> Lazy.Text.fromStrict name
|
||||
<> " on " <> Lazy.Text.fromStrict tc
|
||||
<> optempty (directives formatter) dirs
|
||||
<> eitherFormat formatter " " mempty
|
||||
<> selectionSet formatter sels
|
||||
|
@ -166,108 +177,128 @@ fragmentDefinition formatter (Full.FragmentDefinition name tc dirs sels)
|
|||
-- * Miscellaneous
|
||||
|
||||
-- | Converts a 'Full.Directive' into a string.
|
||||
directive :: Formatter -> Full.Directive -> Text
|
||||
directive :: Formatter -> Full.Directive -> Lazy.Text
|
||||
directive formatter (Full.Directive name args)
|
||||
= "@" <> Text.Lazy.fromStrict name <> optempty (arguments formatter) args
|
||||
= "@" <> Lazy.Text.fromStrict name <> optempty (arguments formatter) args
|
||||
|
||||
directives :: Formatter -> [Full.Directive] -> Text
|
||||
directives formatter@(Pretty _) = Text.Lazy.cons ' ' . spaces (directive formatter)
|
||||
directives :: Formatter -> [Full.Directive] -> Lazy.Text
|
||||
directives Minified = spaces (directive Minified)
|
||||
directives formatter = Lazy.Text.cons ' ' . spaces (directive formatter)
|
||||
|
||||
-- | Converts a 'Full.Value' into a string.
|
||||
value :: Formatter -> Full.Value -> Text
|
||||
value :: Formatter -> Full.Value -> Lazy.Text
|
||||
value _ (Full.Variable x) = variable x
|
||||
value _ (Full.Int x) = toLazyText $ decimal x
|
||||
value _ (Full.Float x) = toLazyText $ realFloat x
|
||||
value _ (Full.Int x) = Builder.toLazyText $ decimal x
|
||||
value _ (Full.Float x) = Builder.toLazyText $ realFloat x
|
||||
value _ (Full.Boolean x) = booleanValue x
|
||||
value _ Full.Null = mempty
|
||||
value _ (Full.String x) = stringValue $ Text.Lazy.fromStrict x
|
||||
value _ (Full.Enum x) = Text.Lazy.fromStrict x
|
||||
value formatter (Full.String string) = stringValue formatter string
|
||||
value _ (Full.Enum x) = Lazy.Text.fromStrict x
|
||||
value formatter (Full.List x) = listValue formatter x
|
||||
value formatter (Full.Object x) = objectValue formatter x
|
||||
|
||||
booleanValue :: Bool -> Text
|
||||
booleanValue :: Bool -> Lazy.Text
|
||||
booleanValue True = "true"
|
||||
booleanValue False = "false"
|
||||
|
||||
stringValue :: Text -> Text
|
||||
stringValue
|
||||
= quotes
|
||||
. Text.Lazy.replace "\"" "\\\""
|
||||
. Text.Lazy.replace "\\" "\\\\"
|
||||
stringValue :: Formatter -> Text -> Lazy.Text
|
||||
stringValue Minified string = Builder.toLazyText
|
||||
$ quote <> Text.foldr (mappend . escape') quote string
|
||||
where
|
||||
quote = Builder.singleton '\"'
|
||||
escape' '\n' = Builder.fromString "\\n"
|
||||
escape' char = escape char
|
||||
stringValue (Pretty indentation) string = byStringType $ Text.lines string
|
||||
where
|
||||
byStringType [] = "\"\""
|
||||
byStringType [line] = Builder.toLazyText
|
||||
$ quote <> Text.foldr (mappend . escape) quote line
|
||||
byStringType lines' = "\"\"\"\n"
|
||||
<> Lazy.Text.unlines (transformLine <$> lines')
|
||||
<> indent indentation
|
||||
<> "\"\"\""
|
||||
transformLine = (indent (indentation + 1) <>)
|
||||
. Lazy.Text.fromStrict
|
||||
. Text.replace "\"\"\"" "\\\"\"\""
|
||||
quote = Builder.singleton '\"'
|
||||
|
||||
listValue :: Formatter -> [Full.Value] -> Text
|
||||
escape :: Char -> Builder
|
||||
escape char'
|
||||
| char' == '\\' = Builder.fromString "\\\\"
|
||||
| char' == '\"' = Builder.fromString "\\\""
|
||||
| char' == '\b' = Builder.fromString "\\b"
|
||||
| char' == '\f' = Builder.fromString "\\f"
|
||||
| char' == '\r' = Builder.fromString "\\r"
|
||||
| char' < '\x0010' = unicode "\\u000" char'
|
||||
| char' < '\x0020' = unicode "\\u00" char'
|
||||
| otherwise = Builder.singleton char'
|
||||
where
|
||||
unicode prefix = mappend (Builder.fromString prefix) . (hexadecimal . ord)
|
||||
|
||||
listValue :: Formatter -> [Full.Value] -> Lazy.Text
|
||||
listValue formatter = bracketsCommas formatter $ value formatter
|
||||
|
||||
objectValue :: Formatter -> [Full.ObjectField] -> Text
|
||||
objectValue :: Formatter -> [Full.ObjectField] -> Lazy.Text
|
||||
objectValue formatter = intercalate $ objectField formatter
|
||||
where
|
||||
intercalate f
|
||||
= braces
|
||||
. Text.Lazy.intercalate (eitherFormat formatter ", " ",")
|
||||
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
||||
. fmap f
|
||||
|
||||
|
||||
objectField :: Formatter -> Full.ObjectField -> Text
|
||||
objectField formatter (Full.ObjectField name v)
|
||||
= Text.Lazy.fromStrict name <> colon <> value formatter v
|
||||
where
|
||||
colon
|
||||
| Pretty _ <- formatter = ": "
|
||||
| Minified <- formatter = ":"
|
||||
objectField :: Formatter -> Full.ObjectField -> Lazy.Text
|
||||
objectField formatter (Full.ObjectField name value') =
|
||||
Lazy.Text.fromStrict name <> colon formatter <> value formatter value'
|
||||
|
||||
-- | Converts a 'Full.Type' a type into a string.
|
||||
type' :: Full.Type -> Text
|
||||
type' (Full.TypeNamed x) = Text.Lazy.fromStrict x
|
||||
type' :: Full.Type -> Lazy.Text
|
||||
type' (Full.TypeNamed x) = Lazy.Text.fromStrict x
|
||||
type' (Full.TypeList x) = listType x
|
||||
type' (Full.TypeNonNull x) = nonNullType x
|
||||
|
||||
listType :: Full.Type -> Text
|
||||
listType :: Full.Type -> Lazy.Text
|
||||
listType x = brackets (type' x)
|
||||
|
||||
nonNullType :: Full.NonNullType -> Text
|
||||
nonNullType (Full.NonNullTypeNamed x) = Text.Lazy.fromStrict x <> "!"
|
||||
nonNullType :: Full.NonNullType -> Lazy.Text
|
||||
nonNullType (Full.NonNullTypeNamed x) = Lazy.Text.fromStrict x <> "!"
|
||||
nonNullType (Full.NonNullTypeList x) = listType x <> "!"
|
||||
|
||||
-- * Internal
|
||||
|
||||
between :: Char -> Char -> Text -> Text
|
||||
between open close = Text.Lazy.cons open . (`Text.Lazy.snoc` close)
|
||||
between :: Char -> Char -> Lazy.Text -> Lazy.Text
|
||||
between open close = Lazy.Text.cons open . (`Lazy.Text.snoc` close)
|
||||
|
||||
parens :: Text -> Text
|
||||
parens :: Lazy.Text -> Lazy.Text
|
||||
parens = between '(' ')'
|
||||
|
||||
brackets :: Text -> Text
|
||||
brackets :: Lazy.Text -> Lazy.Text
|
||||
brackets = between '[' ']'
|
||||
|
||||
braces :: Text -> Text
|
||||
braces :: Lazy.Text -> Lazy.Text
|
||||
braces = between '{' '}'
|
||||
|
||||
quotes :: Text -> Text
|
||||
quotes = between '"' '"'
|
||||
spaces :: forall a. (a -> Lazy.Text) -> [a] -> Lazy.Text
|
||||
spaces f = Lazy.Text.intercalate "\SP" . fmap f
|
||||
|
||||
spaces :: forall a. (a -> Text) -> [a] -> Text
|
||||
spaces f = Text.Lazy.intercalate "\SP" . fmap f
|
||||
|
||||
parensCommas :: forall a. Formatter -> (a -> Text) -> [a] -> Text
|
||||
parensCommas :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
||||
parensCommas formatter f
|
||||
= parens
|
||||
. Text.Lazy.intercalate (eitherFormat formatter ", " ",")
|
||||
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
||||
. fmap f
|
||||
|
||||
bracketsCommas :: Formatter -> (a -> Text) -> [a] -> Text
|
||||
bracketsCommas :: Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
||||
bracketsCommas formatter f
|
||||
= brackets
|
||||
. Text.Lazy.intercalate (eitherFormat formatter ", " ",")
|
||||
. Lazy.Text.intercalate (eitherFormat formatter ", " ",")
|
||||
. fmap f
|
||||
|
||||
bracesList :: forall a. Formatter -> (a -> Text) -> [a] -> Text
|
||||
bracesList :: forall a. Formatter -> (a -> Lazy.Text) -> [a] -> Lazy.Text
|
||||
bracesList (Pretty intendation) f xs
|
||||
= Text.Lazy.snoc (Text.Lazy.intercalate "\n" content) '\n'
|
||||
<> (Text.Lazy.snoc $ Text.Lazy.replicate (fromIntegral intendation) " ") '}'
|
||||
= Lazy.Text.snoc (Lazy.Text.intercalate "\n" content) '\n'
|
||||
<> (Lazy.Text.snoc $ Lazy.Text.replicate (fromIntegral intendation) " ") '}'
|
||||
where
|
||||
content = "{" : fmap f xs
|
||||
bracesList Minified f xs = braces $ Text.Lazy.intercalate "," $ fmap f xs
|
||||
bracesList Minified f xs = braces $ Lazy.Text.intercalate "," $ fmap f xs
|
||||
|
||||
optempty :: (Eq a, Monoid a, Monoid b) => (a -> b) -> a -> b
|
||||
optempty f xs = if xs == mempty then mempty else f xs
|
||||
|
|
|
@ -134,7 +134,7 @@ braces = between (symbol "{") (symbol "}")
|
|||
|
||||
-- | Parser for strings.
|
||||
string :: Parser T.Text
|
||||
string = between "\"" "\"" stringValue
|
||||
string = between "\"" "\"" stringValue <* spaceConsumer
|
||||
where
|
||||
stringValue = T.pack <$> many stringCharacter
|
||||
stringCharacter = satisfy isStringCharacter1
|
||||
|
@ -143,7 +143,7 @@ string = between "\"" "\"" stringValue
|
|||
|
||||
-- | Parser for block strings.
|
||||
blockString :: Parser T.Text
|
||||
blockString = between "\"\"\"" "\"\"\"" stringValue
|
||||
blockString = between "\"\"\"" "\"\"\"" stringValue <* spaceConsumer
|
||||
where
|
||||
stringValue = do
|
||||
byLine <- sepBy (many blockStringCharacter) lineTerminator
|
||||
|
|
|
@ -15,7 +15,7 @@ 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 qualified Language.GraphQL.Execute.Transform as Transform
|
||||
import Language.GraphQL.Error
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
|
||||
|
|
|
@ -1,10 +1,10 @@
|
|||
{-# LANGUAGE TupleSections #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
|
||||
-- | After the document is parsed, before getting executed the AST is
|
||||
-- transformed into a similar, simpler AST. This module is responsible for
|
||||
-- this transformation.
|
||||
module Language.GraphQL.AST.Transform
|
||||
module Language.GraphQL.Execute.Transform
|
||||
( document
|
||||
) where
|
||||
|
||||
|
@ -20,15 +20,19 @@ import Data.Sequence (Seq, (<|), (><))
|
|||
import qualified Language.GraphQL.AST as Full
|
||||
import qualified Language.GraphQL.AST.Core as Core
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import qualified Language.GraphQL.Type.Directive as Directive
|
||||
|
||||
-- | Associates a fragment name with a list of 'Core.Field's.
|
||||
data Replacement = Replacement
|
||||
{ fragments :: HashMap Core.Name (Seq Core.Selection)
|
||||
{ fragments :: HashMap Core.Name Core.Fragment
|
||||
, fragmentDefinitions :: HashMap Full.Name Full.FragmentDefinition
|
||||
}
|
||||
|
||||
type TransformT a = StateT Replacement (ReaderT Schema.Subs Maybe) a
|
||||
|
||||
liftJust :: forall a. a -> TransformT a
|
||||
liftJust = lift . lift . Just
|
||||
|
||||
-- | Rewrites the original syntax tree into an intermediate representation used
|
||||
-- for query execution.
|
||||
document :: Schema.Subs -> Full.Document -> Maybe Core.Document
|
||||
|
@ -46,7 +50,6 @@ document subs document' =
|
|||
|
||||
-- * Operation
|
||||
|
||||
-- TODO: Replace Maybe by MonadThrow CustomError
|
||||
operations :: [Full.OperationDefinition] -> TransformT Core.Document
|
||||
operations operations' = do
|
||||
coreOperations <- traverse operation operations'
|
||||
|
@ -61,27 +64,34 @@ operation (Full.OperationDefinition Full.Query name _vars _dirs sels) =
|
|||
operation (Full.OperationDefinition Full.Mutation name _vars _dirs sels) =
|
||||
Core.Mutation name <$> appendSelection sels
|
||||
|
||||
-- * Selection
|
||||
|
||||
selection ::
|
||||
Full.Selection ->
|
||||
TransformT (Either (Seq Core.Selection) Core.Selection)
|
||||
selection (Full.SelectionField fld) = Right . Core.SelectionField <$> field fld
|
||||
selection (Full.SelectionFragmentSpread (Full.FragmentSpread name _)) = do
|
||||
fragments' <- gets fragments
|
||||
Left <$> maybe lookupDefinition liftJust (HashMap.lookup name fragments')
|
||||
selection (Full.SelectionField field') =
|
||||
maybe (Left mempty) (Right . Core.SelectionField) <$> field field'
|
||||
selection (Full.SelectionFragmentSpread fragment) =
|
||||
maybe (Left mempty) (Right . Core.SelectionFragment)
|
||||
<$> fragmentSpread fragment
|
||||
selection (Full.SelectionInlineFragment fragment) =
|
||||
inlineFragment fragment
|
||||
|
||||
appendSelection ::
|
||||
Traversable t =>
|
||||
t Full.Selection ->
|
||||
TransformT (Seq Core.Selection)
|
||||
appendSelection = foldM go mempty
|
||||
where
|
||||
lookupDefinition :: TransformT (Seq Core.Selection)
|
||||
lookupDefinition = do
|
||||
fragmentDefinitions' <- gets fragmentDefinitions
|
||||
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
|
||||
fragmentDefinition found
|
||||
selection (Full.SelectionInlineFragment fragment)
|
||||
| (Full.InlineFragment (Just typeCondition) _ selectionSet) <- fragment
|
||||
= Right
|
||||
. Core.SelectionFragment
|
||||
. Core.Fragment typeCondition
|
||||
<$> appendSelection selectionSet
|
||||
| (Full.InlineFragment Nothing _ selectionSet) <- fragment
|
||||
= Left <$> appendSelection selectionSet
|
||||
go acc sel = append acc <$> selection sel
|
||||
append acc (Left list) = list >< acc
|
||||
append acc (Right one) = one <| acc
|
||||
|
||||
directives :: [Full.Directive] -> TransformT [Core.Directive]
|
||||
directives = traverse directive
|
||||
where
|
||||
directive (Full.Directive directiveName directiveArguments) =
|
||||
Core.Directive directiveName <$> arguments directiveArguments
|
||||
|
||||
-- * Fragment replacement
|
||||
|
||||
|
@ -94,12 +104,40 @@ collectFragments = do
|
|||
_ <- fragmentDefinition nextValue
|
||||
collectFragments
|
||||
|
||||
inlineFragment ::
|
||||
Full.InlineFragment ->
|
||||
TransformT (Either (Seq Core.Selection) Core.Selection)
|
||||
inlineFragment (Full.InlineFragment type' directives' selectionSet) = do
|
||||
fragmentDirectives <- Directive.selection <$> directives directives'
|
||||
case fragmentDirectives of
|
||||
Nothing -> pure $ Left mempty
|
||||
_ -> do
|
||||
fragmentSelectionSet <- appendSelection selectionSet
|
||||
pure $ maybe Left selectionFragment type' fragmentSelectionSet
|
||||
where
|
||||
selectionFragment typeName = Right
|
||||
. Core.SelectionFragment
|
||||
. Core.Fragment typeName
|
||||
|
||||
fragmentSpread :: Full.FragmentSpread -> TransformT (Maybe Core.Fragment)
|
||||
fragmentSpread (Full.FragmentSpread name directives') = do
|
||||
spreadDirectives <- Directive.selection <$> directives directives'
|
||||
fragments' <- gets fragments
|
||||
fragment <- maybe lookupDefinition liftJust (HashMap.lookup name fragments')
|
||||
pure $ fragment <$ spreadDirectives
|
||||
where
|
||||
lookupDefinition = do
|
||||
fragmentDefinitions' <- gets fragmentDefinitions
|
||||
found <- lift . lift $ HashMap.lookup name fragmentDefinitions'
|
||||
fragmentDefinition found
|
||||
|
||||
fragmentDefinition ::
|
||||
Full.FragmentDefinition ->
|
||||
TransformT (Seq Core.Selection)
|
||||
fragmentDefinition (Full.FragmentDefinition name _tc _dirs selections) = do
|
||||
TransformT Core.Fragment
|
||||
fragmentDefinition (Full.FragmentDefinition name type' _ selections) = do
|
||||
modify deleteFragmentDefinition
|
||||
newValue <- appendSelection selections
|
||||
fragmentSelection <- appendSelection selections
|
||||
let newValue = Core.Fragment type' fragmentSelection
|
||||
modify $ insertFragment newValue
|
||||
liftJust newValue
|
||||
where
|
||||
|
@ -109,11 +147,20 @@ fragmentDefinition (Full.FragmentDefinition name _tc _dirs selections) = do
|
|||
let newFragments = HashMap.insert name newValue fragments'
|
||||
in Replacement newFragments fragmentDefinitions'
|
||||
|
||||
field :: Full.Field -> TransformT Core.Field
|
||||
field (Full.Field a n args _dirs sels) = do
|
||||
arguments <- traverse argument args
|
||||
selection' <- appendSelection sels
|
||||
return $ Core.Field a n arguments selection'
|
||||
field :: Full.Field -> TransformT (Maybe Core.Field)
|
||||
field (Full.Field alias name arguments' directives' selections) = do
|
||||
fieldArguments <- traverse argument arguments'
|
||||
fieldSelections <- appendSelection selections
|
||||
fieldDirectives <- Directive.selection <$> directives directives'
|
||||
let field' = Core.Field alias name fieldArguments fieldSelections
|
||||
pure $ field' <$ fieldDirectives
|
||||
|
||||
arguments :: [Full.Argument] -> TransformT Core.Arguments
|
||||
arguments = fmap Core.Arguments . foldM go HashMap.empty
|
||||
where
|
||||
go arguments' argument' = do
|
||||
(Core.Argument name value') <- argument argument'
|
||||
return $ HashMap.insert name value' arguments'
|
||||
|
||||
argument :: Full.Argument -> TransformT Core.Argument
|
||||
argument (Full.Argument n v) = Core.Argument n <$> value v
|
||||
|
@ -134,17 +181,4 @@ value (Full.Object o) =
|
|||
Core.Object . HashMap.fromList <$> traverse objectField o
|
||||
|
||||
objectField :: Full.ObjectField -> TransformT (Core.Name, Core.Value)
|
||||
objectField (Full.ObjectField n v) = (n,) <$> value v
|
||||
|
||||
appendSelection ::
|
||||
Traversable t =>
|
||||
t Full.Selection ->
|
||||
TransformT (Seq Core.Selection)
|
||||
appendSelection = foldM go mempty
|
||||
where
|
||||
go acc sel = append acc <$> selection sel
|
||||
append acc (Left list) = list >< acc
|
||||
append acc (Right one) = one <| acc
|
||||
|
||||
liftJust :: forall a. a -> TransformT a
|
||||
liftJust = lift . lift . Just
|
||||
objectField (Full.ObjectField name value') = (name,) <$> value value'
|
|
@ -131,8 +131,8 @@ resolve resolvers = fmap (Aeson.toJSON . fold) . traverse tryResolvers
|
|||
tryResolvers (SelectionField fld@(Field _ name _ _))
|
||||
= maybe (errmsg fld) (tryResolver fld) $ find (compareResolvers name) resolvers
|
||||
tryResolvers (SelectionFragment (Fragment typeCondition selections')) = do
|
||||
that <- maybe (return "") resolveTypeName (find (compareResolvers "__typename") resolvers)
|
||||
if Aeson.String typeCondition == that
|
||||
that <- traverse resolveTypeName (find (compareResolvers "__typename") resolvers)
|
||||
if maybe True (Aeson.String typeCondition ==) that
|
||||
then fmap fold . traverse tryResolvers $ selections'
|
||||
else return mempty
|
||||
compareResolvers name (Resolver name' _) = name == name'
|
||||
|
|
|
@ -0,0 +1,50 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module Language.GraphQL.Type.Directive
|
||||
( selection
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Language.GraphQL.AST.Core
|
||||
|
||||
-- | Directive processing status.
|
||||
data Status
|
||||
= Skip -- ^ Skip the selection and stop directive processing
|
||||
| Include Directive -- ^ The directive was processed, try other handlers
|
||||
| Continue Directive -- ^ Directive handler mismatch, try other handlers
|
||||
|
||||
-- | Takes a list of directives, handles supported directives and excludes them
|
||||
-- from the result. If the selection should be skipped, returns 'Nothing'.
|
||||
selection :: [Directive] -> Maybe [Directive]
|
||||
selection = foldr go (Just [])
|
||||
where
|
||||
go directive' directives' =
|
||||
case (skip . include) (Continue directive') of
|
||||
(Include _) -> directives'
|
||||
Skip -> Nothing
|
||||
(Continue x) -> (x :) <$> directives'
|
||||
|
||||
handle :: (Directive -> Status) -> Status -> Status
|
||||
handle _ Skip = Skip
|
||||
handle handler (Continue directive) = handler directive
|
||||
handle handler (Include directive) = handler directive
|
||||
|
||||
-- * Directive implementations
|
||||
|
||||
skip :: Status -> Status
|
||||
skip = handle skip'
|
||||
where
|
||||
skip' directive'@(Directive "skip" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Skip
|
||||
_ -> Include directive'
|
||||
skip' directive' = Continue directive'
|
||||
|
||||
include :: Status -> Status
|
||||
include = handle include'
|
||||
where
|
||||
include' directive'@(Directive "include" (Arguments arguments)) =
|
||||
case HashMap.lookup "if" arguments of
|
||||
(Just (Boolean True)) -> Include directive'
|
||||
_ -> Skip
|
||||
include' directive' = Continue directive'
|
|
@ -1,4 +1,4 @@
|
|||
resolver: lts-14.16
|
||||
resolver: lts-14.18
|
||||
|
||||
packages:
|
||||
- .
|
||||
|
|
|
@ -1,19 +1,46 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Language.GraphQL.AST.EncoderSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Language.GraphQL.AST (Value(..))
|
||||
import Language.GraphQL.AST
|
||||
import Language.GraphQL.AST.Encoder
|
||||
import Test.Hspec ( Spec
|
||||
, describe
|
||||
, it
|
||||
, shouldBe
|
||||
)
|
||||
import Test.Hspec (Spec, context, describe, it, shouldBe)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "value" $ do
|
||||
it "escapes \\" $
|
||||
value minified (String "\\") `shouldBe` "\"\\\\\""
|
||||
it "escapes quotes" $
|
||||
value minified (String "\"") `shouldBe` "\"\\\"\""
|
||||
spec = do
|
||||
describe "value" $ do
|
||||
context "minified" $ do
|
||||
it "escapes \\" $
|
||||
value minified (String "\\") `shouldBe` "\"\\\\\""
|
||||
it "escapes quotes" $
|
||||
value minified (String "\"") `shouldBe` "\"\\\"\""
|
||||
it "escapes backspace" $
|
||||
value minified (String "a\bc") `shouldBe` "\"a\\bc\""
|
||||
it "escapes Unicode" $
|
||||
value minified (String "\0") `shouldBe` "\"\\u0000\""
|
||||
|
||||
context "pretty" $ do
|
||||
it "uses strings for short string values" $
|
||||
value pretty (String "Short text") `shouldBe` "\"Short text\""
|
||||
it "uses block strings for text with new lines" $
|
||||
value pretty (String "Line 1\nLine 2")
|
||||
`shouldBe` "\"\"\"\n Line 1\n Line 2\n\"\"\""
|
||||
it "escapes \\ in short strings" $
|
||||
value pretty (String "\\") `shouldBe` "\"\\\\\""
|
||||
|
||||
describe "definition" $
|
||||
it "indents block strings in arguments" $
|
||||
let arguments = [Argument "message" (String "line1\nline2")]
|
||||
field = Field Nothing "field" arguments [] []
|
||||
set = OperationSelectionSet $ pure $ SelectionField field
|
||||
operation = DefinitionOperation set
|
||||
in definition pretty operation `shouldBe` [r|{
|
||||
field(message: """
|
||||
line1
|
||||
line2
|
||||
""")
|
||||
}
|
||||
|]
|
||||
|
|
|
@ -30,3 +30,15 @@ spec = describe "Parser" $ do
|
|||
mutation auth($username: String!, $password: String!){
|
||||
test
|
||||
}|]
|
||||
|
||||
it "accepts two string arguments" $
|
||||
parse document "" `shouldSucceedOn` [r|
|
||||
mutation auth{
|
||||
test(username: "username", password: "password")
|
||||
}|]
|
||||
|
||||
it "accepts two block string arguments" $
|
||||
parse document "" `shouldSucceedOn` [r|
|
||||
mutation auth{
|
||||
test(username: """username""", password: """password""")
|
||||
}|]
|
||||
|
|
|
@ -0,0 +1,84 @@
|
|||
{-# LANGUAGE OverloadedStrings #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
module Test.DirectiveSpec
|
||||
( spec
|
||||
) where
|
||||
|
||||
import Data.Aeson (Value, object, (.=))
|
||||
import Data.List.NonEmpty (NonEmpty(..))
|
||||
import Language.GraphQL
|
||||
import qualified Language.GraphQL.Schema as Schema
|
||||
import Test.Hspec (Spec, describe, it, shouldBe)
|
||||
import Text.RawString.QQ (r)
|
||||
|
||||
experimentalResolver :: Schema.Resolver IO
|
||||
experimentalResolver = Schema.scalar "experimentalField" $ pure (5 :: Int)
|
||||
|
||||
emptyObject :: Value
|
||||
emptyObject = object
|
||||
[ "data" .= object []
|
||||
]
|
||||
|
||||
spec :: Spec
|
||||
spec =
|
||||
describe "Directive executor" $ do
|
||||
it "should be able to @skip fields" $ do
|
||||
let query = [r|
|
||||
{
|
||||
experimentalField @skip(if: true)
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (experimentalResolver :| []) query
|
||||
actual `shouldBe` emptyObject
|
||||
|
||||
it "should not skip fields if @skip is false" $ do
|
||||
let query = [r|
|
||||
{
|
||||
experimentalField @skip(if: false)
|
||||
}
|
||||
|]
|
||||
expected = object
|
||||
[ "data" .= object
|
||||
[ "experimentalField" .= (5 :: Int)
|
||||
]
|
||||
]
|
||||
|
||||
actual <- graphql (experimentalResolver :| []) query
|
||||
actual `shouldBe` expected
|
||||
|
||||
it "should skip fields if @include is false" $ do
|
||||
let query = [r|
|
||||
{
|
||||
experimentalField @include(if: false)
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (experimentalResolver :| []) query
|
||||
actual `shouldBe` emptyObject
|
||||
|
||||
it "should be able to @skip a fragment spread" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...experimentalFragment @skip(if: true)
|
||||
}
|
||||
|
||||
fragment experimentalFragment on ExperimentalType {
|
||||
experimentalField
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (experimentalResolver :| []) query
|
||||
actual `shouldBe` emptyObject
|
||||
|
||||
it "should be able to @skip an inline fragment" $ do
|
||||
let query = [r|
|
||||
{
|
||||
... on ExperimentalType @skip(if: true) {
|
||||
experimentalField
|
||||
}
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (experimentalResolver :| []) query
|
||||
actual `shouldBe` emptyObject
|
|
@ -48,117 +48,144 @@ hasErrors (Object object') = HashMap.member "errors" object'
|
|||
hasErrors _ = True
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "Inline fragment executor" $ do
|
||||
it "chooses the first selection if the type matches" $ do
|
||||
actual <- graphql (garment "Hat" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
spec = do
|
||||
describe "Inline fragment executor" $ do
|
||||
it "chooses the first selection if the type matches" $ do
|
||||
actual <- graphql (garment "Hat" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "chooses the last selection if the type matches" $ do
|
||||
actual <- graphql (garment "Shirt" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "size" .= ("L" :: Text)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "embeds inline fragments without type" $ do
|
||||
let query = [r|{
|
||||
garment {
|
||||
circumference
|
||||
... {
|
||||
size
|
||||
}
|
||||
}
|
||||
}|]
|
||||
resolvers = Schema.object "garment" $ return [circumference, size]
|
||||
|
||||
actual <- graphql (resolvers :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
, "size" .= ("L" :: Text)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments on Query" $ do
|
||||
let query = [r|{
|
||||
... {
|
||||
size
|
||||
}
|
||||
}|]
|
||||
|
||||
actual <- graphql (size :| []) query
|
||||
actual `shouldNotSatisfy` hasErrors
|
||||
|
||||
describe "Fragment spread executor" $ do
|
||||
it "evaluates fragment spreads" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "chooses the last selection if the type matches" $ do
|
||||
actual <- graphql (garment "Shirt" :| []) inlineQuery
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "size" .= ("L" :: Text)
|
||||
it "evaluates nested fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
garment {
|
||||
...circumferenceFragment
|
||||
}
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...hatFragment
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (garment "Hat" :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "embeds inline fragments without type" $ do
|
||||
let query = [r|{
|
||||
garment {
|
||||
circumference
|
||||
... {
|
||||
size
|
||||
}
|
||||
}
|
||||
}|]
|
||||
resolvers = Schema.object "garment" $ return [circumference, size]
|
||||
it "rejects recursive fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
actual <- graphql (resolvers :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
, "size" .= ("L" :: Text)
|
||||
fragment circumferenceFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
actual `shouldSatisfy` hasErrors
|
||||
|
||||
it "considers type condition" $ do
|
||||
let query = [r|
|
||||
{
|
||||
garment {
|
||||
...circumferenceFragment
|
||||
...sizeFragment
|
||||
}
|
||||
}
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
fragment sizeFragment on Shirt {
|
||||
size
|
||||
}
|
||||
|]
|
||||
expected = object
|
||||
[ "data" .= object
|
||||
[ "garment" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments on Query" $ do
|
||||
let query = [r|{
|
||||
... {
|
||||
size
|
||||
}
|
||||
}|]
|
||||
|
||||
actual <- graphql (size :| []) query
|
||||
actual `shouldNotSatisfy` hasErrors
|
||||
|
||||
it "evaluates nested fragments" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "evaluates fragments defined in any order" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...hatFragment
|
||||
}
|
||||
|
||||
fragment hatFragment on Hat {
|
||||
circumference
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
let expected = object
|
||||
[ "data" .= object
|
||||
[ "circumference" .= (60 :: Int)
|
||||
]
|
||||
]
|
||||
in actual `shouldBe` expected
|
||||
|
||||
it "rejects recursive" $ do
|
||||
let query = [r|
|
||||
{
|
||||
...circumferenceFragment
|
||||
}
|
||||
|
||||
fragment circumferenceFragment on Hat {
|
||||
...circumferenceFragment
|
||||
}
|
||||
|]
|
||||
|
||||
actual <- graphql (circumference :| []) query
|
||||
actual `shouldSatisfy` hasErrors
|
||||
actual <- graphql (garment "Hat" :| []) query
|
||||
actual `shouldBe` expected
|
||||
|
|
Loading…
Reference in New Issue