From 4c10ce92041dc73a95aeb64aca241dd937ffaa5c Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Mon, 14 Sep 2020 07:49:33 +0200 Subject: [PATCH] Use Seq as base monad in the validator It is more natural to implement the logic: try to apply each rule to each node. --- CHANGELOG.md | 9 +- src/Language/GraphQL/AST/Document.hs | 10 +- src/Language/GraphQL/AST/Encoder.hs | 2 +- src/Language/GraphQL/AST/Lexer.hs | 4 +- src/Language/GraphQL/AST/Parser.hs | 7 +- src/Language/GraphQL/Execute/Transform.hs | 4 +- src/Language/GraphQL/Validate.hs | 153 ++++++++------------ src/Language/GraphQL/Validate/Rules.hs | 55 +++---- src/Language/GraphQL/Validate/Validation.hs | 6 +- tests/Language/GraphQL/AST/EncoderSpec.hs | 8 +- tests/Language/GraphQL/AST/LexerSpec.hs | 2 +- 11 files changed, 123 insertions(+), 137 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 378814d..85ffcf1 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -10,9 +10,16 @@ and this project adheres to ### Changed - `AST.Document.Selection` wraps additional new types: `Field`, `FragmentSpread` and `InlineFragment`. Thus validation rules can be defined more concise. +- `AST.Document.Argument` contains the argument location. +- `AST.Lexer.colon` ignores the result (it is always a colon). +- `Validate.Validation`: `Validation.rules` was removed. `Validation.rules` + contained the list of rules, but the executed rules shouldn't know about other + rules. `rules` was a part of the `Validation` context to pass it easier + around, but since the rules are traversed once now and applied to all nodes in + the tree at the beginning, it isn't required anymore. ### Added -- `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule` and +- `Validate.Validation.Rule`: `SelectionRule`, `FieldRule`, `FragmentRule`, `FragmentSpreadRule` constructors. - `Validate.Rules`: - `fragmentsOnCompositeTypesRule` diff --git a/src/Language/GraphQL/AST/Document.hs b/src/Language/GraphQL/AST/Document.hs index cc657f4..7d0bcd0 100644 --- a/src/Language/GraphQL/AST/Document.hs +++ b/src/Language/GraphQL/AST/Document.hs @@ -49,7 +49,7 @@ import Data.Int (Int32) import Data.List.NonEmpty (NonEmpty) import Data.Text (Text) import qualified Data.Text as Text -import Language.GraphQL.AST.DirectiveLocation +import Language.GraphQL.AST.DirectiveLocation (DirectiveLocation) -- * Language @@ -126,7 +126,7 @@ data Selection | InlineFragmentSelection InlineFragment deriving (Eq, Show) --- The only required property of a field is its name. Optionally it can also +-- | The only required property of a field is its name. Optionally it can also -- have an alias, arguments, directives and a list of subfields. -- -- In the following query "user" is a field with two subfields, "id" and "name": @@ -143,7 +143,7 @@ data Field = Field (Maybe Name) Name [Argument] [Directive] SelectionSetOpt Location deriving (Eq, Show) --- Inline fragments don't have any name and the type condition ("on UserType") +-- | Inline fragments don't have any name and the type condition ("on UserType") -- is optional. -- -- @ @@ -159,7 +159,7 @@ data InlineFragment = InlineFragment (Maybe TypeCondition) [Directive] SelectionSet Location deriving (Eq, Show) --- A fragment spread refers to a fragment defined outside the operation and is +-- | A fragment spread refers to a fragment defined outside the operation and is -- expanded at the execution time. -- -- @ @@ -190,7 +190,7 @@ data FragmentSpread = FragmentSpread Name [Directive] Location -- @ -- -- Here "id" is an argument for the field "user" and its value is 4. -data Argument = Argument Name Value deriving (Eq,Show) +data Argument = Argument Name Value Location deriving (Eq,Show) -- ** Fragments diff --git a/src/Language/GraphQL/AST/Encoder.hs b/src/Language/GraphQL/AST/Encoder.hs index dcc24fe..342a45f 100644 --- a/src/Language/GraphQL/AST/Encoder.hs +++ b/src/Language/GraphQL/AST/Encoder.hs @@ -159,7 +159,7 @@ arguments :: Formatter -> [Argument] -> Lazy.Text arguments formatter = parensCommas formatter $ argument formatter argument :: Formatter -> Argument -> Lazy.Text -argument formatter (Argument name value') +argument formatter (Argument name value' _) = Lazy.Text.fromStrict name <> colon formatter <> value formatter value' diff --git a/src/Language/GraphQL/AST/Lexer.hs b/src/Language/GraphQL/AST/Lexer.hs index 17d3f9c..cd2bd89 100644 --- a/src/Language/GraphQL/AST/Lexer.hs +++ b/src/Language/GraphQL/AST/Lexer.hs @@ -100,8 +100,8 @@ amp :: Parser T.Text amp = symbol "&" -- | Parser for ":". -colon :: Parser T.Text -colon = symbol ":" +colon :: Parser () +colon = symbol ":" >> pure () -- | Parser for "=". equals :: Parser T.Text diff --git a/src/Language/GraphQL/AST/Parser.hs b/src/Language/GraphQL/AST/Parser.hs index 136067b..f6d1539 100644 --- a/src/Language/GraphQL/AST/Parser.hs +++ b/src/Language/GraphQL/AST/Parser.hs @@ -398,7 +398,12 @@ arguments :: Parser [Argument] arguments = listOptIn parens argument "Arguments" argument :: Parser Argument -argument = Argument <$> name <* colon <*> value "Argument" +argument = label "Argument" $ do + location <- getLocation + name' <- name + colon + value' <- value + pure $ Argument name' value' location fragmentSpread :: Parser FragmentSpread fragmentSpread = label "FragmentSpread" $ do diff --git a/src/Language/GraphQL/Execute/Transform.hs b/src/Language/GraphQL/Execute/Transform.hs index 6c7c141..64259ec 100644 --- a/src/Language/GraphQL/Execute/Transform.hs +++ b/src/Language/GraphQL/Execute/Transform.hs @@ -304,7 +304,7 @@ field (Full.Field alias name arguments' directives' selections _) = do let field' = Field alias name fieldArguments fieldSelections pure $ field' <$ fieldDirectives where - go arguments (Full.Argument name' value') = + go arguments (Full.Argument name' value' _) = inputField arguments name' value' fragmentSpread @@ -363,7 +363,7 @@ directives = traverse directive directive (Full.Directive directiveName directiveArguments) = Definition.Directive directiveName . Type.Arguments <$> foldM go HashMap.empty directiveArguments - go arguments (Full.Argument name value') = do + go arguments (Full.Argument name value' _) = do substitutedValue <- value value' return $ HashMap.insert name substitutedValue arguments diff --git a/src/Language/GraphQL/Validate.hs b/src/Language/GraphQL/Validate.hs index 7aafa64..42b802c 100644 --- a/src/Language/GraphQL/Validate.hs +++ b/src/Language/GraphQL/Validate.hs @@ -12,9 +12,9 @@ module Language.GraphQL.Validate , module Language.GraphQL.Validate.Rules ) where -import Control.Monad (foldM) -import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader) -import Data.Foldable (fold, foldrM) +import Control.Monad (join) +import Control.Monad.Trans.Class (MonadTrans(..)) +import Control.Monad.Trans.Reader (runReaderT) import Data.Sequence (Seq(..), (><), (|>)) import qualified Data.Sequence as Seq import Language.GraphQL.AST.Document @@ -23,110 +23,79 @@ import Language.GraphQL.Type.Schema (Schema(..)) import Language.GraphQL.Validate.Rules import Language.GraphQL.Validate.Validation -type ValidateT m = Reader (Validation m) (Seq Error) - -- | Validates a document and returns a list of found errors. If the returned -- list is empty, the document is valid. document :: forall m. Schema m -> [Rule m] -> Document -> Seq Error document schema' rules' document' = - runReader (foldrM go Seq.empty document') context + runReaderT reader context where context = Validation { ast = document' , schema = schema' , types = collectReferencedTypes schema' - , rules = rules' } - go definition' accumulator = (accumulator ><) <$> definition definition' + reader = do + rule' <- lift $ Seq.fromList rules' + join $ lift $ foldr (definition rule') Seq.empty document' -definition :: forall m. Definition -> ValidateT m -definition definition' - | ExecutableDefinition executableDefinition' <- definition' - = visitChildSelections ruleFilter - $ executableDefinition executableDefinition' - | otherwise = asks rules >>= foldM ruleFilter Seq.empty +definition :: Rule m -> Definition -> Seq (RuleT m) -> Seq (RuleT m) +definition (DefinitionRule rule) definition' acc = + acc |> rule definition' +definition rule (ExecutableDefinition executableDefinition') acc = + acc >< executableDefinition rule executableDefinition' +definition _ _ acc = acc + +executableDefinition :: Rule m -> ExecutableDefinition -> Seq (RuleT m) +executableDefinition rule (DefinitionOperation operation) = + operationDefinition rule operation +executableDefinition rule (DefinitionFragment fragment) = + fragmentDefinition rule fragment + +operationDefinition :: Rule m -> OperationDefinition -> Seq (RuleT m) +operationDefinition (OperationDefinitionRule rule) operationDefinition' = + pure $ rule operationDefinition' +operationDefinition rule (SelectionSet selections _) = + selectionSet rule selections +operationDefinition rule (OperationDefinition _ _ _ _ selections _) = + selectionSet rule selections + +fragmentDefinition :: Rule m -> FragmentDefinition -> Seq (RuleT m) +fragmentDefinition (FragmentDefinitionRule rule) fragmentDefinition' = + pure $ rule fragmentDefinition' +fragmentDefinition rule fragmentDefinition'@(FragmentDefinition _ _ _ selections _) + | FragmentRule definitionRule _ <- rule = + applyToChildren |> definitionRule fragmentDefinition' + | otherwise = applyToChildren where - ruleFilter accumulator (DefinitionRule rule) = - mapReaderT (runRule accumulator) $ rule definition' - ruleFilter accumulator _ = pure accumulator + applyToChildren = selectionSet rule selections -runRule :: Applicative f => Seq Error -> Maybe Error -> f (Seq Error) -runRule accumulator (Just error') = pure $ accumulator |> error' -runRule accumulator Nothing = pure accumulator +selectionSet :: Traversable t => Rule m -> t Selection -> Seq (RuleT m) +selectionSet = foldMap . selection -executableDefinition :: forall m. ExecutableDefinition -> ValidateT m -executableDefinition (DefinitionOperation definition') = - operationDefinition definition' -executableDefinition (DefinitionFragment definition') = - fragmentDefinition definition' - -operationDefinition :: forall m. OperationDefinition -> ValidateT m -operationDefinition operation = - let selectionSet = getSelectionSet operation - in visitChildSelections ruleFilter $ traverseSelectionSet selectionSet +selection :: Rule m -> Selection -> Seq (RuleT m) +selection rule selection' + | SelectionRule selectionRule <- rule = + applyToChildren |> selectionRule selection' + | otherwise = applyToChildren where - ruleFilter accumulator (OperationDefinitionRule rule) = - mapReaderT (runRule accumulator) $ rule operation - ruleFilter accumulator _ = pure accumulator - getSelectionSet (SelectionSet selectionSet _) = selectionSet - getSelectionSet (OperationDefinition _ _ _ _ selectionSet _) = selectionSet + applyToChildren = + case selection' of + FieldSelection field' -> field rule field' + InlineFragmentSelection inlineFragment' -> + inlineFragment rule inlineFragment' + FragmentSpreadSelection fragmentSpread' -> + pure $ fragmentSpread rule fragmentSpread' -visitChildSelections :: forall m - . (Seq Error -> Rule m -> ValidateT m) - -> ValidateT m - -> ValidateT m -visitChildSelections ruleFilter children' = do - rules' <- asks rules - applied <- foldM ruleFilter Seq.empty rules' - children <- children' - pure $ children >< applied +field :: Rule m -> Field -> Seq (RuleT m) +field (FieldRule rule) field' = pure $ rule field' +field rule (Field _ _ _ _ selections _) = selectionSet rule selections -selection :: forall m. Selection -> ValidateT m -selection selection' - | FragmentSpreadSelection fragmentSelection <- selection' = - visitChildSelections ruleFilter $ fragmentSpread fragmentSelection - | FieldSelection fieldSelection <- selection' = - visitChildSelections ruleFilter $ field fieldSelection - | InlineFragmentSelection fragmentSelection <- selection' = - visitChildSelections ruleFilter $ inlineFragment fragmentSelection - where - ruleFilter accumulator (SelectionRule rule) = - mapReaderT (runRule accumulator) $ rule selection' - ruleFilter accumulator _ = pure accumulator +inlineFragment :: Rule m -> InlineFragment -> Seq (RuleT m) +inlineFragment (FragmentRule _ rule) inlineFragment' = + pure $ rule inlineFragment' +inlineFragment rule (InlineFragment _ _ selections _) = + selectionSet rule selections -field :: forall m. Field -> ValidateT m -field field'@(Field _ _ _ _ selections _) = - visitChildSelections ruleFilter $ traverseSelectionSet selections - where - ruleFilter accumulator (FieldRule rule) = - mapReaderT (runRule accumulator) $ rule field' - ruleFilter accumulator _ = pure accumulator - -inlineFragment :: forall m. InlineFragment -> ValidateT m -inlineFragment fragment@(InlineFragment _ _ selections _) = - visitChildSelections ruleFilter $ traverseSelectionSet selections - where - ruleFilter accumulator (FragmentRule _ inlineRule) = - mapReaderT (runRule accumulator) $ inlineRule fragment - ruleFilter accumulator _ = pure accumulator - -fragmentSpread :: forall m. FragmentSpread -> ValidateT m -fragmentSpread fragment = - asks rules >>= foldM ruleFilter Seq.empty - where - ruleFilter accumulator (FragmentSpreadRule rule) = - mapReaderT (runRule accumulator) $ rule fragment - ruleFilter accumulator _ = pure accumulator - -traverseSelectionSet :: Traversable t => forall m. t Selection -> ValidateT m -traverseSelectionSet = fmap fold . traverse selection - -fragmentDefinition :: forall m. FragmentDefinition -> ValidateT m -fragmentDefinition fragment@(FragmentDefinition _ _ _ selectionSet _) = - visitChildSelections ruleFilter $ traverseSelectionSet selectionSet - where - ruleFilter accumulator (FragmentDefinitionRule rule) = - mapReaderT (runRule accumulator) $ rule fragment - ruleFilter accumulator (FragmentRule definitionRule _) = - mapReaderT (runRule accumulator) $ definitionRule fragment - ruleFilter accumulator _ = pure accumulator +fragmentSpread :: Rule m -> FragmentSpread -> RuleT m +fragmentSpread (FragmentSpreadRule rule) fragmentSpread' = rule fragmentSpread' +fragmentSpread _ _ = lift mempty diff --git a/src/Language/GraphQL/Validate/Rules.hs b/src/Language/GraphQL/Validate/Rules.hs index f5fdf9f..0e1ccfa 100644 --- a/src/Language/GraphQL/Validate/Rules.hs +++ b/src/Language/GraphQL/Validate/Rules.hs @@ -33,6 +33,7 @@ import Data.HashMap.Strict (HashMap) import qualified Data.HashSet as HashSet import Data.List (sortBy) import Data.Ord (comparing) +import Data.Sequence (Seq(..)) import Data.Text (Text) import qualified Data.Text as Text import Language.GraphQL.AST.Document @@ -61,7 +62,7 @@ specifiedRules = -- | Definition must be OperationDefinition or FragmentDefinition. executableDefinitionsRule :: forall m. Rule m executableDefinitionsRule = DefinitionRule $ \case - ExecutableDefinition _ -> lift Nothing + ExecutableDefinition _ -> lift mempty TypeSystemDefinition _ location -> pure $ error' location TypeSystemExtension _ location -> pure $ error' location where @@ -78,7 +79,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case OperationDefinition Subscription name' _ _ rootFields location -> do groupedFieldSet <- evalStateT (collectFields rootFields) HashSet.empty case HashSet.size groupedFieldSet of - 1 -> lift Nothing + 1 -> lift mempty _ | Just name <- name' -> pure $ Error { message = unwords @@ -94,7 +95,7 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case , locations = [location] , path = [] } - _ -> lift Nothing + _ -> lift mempty where errorMessage = "Anonymous Subscription must select only one top level field." @@ -123,8 +124,8 @@ singleFieldSubscriptionsRule = OperationDefinitionRule $ \case collectFromFragment typeCondition selections accumulator | otherwise = HashSet.union accumulator <$> collectFields selections - skip (Directive "skip" [Argument "if" (Boolean True)]) = True - skip (Directive "include" [Argument "if" (Boolean False)]) = True + skip (Directive "skip" [Argument "if" (Boolean True) _]) = True + skip (Directive "include" [Argument "if" (Boolean False) _]) = True skip _ = False findFragmentDefinition (ExecutableDefinition executableDefinition) Nothing | DefinitionFragment fragmentDefinition <- executableDefinition = @@ -154,11 +155,11 @@ loneAnonymousOperationRule :: forall m. Rule m loneAnonymousOperationRule = OperationDefinitionRule $ \case SelectionSet _ thisLocation -> check thisLocation OperationDefinition _ Nothing _ _ _ thisLocation -> check thisLocation - _ -> lift Nothing + _ -> lift mempty where check thisLocation = asks ast - >>= lift . foldr (filterAnonymousOperations thisLocation) Nothing - filterAnonymousOperations thisLocation definition Nothing + >>= lift . foldr (filterAnonymousOperations thisLocation) mempty + filterAnonymousOperations thisLocation definition Empty | (viewOperation -> Just operationDefinition) <- definition = compareAnonymousOperations thisLocation operationDefinition filterAnonymousOperations _ _ accumulator = accumulator @@ -167,7 +168,7 @@ loneAnonymousOperationRule = OperationDefinitionRule $ \case | thisLocation /= thatLocation -> pure $ error' thisLocation SelectionSet _ thatLocation | thisLocation /= thatLocation -> pure $ error' thisLocation - _ -> Nothing + _ -> mempty error' location = Error { message = "This anonymous operation must be the only defined operation." @@ -181,7 +182,7 @@ uniqueOperationNamesRule :: forall m. Rule m uniqueOperationNamesRule = OperationDefinitionRule $ \case OperationDefinition _ (Just thisName) _ _ _ thisLocation -> findDuplicates (filterByName thisName) thisLocation (error' thisName) - _ -> lift Nothing + _ -> lift mempty where error' operationName = concat [ "There can be only one operation named \"" @@ -203,7 +204,7 @@ findDuplicates filterByName thisLocation errorMessage = do let locations' = foldr filterByName [] ast' if length locations' > 1 && head locations' == thisLocation then pure $ error' locations' - else lift Nothing + else lift mempty where error' locations' = Error { message = errorMessage @@ -258,7 +259,7 @@ fragmentSpreadTargetDefinedRule = FragmentSpreadRule $ \case , locations = [location] , path = [] } - Just _ -> lift Nothing + Just _ -> lift mempty where error' fragmentName = concat [ "Fragment target \"" @@ -280,8 +281,8 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case FragmentSpreadSelection fragmentSelection | FragmentSpread fragmentName _ location <- fragmentSelection -> do ast' <- asks ast - target <- lift $ find (isSpreadTarget fragmentName) ast' - typeCondition <- extractTypeCondition target + let target = find (isSpreadTarget fragmentName) ast' + typeCondition <- lift $ maybeToSeq $ target >>= extractTypeCondition types' <- asks types case HashMap.lookup typeCondition types' of Nothing -> pure $ Error @@ -289,7 +290,7 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case , locations = [location] , path = [] } - Just _ -> lift Nothing + Just _ -> lift mempty InlineFragmentSelection fragmentSelection | InlineFragment maybeType _ _ location <- fragmentSelection , Just typeCondition <- maybeType -> do @@ -300,13 +301,13 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case , locations = [location] , path = [] } - Just _ -> lift Nothing - _ -> lift Nothing + Just _ -> lift mempty + _ -> lift mempty where extractTypeCondition (viewFragment -> Just fragmentDefinition) = let FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition - in pure typeCondition - extractTypeCondition _ = lift Nothing + in Just typeCondition + extractTypeCondition _ = Nothing spreadError fragmentName typeCondition = concat [ "Fragment \"" , Text.unpack fragmentName @@ -320,6 +321,10 @@ fragmentSpreadTypeExistenceRule = SelectionRule $ \case , "\" which doesn't exist in the schema." ] +maybeToSeq :: forall a. Maybe a -> Seq a +maybeToSeq (Just x) = pure x +maybeToSeq Nothing = mempty + -- | Fragments can only be declared on unions, interfaces, and objects. They are -- invalid on scalars. They can only be applied on non‐leaf fields. This rule -- applies to both inline and named fragments. @@ -328,20 +333,20 @@ fragmentsOnCompositeTypesRule = FragmentRule definitionRule inlineRule where inlineRule (InlineFragment (Just typeCondition) _ _ location) = check typeCondition location - inlineRule _ = lift Nothing + inlineRule _ = lift mempty definitionRule (FragmentDefinition _ typeCondition _ _ location) = check typeCondition location check typeCondition location = do types' <- asks types -- Skip unknown types, they are checked by another rule. - _ <- lift $ HashMap.lookup typeCondition types' + _ <- lift $ maybeToSeq $ HashMap.lookup typeCondition types' case lookupTypeCondition typeCondition types' of Nothing -> pure $ Error { message = errorMessage typeCondition , locations = [location] , path = [] } - Just _ -> lift Nothing + Just _ -> lift mempty errorMessage typeCondition = concat [ "Fragment cannot condition on non composite type \"" , Text.unpack typeCondition, @@ -354,7 +359,7 @@ noUnusedFragmentsRule = FragmentDefinitionRule $ \fragment -> asks ast >>= findSpreadByName fragment where findSpreadByName (FragmentDefinition fragName _ _ _ location) definitions - | foldr (go fragName) False definitions = lift Nothing + | foldr (go fragName) False definitions = lift mempty | otherwise = pure $ Error { message = errorMessage fragName , locations = [location] @@ -410,12 +415,12 @@ noFragmentCyclesRule = FragmentDefinitionRule $ \case , locations = [location] , path = [] } - _ -> lift Nothing + _ -> lift mempty where collectFields :: Traversable t => forall m . t Selection - -> StateT (Int, Name) (ReaderT (Validation m) Maybe) (HashMap Name Int) + -> StateT (Int, Name) (ReaderT (Validation m) Seq) (HashMap Name Int) collectFields selectionSet = foldM forEach HashMap.empty selectionSet forEach accumulator = \case FieldSelection fieldSelection -> forField accumulator fieldSelection diff --git a/src/Language/GraphQL/Validate/Validation.hs b/src/Language/GraphQL/Validate/Validation.hs index a513467..4432478 100644 --- a/src/Language/GraphQL/Validate/Validation.hs +++ b/src/Language/GraphQL/Validate/Validation.hs @@ -11,8 +11,9 @@ module Language.GraphQL.Validate.Validation , Validation(..) ) where -import Control.Monad.Trans.Reader (ReaderT(..)) +import Control.Monad.Trans.Reader (ReaderT) import Data.HashMap.Strict (HashMap) +import Data.Sequence (Seq) import Data.Text (Text) import Language.GraphQL.AST.Document import Language.GraphQL.Type.Schema (Schema) @@ -39,7 +40,6 @@ data Validation m = Validation { ast :: Document , schema :: Schema m , types :: HashMap Name (Schema.Type m) - , rules :: [Rule m] } -- | 'Rule' assigns a function to each AST node that can be validated. If the @@ -55,4 +55,4 @@ data Rule m | FieldRule (Field -> RuleT m) -- | Monad transformer used by the rules. -type RuleT m = ReaderT (Validation m) Maybe Error +type RuleT m = ReaderT (Validation m) Seq Error diff --git a/tests/Language/GraphQL/AST/EncoderSpec.hs b/tests/Language/GraphQL/AST/EncoderSpec.hs index 9326fd1..b21e68f 100644 --- a/tests/Language/GraphQL/AST/EncoderSpec.hs +++ b/tests/Language/GraphQL/AST/EncoderSpec.hs @@ -121,11 +121,11 @@ spec = do describe "definition" $ it "indents block strings in arguments" $ - let arguments = [Argument "message" (String "line1\nline2")] - field = Field Nothing "field" arguments [] [] $ Location 0 0 + let location = Location 0 0 + arguments = [Argument "message" (String "line1\nline2") location] + field = Field Nothing "field" arguments [] [] location operation = DefinitionOperation - $ SelectionSet (pure $ FieldSelection field) - $ Location 0 0 + $ SelectionSet (pure $ FieldSelection field) location in definition pretty operation `shouldBe` [r|{ field(message: """ line1 diff --git a/tests/Language/GraphQL/AST/LexerSpec.hs b/tests/Language/GraphQL/AST/LexerSpec.hs index 0b4cb31..5649d2d 100644 --- a/tests/Language/GraphQL/AST/LexerSpec.hs +++ b/tests/Language/GraphQL/AST/LexerSpec.hs @@ -75,7 +75,7 @@ spec = describe "Lexer" $ do parse dollar "" "$" `shouldParse` "$" runBetween parens `shouldSucceedOn` "()" parse spread "" "..." `shouldParse` "..." - parse colon "" ":" `shouldParse` ":" + parse colon "" `shouldSucceedOn` ":" parse equals "" "=" `shouldParse` "=" parse at "" "@" `shouldParse` "@" runBetween brackets `shouldSucceedOn` "[]"