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

@@ -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`

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
 

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'

src/Language/GraphQL/AST/Lexer.hs

@@ -100,8 +100,8 @@ amp :: Parser T.Text
 amp = symbol "&"
 
 -- | Parser for ":".
-colon :: Parser T.Text
+colon :: Parser ()
-colon = symbol ":"
+colon = symbol ":" >> pure ()
 
 -- | Parser for "=".
 equals :: Parser T.Text

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

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
 

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 (join)
-import Control.Monad.Trans.Reader (Reader, asks, mapReaderT, runReader)
+import Control.Monad.Trans.Class (MonadTrans(..))
-import Data.Foldable (fold, foldrM)
+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 :: Rule m -> Definition -> Seq (RuleT m) -> Seq (RuleT m)
-definition definition'
+definition (DefinitionRule rule) definition' acc =
-    | ExecutableDefinition executableDefinition' <- definition'
+    acc |> rule definition'
-        = visitChildSelections ruleFilter
+definition rule (ExecutableDefinition executableDefinition') acc =
-        $ executableDefinition executableDefinition'
+    acc >< executableDefinition rule executableDefinition'
-    | otherwise = asks rules >>= foldM ruleFilter Seq.empty
+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) =
+    applyToChildren = selectionSet rule selections
-        mapReaderT (runRule accumulator) $ rule definition'
-    ruleFilter accumulator _ = pure accumulator
 
-runRule :: Applicative f => Seq Error -> Maybe Error -> f (Seq Error)
+selectionSet :: Traversable t => Rule m -> t Selection -> Seq (RuleT m)
-runRule accumulator (Just error') = pure $ accumulator |> error'
+selectionSet = foldMap . selection
-runRule accumulator Nothing = pure accumulator
 
-executableDefinition :: forall m. ExecutableDefinition -> ValidateT m
+selection :: Rule m -> Selection -> Seq (RuleT m)
-executableDefinition (DefinitionOperation definition') =
+selection rule selection'
-    operationDefinition definition'
+    | SelectionRule selectionRule <- rule =
-executableDefinition (DefinitionFragment definition') =
+        applyToChildren |> selectionRule selection'
-    fragmentDefinition definition'
+    | otherwise = applyToChildren
-
-operationDefinition :: forall m. OperationDefinition -> ValidateT m
-operationDefinition operation =
-    let selectionSet = getSelectionSet operation
-     in visitChildSelections ruleFilter $ traverseSelectionSet selectionSet
   where
-    ruleFilter accumulator (OperationDefinitionRule rule) =
+    applyToChildren =
-        mapReaderT (runRule accumulator) $ rule operation
+        case selection' of
-    ruleFilter accumulator _ = pure accumulator
+            FieldSelection field' -> field rule field'
-    getSelectionSet (SelectionSet selectionSet _) = selectionSet
+            InlineFragmentSelection inlineFragment' ->
-    getSelectionSet (OperationDefinition _ _ _ _ selectionSet _) = selectionSet
+                inlineFragment rule inlineFragment'
+            FragmentSpreadSelection fragmentSpread' ->
+                pure $ fragmentSpread rule fragmentSpread'
 
-visitChildSelections :: forall  m
+field :: Rule m -> Field -> Seq (RuleT m)
-    . (Seq Error -> Rule m -> ValidateT m)
+field (FieldRule rule) field' = pure $ rule field'
-    -> ValidateT m
+field rule (Field _ _ _ _ selections _) = selectionSet rule selections
-    -> ValidateT m
-visitChildSelections ruleFilter children' = do
-    rules' <- asks rules
-    applied <- foldM ruleFilter Seq.empty rules'
-    children <- children'
-    pure $ children >< applied
 
-selection :: forall m. Selection -> ValidateT m
+inlineFragment :: Rule m -> InlineFragment -> Seq (RuleT m)
-selection selection'
+inlineFragment (FragmentRule _ rule) inlineFragment' =
-    | FragmentSpreadSelection fragmentSelection <- selection' =
+    pure $ rule inlineFragment'
-        visitChildSelections ruleFilter $ fragmentSpread fragmentSelection
+inlineFragment rule (InlineFragment _ _ selections _) =
-    | FieldSelection fieldSelection <- selection' =
+    selectionSet rule selections
-        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
 
-field :: forall m. Field -> ValidateT m
+fragmentSpread :: Rule m -> FragmentSpread -> RuleT m
-field field'@(Field _ _ _ _ selections _) =
+fragmentSpread (FragmentSpreadRule rule) fragmentSpread' = rule fragmentSpread'
-    visitChildSelections ruleFilter $ traverseSelectionSet selections
+fragmentSpread _ _ = lift mempty
-  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

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 "skip" [Argument "if" (Boolean True) _]) = True
-    skip (Directive "include" [Argument "if" (Boolean False)]) = 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
+          >>= lift . foldr (filterAnonymousOperations thisLocation) mempty
-      filterAnonymousOperations thisLocation definition Nothing
+      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'
+            let target = find (isSpreadTarget fragmentName) ast'
-            typeCondition <- extractTypeCondition target
+            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
+                Just _ -> lift mempty
-    _ -> lift Nothing
+    _ -> lift mempty
   where
     extractTypeCondition (viewFragment -> Just fragmentDefinition) =
         let FragmentDefinition _ typeCondition _ _ _ = fragmentDefinition
-         in pure typeCondition
+         in Just typeCondition
-    extractTypeCondition _ = lift Nothing
+    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

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

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")]
+            let location = Location 0 0
-                field = Field Nothing "field" arguments [] [] $ Location 0 0
+                arguments = [Argument "message" (String "line1\nline2") location]
+                field = Field Nothing "field" arguments [] [] location
                 operation = DefinitionOperation
-                    $ SelectionSet (pure $ FieldSelection field)
+                    $ SelectionSet (pure $ FieldSelection field) location
-                    $ Location 0 0
              in definition pretty operation `shouldBe` [r|{
   field(message: """
     line1

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` "[]"