aboutsummaryrefslogtreecommitdiff
path: root/src/Language/GraphQL
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/GraphQL')
-rw-r--r--src/Language/GraphQL/AST/Document.hs9
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs3
-rw-r--r--src/Language/GraphQL/AST/Parser.hs1
-rw-r--r--src/Language/GraphQL/TH.hs48
-rw-r--r--src/Language/GraphQL/Validate.hs2
-rw-r--r--src/Language/GraphQL/Validate/Rules.hs45
6 files changed, 31 insertions, 77 deletions
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 101cf78..11317d8 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -482,12 +482,9 @@ instance Monoid Description
data TypeDefinition
= ScalarTypeDefinition Description Name [Directive]
| ObjectTypeDefinition
- Description
- Name
- (ImplementsInterfaces [])
- [Directive]
- [FieldDefinition]
- | InterfaceTypeDefinition Description Name [Directive] [FieldDefinition]
+ Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
+ | InterfaceTypeDefinition
+ Description Name (ImplementsInterfaces []) [Directive] [FieldDefinition]
| UnionTypeDefinition Description Name [Directive] (UnionMemberTypes [])
| EnumTypeDefinition Description Name [Directive] [EnumValueDefinition]
| InputObjectTypeDefinition
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index a1076e4..603023b 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -226,10 +226,11 @@ typeDefinition formatter = \case
<> optempty (directives formatter) directives'
<> eitherFormat formatter " " ""
<> bracesList formatter (fieldDefinition nextFormatter) fields'
- Full.InterfaceTypeDefinition description' name' directives' fields'
+ Full.InterfaceTypeDefinition description' name' ifaces' directives' fields'
-> optempty (description formatter) description'
<> "interface "
<> Lazy.Text.fromStrict name'
+ <> optempty (" " <>) (implementsInterfaces ifaces')
<> optempty (directives formatter) directives'
<> eitherFormat formatter " " ""
<> bracesList formatter (fieldDefinition nextFormatter) fields'
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index f325ee7..d3a6b34 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -214,6 +214,7 @@ interfaceTypeDefinition :: Full.Description -> Parser Full.TypeDefinition
interfaceTypeDefinition description' = Full.InterfaceTypeDefinition description'
<$ symbol "interface"
<*> name
+ <*> option (Full.ImplementsInterfaces []) (implementsInterfaces sepBy1)
<*> directives
<*> braces (many fieldDefinition)
<?> "InterfaceTypeDefinition"
diff --git a/src/Language/GraphQL/TH.hs b/src/Language/GraphQL/TH.hs
deleted file mode 100644
index 22ffdd0..0000000
--- a/src/Language/GraphQL/TH.hs
+++ /dev/null
@@ -1,48 +0,0 @@
-{- This Source Code Form is subject to the terms of the Mozilla Public License,
- v. 2.0. If a copy of the MPL was not distributed with this file, You can
- obtain one at https://mozilla.org/MPL/2.0/. -}
-
--- | Template Haskell helpers.
-module Language.GraphQL.TH
- ( gql
- ) where
-
-import Language.Haskell.TH.Quote (QuasiQuoter(..))
-import Language.Haskell.TH (Exp(..), Lit(..))
-
-stripIndentation :: String -> String
-stripIndentation code = reverse
- $ dropWhile isLineBreak
- $ reverse
- $ unlines
- $ indent spaces <$> lines' withoutLeadingNewlines
- where
- indent 0 xs = xs
- indent count (' ' : xs) = indent (count - 1) xs
- indent _ xs = xs
- withoutLeadingNewlines = dropWhile isLineBreak code
- spaces = length $ takeWhile (== ' ') withoutLeadingNewlines
- lines' "" = []
- lines' string =
- let (line, rest) = break isLineBreak string
- reminder =
- case rest of
- [] -> []
- '\r' : '\n' : strippedString -> lines' strippedString
- _ : strippedString -> lines' strippedString
- in line : reminder
- isLineBreak = flip any ['\n', '\r'] . (==)
-
--- | Removes leading and trailing newlines. Indentation of the first line is
--- removed from each line of the string.
-{-# DEPRECATED gql "Use Language.GraphQL.Class.gql from graphql-spice instead" #-}
-gql :: QuasiQuoter
-gql = QuasiQuoter
- { quoteExp = pure . LitE . StringL . stripIndentation
- , quotePat = const
- $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a pattern)"
- , quoteType = const
- $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a type)"
- , quoteDec = const
- $ fail "Illegal gql QuasiQuote (allowed as expression only, used as a declaration)"
- }
diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs
index 5feb85a..1d24523 100644
--- a/src/Language/GraphQL/Validate.hs
+++ b/src/Language/GraphQL/Validate.hs
@@ -210,7 +210,7 @@ typeDefinition context rule = \case
Full.ObjectTypeDefinition _ _ _ directives' fields
-> directives context rule objectLocation directives'
>< foldMap (fieldDefinition context rule) fields
- Full.InterfaceTypeDefinition _ _ directives' fields
+ Full.InterfaceTypeDefinition _ _ _ directives' fields
-> directives context rule interfaceLocation directives'
>< foldMap (fieldDefinition context rule) fields
Full.UnionTypeDefinition _ _ directives' _ ->
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index 3fef94d..1c202fe 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -137,25 +137,28 @@ singleFieldSubscriptionsRule :: forall m. Rule m
singleFieldSubscriptionsRule = OperationDefinitionRule $ \case
Full.OperationDefinition Full.Subscription name' _ _ rootFields location' -> do
groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty
- case HashSet.size groupedFieldSet of
- 1 -> lift mempty
- _
- | Just name <- name' -> pure $ Error
- { message = concat
- [ "Subscription \""
- , Text.unpack name
- , "\" must select only one top level field."
- ]
- , locations = [location']
- }
- | otherwise -> pure $ Error
- { message = errorMessage
- , locations = [location']
- }
+ case HashSet.toList groupedFieldSet of
+ [rootName]
+ | Text.isPrefixOf "__" rootName -> makeError location' name'
+ "exactly one top level field, which must not be an introspection field."
+ | otherwise -> lift mempty
+ [] -> makeError location' name' "exactly one top level field."
+ _ -> makeError location' name' "only one top level field."
_ -> lift mempty
where
- errorMessage =
- "Anonymous Subscription must select only one top level field."
+ makeError location' (Just operationName) errorLine = pure $ Error
+ { message = concat
+ [ "Subscription \""
+ , Text.unpack operationName
+ , "\" must select "
+ , errorLine
+ ]
+ , locations = [location']
+ }
+ makeError location' Nothing errorLine = pure $ Error
+ { message = "Anonymous Subscription must select " <> errorLine
+ , locations = [location']
+ }
collectFields = foldM forEach HashSet.empty
forEach accumulator = \case
Full.FieldSelection fieldSelection -> forField accumulator fieldSelection
@@ -856,8 +859,8 @@ knownArgumentNamesRule = ArgumentsRule fieldRule directiveRule
, "\"."
]
--- | GraphQL servers define what directives they support. For each usage of a
--- directive, the directive must be available on that server.
+-- | GraphQL services define what directives they support. For each usage of a
+-- directive, the directive must be available on that service.
knownDirectiveNamesRule :: Rule m
knownDirectiveNamesRule = DirectivesRule $ const $ \directives' -> do
definitions' <- asks $ Schema.directives . schema
@@ -909,9 +912,9 @@ knownInputFieldNamesRule = ValueRule go constGo
, "\"."
]
--- | GraphQL servers define what directives they support and where they support
+-- | GraphQL services define what directives they support and where they support
-- them. For each usage of a directive, the directive must be used in a location
--- that the server has declared support for.
+-- that the service has declared support for.
directivesInValidLocationsRule :: Rule m
directivesInValidLocationsRule = DirectivesRule directivesRule
where
generated by cgit v1.2.3 (git 2.26.2) at 2026-10-02 10:23:39 +0000