summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--graphql.cabal4
-rw-r--r--src/Language/GraphQL/AST.hs1
-rw-r--r--src/Language/GraphQL/AST/DirectiveLocation.hs1
-rw-r--r--src/Language/GraphQL/AST/Document.hs1
-rw-r--r--src/Language/GraphQL/AST/Encoder.hs1
-rw-r--r--src/Language/GraphQL/AST/Lexer.hs2
-rw-r--r--src/Language/GraphQL/AST/Parser.hs2
-rw-r--r--src/Language/GraphQL/Execute.hs21
-rw-r--r--src/Language/GraphQL/Type/Definition.hs1
-rw-r--r--src/Language/GraphQL/Type/In.hs1
-rw-r--r--src/Language/GraphQL/Validate/Rules.hs10
11 files changed, 22 insertions, 23 deletions
diff --git a/graphql.cabal b/graphql.cabal
index 7088230..c31c058 100644
--- a/graphql.cabal
+++ b/graphql.cabal
@@ -11,7 +11,7 @@ author: Danny Navarro <j@dannynavarro.net>,
Matthías Páll Gissurarson <mpg@mpg.is>,
Sólrún Halla Einarsdóttir <she@mpg.is>
maintainer: belka@caraus.de
-copyright: (c) 2019-2024 Eugen Wissner,
+copyright: (c) 2019-2025 Eugen Wissner,
(c) 2015-2017 J. Daniel Navarro
license: MPL-2.0 AND BSD-3-Clause
license-files: LICENSE,
@@ -21,7 +21,7 @@ extra-source-files:
CHANGELOG.md
README.md
tested-with:
- GHC == 9.8.2
+ GHC == 9.10.1
source-repository head
type: git
diff --git a/src/Language/GraphQL/AST.hs b/src/Language/GraphQL/AST.hs
index 4cf9bfd..93fe686 100644
--- a/src/Language/GraphQL/AST.hs
+++ b/src/Language/GraphQL/AST.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
-- | Target AST for parser.
diff --git a/src/Language/GraphQL/AST/DirectiveLocation.hs b/src/Language/GraphQL/AST/DirectiveLocation.hs
index 600f931..10da19b 100644
--- a/src/Language/GraphQL/AST/DirectiveLocation.hs
+++ b/src/Language/GraphQL/AST/DirectiveLocation.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
-- | Various parts of a GraphQL document can be annotated with directives.
diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs
index 11317d8..4fcdd41 100644
--- a/src/Language/GraphQL/AST/Document.hs
+++ b/src/Language/GraphQL/AST/Document.hs
@@ -3,6 +3,7 @@
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
-- | This module defines an abstract syntax tree for the @GraphQL@ language. It
diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs
index 603023b..c26b2e7 100644
--- a/src/Language/GraphQL/AST/Encoder.hs
+++ b/src/Language/GraphQL/AST/Encoder.hs
@@ -2,6 +2,7 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
-- | This module defines a minifier and a printer for the @GraphQL@ language.
diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs
index 62cf4d2..123383b 100644
--- a/src/Language/GraphQL/AST/Lexer.hs
+++ b/src/Language/GraphQL/AST/Lexer.hs
@@ -1,5 +1,7 @@
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Safe #-}
-- | This module defines a bunch of small parsers used to parse individual
-- lexemes.
diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs
index d3a6b34..8b03bb2 100644
--- a/src/Language/GraphQL/AST/Parser.hs
+++ b/src/Language/GraphQL/AST/Parser.hs
@@ -2,6 +2,8 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
+{-# LANGUAGE Safe #-}
-- | @GraphQL@ document parser.
module Language.GraphQL.AST.Parser
diff --git a/src/Language/GraphQL/Execute.hs b/src/Language/GraphQL/Execute.hs
index 265e94f..f959f64 100644
--- a/src/Language/GraphQL/Execute.hs
+++ b/src/Language/GraphQL/Execute.hs
@@ -189,6 +189,8 @@ data QueryError
| CoercionError Full.VariableDefinition
| UnknownInputType Full.VariableDefinition
+type ExecuteHandler m a e = e -> ExecutorT m a
+
tell :: Monad m => Seq Error -> ExecutorT m ()
tell = ExecutorT . lift . Writer.tell
@@ -313,8 +315,7 @@ executeQuery topSelections schema = do
pure $ Response data' errors
handleException :: (MonadCatch m, Serialize a)
- => FieldException
- -> ExecutorT m a
+ => ExecuteHandler m a FieldException
handleException (FieldException fieldLocation errorPath next) =
let newError = constructError next fieldLocation errorPath
in tell (Seq.singleton newError) >> pure null
@@ -390,30 +391,28 @@ executeField objectValue fields (viewResolver -> resolverPair) errorPath =
fieldErrorPath = fieldsSegment fields : errorPath
inputCoercionHandler :: (MonadCatch m, Serialize a)
=> Full.Location
- -> InputCoercionException
- -> ExecutorT m a
+ -> ExecuteHandler m a InputCoercionException
inputCoercionHandler _ e@(InputCoercionException _ _ (Just valueNode)) =
let argumentLocation = getField @"location" valueNode
in exceptionHandler argumentLocation e
inputCoercionHandler fieldLocation e = exceptionHandler fieldLocation e
resultHandler :: (MonadCatch m, Serialize a)
=> Full.Location
- -> ResultException
- -> ExecutorT m a
+ -> ExecuteHandler m a ResultException
resultHandler = exceptionHandler
resolverHandler :: (MonadCatch m, Serialize a)
=> Full.Location
- -> ResolverException
- -> ExecutorT m a
+ -> ExecuteHandler m a ResolverException
resolverHandler = exceptionHandler
- nullResultHandler :: (MonadCatch m, Serialize a)
- => FieldException
- -> ExecutorT m a
+ nullResultHandler :: (MonadCatch m, Serialize a) => ExecuteHandler m a FieldException
nullResultHandler e@(FieldException fieldLocation errorPath' next) =
let newError = constructError next fieldLocation errorPath'
in if Out.isNonNullType fieldType
then throwM e
else returnError newError
+ exceptionHandler :: (Exception e, MonadCatch m, Serialize a)
+ => Full.Location
+ -> ExecuteHandler m a e
exceptionHandler errorLocation e =
let newError = constructError e errorLocation fieldErrorPath
in if Out.isNonNullType fieldType
diff --git a/src/Language/GraphQL/Type/Definition.hs b/src/Language/GraphQL/Type/Definition.hs
index ad4b538..e3616d1 100644
--- a/src/Language/GraphQL/Type/Definition.hs
+++ b/src/Language/GraphQL/Type/Definition.hs
@@ -3,6 +3,7 @@
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
-- | Types that can be used as both input and output types.
diff --git a/src/Language/GraphQL/Type/In.hs b/src/Language/GraphQL/Type/In.hs
index bd78c8c..1fdedf4 100644
--- a/src/Language/GraphQL/Type/In.hs
+++ b/src/Language/GraphQL/Type/In.hs
@@ -3,6 +3,7 @@
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE PatternSynonyms #-}
+{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ViewPatterns #-}
diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs
index 1c202fe..9d3561f 100644
--- a/src/Language/GraphQL/Validate/Rules.hs
+++ b/src/Language/GraphQL/Validate/Rules.hs
@@ -1067,18 +1067,12 @@ overlappingFieldsCanBeMergedRule = OperationDefinitionRule $ \case
go selectionSet selectionType = do
fieldTuples <- evalStateT (collectFields selectionType selectionSet) HashSet.empty
fieldsInSetCanMerge fieldTuples
- fieldsInSetCanMerge :: forall m
- . HashMap Full.Name (NonEmpty (Full.Field, Type.CompositeType m))
- -> ReaderT (Validation m) Seq Error
fieldsInSetCanMerge fieldTuples = do
validation <- ask
let (lonely, paired) = flattenPairs fieldTuples
let reader = flip runReaderT validation
lift $ foldMap (reader . visitLonelyFields) lonely
<> foldMap (reader . forEachFieldTuple) paired
- forEachFieldTuple :: forall m
- . (FieldInfo m, FieldInfo m)
- -> ReaderT (Validation m) Seq Error
forEachFieldTuple (fieldA, fieldB) =
case (parent fieldA, parent fieldB) of
(parentA@Type.CompositeObjectType{}, parentB@Type.CompositeObjectType{})
@@ -1105,10 +1099,6 @@ overlappingFieldsCanBeMergedRule = OperationDefinitionRule $ \case
let Full.Field _ _ _ _ subSelections _ = node
compositeFieldType = Type.outToComposite type'
in maybe (lift Seq.empty) (go subSelections) compositeFieldType
- sameResponseShape :: forall m
- . FieldInfo m
- -> FieldInfo m
- -> ReaderT (Validation m) Seq Error
sameResponseShape fieldA fieldB =
let Full.Field _ _ _ _ selectionsA _ = node fieldA
Full.Field _ _ _ _ selectionsB _ = node fieldB