Merge branch 'master' into diff-assignment-by-syntax

src/Data/Syntax/Assignment.hs

@@ -228,14 +228,28 @@ showPos :: Maybe FilePath -> Info.Pos -> ShowS
 showPos path Info.Pos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows posLine . showChar ':' . shows posColumn
 
 -- | Run an assignment over an AST exhaustively.
-assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Either (Error grammar) a
+assign :: (HasField fields Info.Range, HasField fields Info.Span, HasField fields grammar, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack)
+  => Assignment (Cofree f (Record fields)) grammar a
+  -> Source.Source
+  -> Cofree f (Record fields)
+  -> Either (Error grammar) a
 assign = assignBy (\ (r :< _) -> Node (getField r) (getField r) (getField r))
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> Source.Source -> ast -> Either (Error grammar) a
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
-assignBy toNode assignment source = fmap fst . assignAllFrom toNode assignment . makeState source . pure
+  => (forall x. Base ast x -> Node grammar)
+  -> Assignment ast grammar a
+  -> Source.Source
+  -> ast
+  -> Either (Error grammar) a
+assignBy toNode assignment source = fmap fst . assignAllFrom source toNode assignment . makeState . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
-assignAllFrom toNode assignment state = runAssignment toNode assignment state >>= go
+  => Source.Source
+  -> (forall x. Base ast x -> Node grammar)
+  -> Assignment ast grammar a
+  -> AssignmentState ast grammar
+  -> Either (Error grammar) (a, AssignmentState ast grammar)
+assignAllFrom source toNode assignment state = runAssignment source toNode assignment state >>= go
   where
     go (a, state) = case stateNodes (dropAnonymous toNode state) of
       [] -> Right (a, state)
@@ -243,19 +257,23 @@ assignAllFrom toNode assignment state = runAssignment toNode assignment state >>
         Left $ fromMaybe (Error spanStart (UnexpectedSymbol [] nodeSymbol)) (stateError state)
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Node grammar) -> Assignment ast grammar a -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
+runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack)
-runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
+  => Source.Source
+  -> (forall x. Base ast x -> Node grammar)
+  -> Assignment ast grammar a
+  -> AssignmentState ast grammar
+  -> Either (Error grammar) (a, AssignmentState ast grammar)
+runAssignment source toNode = iterFreer run . fmap ((pure .) . (,))
   where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)) -> AssignmentState ast grammar -> Either (Error grammar) (a, AssignmentState ast grammar)
-        run assignment yield initialState = case (assignment, stateNodes) of
+        run assignment yield initialState = case (assignment, stateNodes state) of
           (Location, node : _) -> yield (nodeLocation (toNode (F.project node))) state
-          (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.Span statePos statePos :. Nil) state
+          (Location, []) -> yield (Info.Range (stateOffset state) (stateOffset state) :. Info.Span (statePos state) (statePos state) :. Nil) state
           (Project projection, node : _) -> yield (projection (F.project node)) state
-          (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) stateSource)) (advanceState toNode state)
+          (Source, node : _) -> yield (Source.sourceBytes (Source.slice (nodeByteRange (toNode (F.project node))) source)) (advanceState toNode state)
           (Children childAssignment, node : _) -> do
-            (a, state') <- assignAllFrom toNode childAssignment state { stateNodes = toList (F.project node) }
+            (a, state') <- assignAllFrom source toNode childAssignment state { stateNodes = toList (F.project node) }
-            yield a (advanceState toNode state' { stateNodes = stateNodes })
+            yield a (advanceState toNode state' { stateNodes = stateNodes state })
           (Choose choices, node : _) | Node symbol _ _ <- toNode (F.project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
-          (Many _, []) -> yield [] state
           (Many rule, _) -> uncurry yield (runMany rule state)
           -- Nullability: some rules, e.g. @pure a@ and @many a@, should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input.
           (Alt a b, _) -> case yield a state of
@@ -265,9 +283,9 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
           (Catch during handler, _) -> case yield during state of
             Left err -> yield (handler err) state
             Right (a, state') -> Right (a, state')
-          (_, []) -> Left (Error statePos (UnexpectedEndOfInput expectedSymbols))
+          (_, []) -> Left (Error (statePos state) (UnexpectedEndOfInput expectedSymbols))
           (_, ast:_) -> let Node symbol _ (Info.Span spanStart _) = toNode (F.project ast) in Left (Error spanStart (UnexpectedSymbol expectedSymbols symbol))
-          where state@AssignmentState{..} = case assignment of
+          where state = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toNode initialState
                   _ -> initialState
                 expectedSymbols = case assignment of
@@ -275,19 +293,25 @@ runAssignment toNode = iterFreer run . fmap ((pure .) . (,))
                   _ -> []
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
                 runMany :: Assignment ast grammar v -> AssignmentState ast grammar -> ([v], AssignmentState ast grammar)
-                runMany rule state = case runAssignment toNode rule state of
+                runMany rule state = case runAssignment source toNode rule state of
-                  Left e -> ([], state { stateError = Just e })
+                  Left err -> ([], state { stateError = Just err })
-                  Right (a, state') -> let (as, state'') = runMany rule state' in as `seq` (a : as, state'')
+                  Right (a, state') | ((/=) `on` stateCounter) state state' ->
+                                        let (as, state'') = runMany rule state'
+                                        in as `seq` (a : as, state'')
+                                    | otherwise -> ([a], state')
         {-# INLINE run #-}
 
 dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
 dropAnonymous toNode state = state { stateNodes = dropWhile ((/= Regular) . symbolType . nodeSymbol . toNode . F.project) (stateNodes state) }
 
--- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
+-- | Advances the state past the current (head) node (if any), dropping it off
+-- stateNodes & its corresponding bytes off of source, and updating stateOffset &
+-- statePos to its end. Exhausted 'AssignmentState's (those without any
+-- remaining nodes) are returned unchanged.
 advanceState :: Recursive ast => (forall x. Base ast x -> Node grammar) -> AssignmentState ast grammar -> AssignmentState ast grammar
 advanceState toNode state@AssignmentState{..}
   | node : rest <- stateNodes
-  , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError stateSource rest
+  , Node{..} <- toNode (F.project node) = AssignmentState (Info.end nodeByteRange) (Info.spanEnd nodeSpan) stateError (succ stateCounter) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
@@ -295,13 +319,13 @@ data AssignmentState ast grammar = AssignmentState
   { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
   , statePos :: Info.Pos -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateError :: Maybe (Error grammar)
-  , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
+  , stateCounter :: Int -- ^ Always incrementing counter that tracks how many nodes have been visited.
   , stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [ast] -> AssignmentState ast grammar
+makeState :: [ast] -> AssignmentState ast grammar
-makeState = AssignmentState 0 (Info.Pos 1 1) Nothing
+makeState = AssignmentState 0 (Info.Pos 1 1) Nothing 0
 
 
 -- Instances

src/Language/Python/Syntax.hs

@@ -109,6 +109,9 @@ declaration = classDefinition
            <|> statement
            <|> parseError
 
+declarations :: Assignment
+declarations = makeTerm <$> location <*> many declaration
+
 statement :: Assignment
 statement = assertStatement
           <|> assignment'
@@ -134,6 +137,9 @@ statement = assertStatement
           <|> withStatement
           <|> parseError
 
+statements :: Assignment
+statements = makeTerm <$> location <*> many statement
+
 literal :: Assignment
 literal =  boolean
        <|> concatenatedString
@@ -147,7 +153,7 @@ literal =  boolean
        <|> parseError
 
 expressionStatement :: Assignment
-expressionStatement = symbol ExpressionStatement *> children declaration
+expressionStatement = makeTerm <$> symbol ExpressionStatement <*> children (some declaration)
 
 expression :: Assignment
 expression =  argument
@@ -174,6 +180,9 @@ expression =  argument
           <|> unaryOperator
           <|> parseError
 
+expressions :: Assignment
+expressions = makeTerm <$> location <*> many expression
+
 argument :: Assignment
 argument = makeTerm <$> symbol ListSplatArgument <*> (Syntax.Identifier <$> source)
         <|> makeTerm <$> symbol DictionarySplatArgument <*> (Syntax.Identifier <$> source)
@@ -200,33 +209,33 @@ withStatement :: Assignment
 withStatement = makeTerm <$> symbol WithStatement <*> children (uncurry Statement.Let . swap <$> (symbol WithItem *> children ((,) <$> identifier <*> identifier)) <*> expression)
 
 forStatement :: Assignment
-forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (makeTerm <$> symbol Variables <*> children (many expression)) <*> expressionList <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration))))
+forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (makeTerm <$> symbol Variables <*> children (many expression)) <*> expressionList <*> expressions <*> optional (makeTerm <$> symbol ElseClause <*> children (many declaration)))
   where
     make loc variables expressionList forBody forElseClause = case forElseClause of
       Nothing -> makeTerm loc (Statement.ForEach variables expressionList forBody)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach variables expressionList forBody) a)
 
 whileStatement :: Assignment
-whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> (makeTerm <$> location <*> many expression) <*> (optional (makeTerm <$> symbol ElseClause <*> children (many declaration))))
+whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> expressions <*> optional (makeTerm <$> symbol ElseClause <*> children (many declaration)))
   where
     make loc whileCondition whileBody whileElseClause = case whileElseClause of
       Nothing -> makeTerm loc (Statement.While whileCondition whileBody)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a)
 
 tryStatement :: Assignment
-tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> (many (expression <|> elseClause)))
+tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> many (expression <|> elseClause))
-  where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> (many expression)))
+  where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> (makeTerm <$> location <*> many expression))
 
 exceptClause :: Assignment
 exceptClause = makeTerm <$> symbol ExceptClause <*> children
   (Statement.Catch <$> ((makeTerm <$> location <*> (uncurry Statement.Let . swap <$> ((,) <$> identifier <* symbol AnonAs <*> identifier) <*> emptyTerm))
-                      <|> (makeTerm <$> location <*> (many identifier)))
+                      <|> makeTerm <$> location <*> many identifier)
-                   <*> (makeTerm <$> location <*> (many expression)))
+                   <*> expressions)
 
 functionDefinition :: Assignment
-functionDefinition =  (symbol FunctionDefinition >>= \ loc -> children (makeFunctionDeclaration loc <$> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
+functionDefinition =  (symbol FunctionDefinition >>= \ loc -> children (makeFunctionDeclaration loc <$> identifier <*> (symbol Parameters *> children (many expression)) <*> optional (symbol Type *> children expression) <*> declarations))
-                  <|> (symbol AsyncFunctionDefinition >>= \ loc -> children (makeAsyncFunctionDeclaration loc <$> async' <*> identifier <*> (symbol Parameters *> children (many expression)) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
+                  <|> (symbol AsyncFunctionDefinition >>= \ loc -> children (makeAsyncFunctionDeclaration loc <$> async' <*> identifier <*> (symbol Parameters *> children (many expression)) <*> optional (symbol Type *> children expression) <*> declarations))
-                  <|> (symbol Lambda >>= \ loc -> children (makeFunctionDeclaration loc <$> (makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)) <*> ((symbol LambdaParameters *> children (many expression)) <|> (pure [])) <*> (optional (symbol Type *> children expression)) <*> (makeTerm <$> location <*> many declaration)))
+                  <|> (symbol Lambda >>= \ loc -> children (makeFunctionDeclaration loc <$> (makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)) <*> ((symbol LambdaParameters *> children (many expression)) <|> pure []) <*> optional (symbol Type *> children expression) <*> declarations))
   where
     makeFunctionDeclaration loc functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty)
     makeAsyncFunctionDeclaration loc async' functionName' functionParameters ty functionBody = makeTerm loc $ Type.Annotation (makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) identity ty)) async'
@@ -235,7 +244,7 @@ async' :: Assignment
 async' = makeTerm <$> symbol AnonAsync <*> (Syntax.Identifier <$> source)
 
 classDefinition :: Assignment
-classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> identifier <*> argumentList <*> (many declaration))
+classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> identifier <*> argumentList <*> many declaration)
   where argumentList = symbol ArgumentList *> children (many expression)
                     <|> pure []
 
@@ -260,6 +269,7 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> makeTerm loc <$ symbol AnonRAngleEqual  <*> (Expression.GreaterThanEqual lexpression <$> expression)
                                   <|> makeTerm loc <$ symbol AnonEqualEqual   <*> (Expression.Equal lexpression <$> expression)
                                   <|> makeTerm loc <$ symbol AnonBangEqual    <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
+                                  <|> makeTerm loc <$ symbol AnonLAngleRAngle <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                   <|> makeTerm loc <$ symbol AnonNot          <*> (Expression.Not <$> (makeTerm <$> location <*> (Expression.Member lexpression <$> expression)))
                                   <|> makeTerm loc <$ symbol AnonIn           <*> (Expression.Member lexpression <$> expression)
                                                     -- source is used here to push the cursor to the next node to enable matching against `AnonNot`
@@ -273,7 +283,7 @@ keyword :: Assignment
 keyword =  makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
 tuple :: Assignment
-tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
+tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> many expression)
 
 -- TODO: Consider flattening single element lists
 expressionList :: Assignment
@@ -397,12 +407,12 @@ deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.C
   where deleteIdentifier = makeTerm <$> symbol AnonDel <*> (Syntax.Identifier <$> source)
 
 raiseStatement :: Assignment
-raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> (makeTerm <$> location <*> many expression))
+raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> expressions)
 
 ifStatement :: Assignment
-ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
+ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statements <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
-  where elseClause = symbol ElseClause *> children statement
+  where elseClause = symbol ElseClause *> children statements
-        elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
+        elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statements)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 

src/Language/Ruby/Syntax.hs

@@ -76,10 +76,10 @@ type Assignment = HasCallStack => Assignment.Assignment (AST Grammar) Grammar Te
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
 assignment :: Assignment
-assignment = makeTerm <$> symbol Program <*> children (many statement) <|> parseError
+assignment = makeTerm <$> symbol Program <*> children (many expression) <|> parseError
 
-statement :: Assignment
+expression :: Assignment
-statement =
+expression =
       beginBlock
   <|> endBlock
   <|> comment
@@ -120,10 +120,10 @@ statement =
   <|> block
   <|> heredoc
   <|> parseError
-  where mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
+  where mk s construct = makeTerm <$> symbol s <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children expression))
 
-statements :: Assignment
+expressions :: Assignment
-statements = makeTerm <$> location <*> many statement
+expressions = makeTerm <$> location <*> many expression
 
 identifier :: Assignment
 identifier =
@@ -148,8 +148,8 @@ literal =
   <|> makeTerm <$> symbol Grammar.Float <*> (Literal.Float <$> source)
   <|> makeTerm <$> symbol Grammar.Nil <*> (Literal.Null <$ source)
    -- TODO: Do we want to represent the difference between .. and ...
-  <|> makeTerm <$> symbol Range <*> children (Expression.Enumeration <$> statement <*> statement <*> emptyTerm)
+  <|> makeTerm <$> symbol Range <*> children (Expression.Enumeration <$> expression <*> expression <*> emptyTerm)
-  <|> makeTerm <$> symbol Array <*> children (Literal.Array <$> many statement)
+  <|> makeTerm <$> symbol Array <*> children (Literal.Array <$> many expression)
   <|> makeTerm <$> symbol Hash <*> children (Literal.Hash <$> many pair)
   -- TODO: Give subshell it's own literal and allow interpolation
   <|> makeTerm <$> symbol Subshell <*> (Literal.TextElement <$> source)
@@ -174,26 +174,23 @@ keyword =
   where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source)
 
 beginBlock :: Assignment
-beginBlock = makeTerm <$> symbol BeginBlock <*> children (Statement.ScopeEntry <$> many statement)
+beginBlock = makeTerm <$> symbol BeginBlock <*> children (Statement.ScopeEntry <$> many expression)
 
 endBlock :: Assignment
-endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many statement)
+endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many expression)
-
-methodName :: Assignment
-methodName = identifier <|> literal
 
 class' :: Assignment
-class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (identifier <|> scopeResolution) <*> (superclass <|> pure []) <*> many statement)
+class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> expression <*> (superclass <|> pure []) <*> many expression)
-  where superclass = pure <$ symbol Superclass <*> children identifier
+  where superclass = pure <$ symbol Superclass <*> children expression
 
 singletonClass :: Assignment
-singletonClass = makeTerm <$> symbol SingletonClass <*> children (Declaration.Class <$> statement <*> pure [] <*> many statement)
+singletonClass = makeTerm <$> symbol SingletonClass <*> children (Declaration.Class <$> expression <*> pure [] <*> many expression)
 
 module' :: Assignment
-module' = makeTerm <$> symbol Module <*> children (Declaration.Module <$> (identifier <|> scopeResolution) <*> many statement)
+module' = makeTerm <$> symbol Module <*> children (Declaration.Module <$> expression <*> many expression)
 
 scopeResolution :: Assignment
-scopeResolution = makeTerm <$> symbol ScopeResolution <*> children (Expression.ScopeResolution <$> many statement)
+scopeResolution = makeTerm <$> symbol ScopeResolution <*> children (Expression.ScopeResolution <$> many expression)
 
 parameter :: Assignment
 parameter =
@@ -203,79 +200,80 @@ parameter =
   <|> mk KeywordParameter
   <|> mk OptionalParameter
   <|> makeTerm <$> symbol DestructuredParameter <*> children (many parameter)
-  <|> statement
+  <|> expression
+  <|> parseError
   where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source)
 
 method :: Assignment
-method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> emptyTerm <*> methodName <*> params <*> statements)
+method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> emptyTerm <*> expression <*> params <*> expressions)
   where params = symbol MethodParameters *> children (many parameter) <|> pure []
 
 singletonMethod :: Assignment
-singletonMethod = makeTerm <$> symbol SingletonMethod <*> children (Declaration.Method <$> statement <*> methodName <*> params <*> statements)
+singletonMethod = makeTerm <$> symbol SingletonMethod <*> children (Declaration.Method <$> expression <*> expression <*> params <*> expressions)
   where params = symbol MethodParameters *> children (many parameter) <|> pure []
 
 lambda :: Assignment
 lambda = symbol Lambda >>= \ loc -> children $ do
   name <- makeTerm loc <$> (Syntax.Identifier <$> source)
   params <- (symbol BlockParameters <|> symbol LambdaParameters) *> children (many parameter) <|> pure []
-  body <- statements
+  body <- expressions
   pure $ makeTerm loc (Declaration.Function name params body)
 
 block :: Assignment
-block =  makeTerm <$> symbol DoBlock <*> children (Declaration.Function <$> emptyTerm <*> params <*> statements)
+block =  makeTerm <$> symbol DoBlock <*> children (Declaration.Function <$> emptyTerm <*> params <*> expressions)
-     <|> makeTerm <$> symbol Block <*> children (Declaration.Function <$> emptyTerm <*> params <*> statements)
+     <|> makeTerm <$> symbol Block <*> children (Declaration.Function <$> emptyTerm <*> params <*> expressions)
   where params = (symbol BlockParameters) *> children (many parameter) <|> pure []
 
 comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 alias :: Assignment
-alias = makeTerm <$> symbol Alias <*> children (Expression.Call <$> name <*> some methodName <*> emptyTerm)
+alias = makeTerm <$> symbol Alias <*> children (Expression.Call <$> name <*> some expression <*> emptyTerm)
   where name = makeTerm <$> location <*> (Syntax.Identifier <$> source)
 
 undef :: Assignment
-undef = makeTerm <$> symbol Undef <*> children (Expression.Call <$> name <*> some methodName <*> emptyTerm)
+undef = makeTerm <$> symbol Undef <*> children (Expression.Call <$> name <*> some expression <*> emptyTerm)
   where name = makeTerm <$> location <*> (Syntax.Identifier <$> source)
 
 if' :: Assignment
 if' =
       ifElsif If
-  <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> emptyTerm)
+  <|> makeTerm <$> symbol IfModifier <*> children (flip Statement.If <$> expression <*> expression <*> emptyTerm)
-  where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> else')))
+  where ifElsif s = makeTerm <$> symbol s <*> children (Statement.If <$> expression <*> expressions <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> else')))
 
 else' :: Assignment
-else' = makeTerm <$> symbol Else <*> children (many statement)
+else' = makeTerm <$> symbol Else <*> children (many expression)
 
 unless :: Assignment
 unless =
-      makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional else'))
+      makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert expression <*> expressions <*> (fromMaybe <$> emptyTerm <*> optional else'))
-  <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> emptyTerm)
+  <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> expression <*> invert expression <*> emptyTerm)
 
 while' :: Assignment
 while' =
-      makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
+      makeTerm <$> symbol While         <*> children      (Statement.While <$> expression <*> expressions)
-  <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
+  <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> expression <*> expression)
 
 until' :: Assignment
 until' =
-      makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
+      makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert expression <*> expressions)
-  <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
+  <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> expression <*> invert expression)
 
 for :: Assignment
-for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> vars <*> statement <*> statements)
+for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> vars <*> expression <*> expressions)
-  where vars = makeTerm <$> location <*> some identifier
+  where vars = makeTerm <$> location <*> some expression
 
 case' :: Assignment
-case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> statement <*> when)
+case' = makeTerm <$> symbol Case <*> children (Statement.Match <$> expression <*> when')
   where
-    when =  makeTerm <$> symbol When <*> children (Statement.Pattern <$> (makeTerm <$> location <*> some pattern) <*> (when <|> else' <|> statements))
+    when' =  makeTerm <$> symbol When <*> children (Statement.Pattern <$> (makeTerm <$> location <*> some pattern) <*> (when' <|> else' <|> expressions))
-    pattern = symbol Pattern *> children ((symbol SplatArgument *> children statement) <|> statement)
+    pattern = symbol Pattern *> children ((symbol SplatArgument *> children expression) <|> expression)
 
 subscript :: Assignment
-subscript = makeTerm <$> symbol ElementReference <*> children (Expression.Subscript <$> statement <*> many argument)
+subscript = makeTerm <$> symbol ElementReference <*> children (Expression.Subscript <$> expression <*> many argument)
 
 pair :: Assignment
-pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> statement <*> statement)
+pair = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
 argument :: Assignment
 argument =
@@ -283,49 +281,48 @@ argument =
   <|> mk HashSplatArgument
   <|> mk BlockArgument
   <|> pair
-  <|> statement
+  <|> expression
   where mk s = makeTerm <$> symbol s <*> (Syntax.Identifier <$> source)
 
 methodCall :: Assignment
-methodCall = makeTerm <$> symbol MethodCall <*> children (Expression.Call <$> name <*> args <*> (block <|> emptyTerm))
+methodCall = makeTerm <$> symbol MethodCall <*> children (Expression.Call <$> expression <*> args <*> (block <|> emptyTerm))
   where
-    name = identifier <|> scopeResolution <|> call
     args = (symbol ArgumentList <|> symbol ArgumentListWithParens) *> children (many argument) <|> pure []
 
 call :: Assignment
-call = makeTerm <$> symbol Call <*> children (Expression.MemberAccess <$> statement <*> statement)
+call = makeTerm <$> symbol Call <*> children (Expression.MemberAccess <$> expression <*> expression)
 
 rescue :: Assignment
 rescue =  rescue'
-      <|> makeTerm <$> symbol RescueModifier <*> children (Statement.Try <$> statement <*> many (makeTerm <$> location <*> (Statement.Catch <$> statement <*> emptyTerm)))
+      <|> makeTerm <$> symbol RescueModifier <*> children (Statement.Try <$> expression <*> many (makeTerm <$> location <*> (Statement.Catch <$> expression <*> emptyTerm)))
-      <|> makeTerm <$> symbol Ensure <*> children (Statement.Finally <$> statements)
+      <|> makeTerm <$> symbol Ensure <*> children (Statement.Finally <$> expressions)
-      <|> makeTerm <$> symbol Else <*> children (Statement.Else <$> emptyTerm <*> statements)
+      <|> makeTerm <$> symbol Else <*> children (Statement.Else <$> emptyTerm <*> expressions)
   where
-    rescue' = makeTerm <$> symbol Rescue <*> children (Statement.Catch <$> exceptions <*> (rescue' <|> statements))
+    rescue' = makeTerm <$> symbol Rescue <*> children (Statement.Catch <$> exceptions <*> (rescue' <|> expressions))
     exceptions = makeTerm <$> location <*> many ex
-    ex =  makeTerm <$> symbol Exceptions <*> children (many identifier)
+    ex =  makeTerm <$> symbol Exceptions <*> children (many expression)
-      <|> makeTerm <$> symbol ExceptionVariable <*> children (many identifier)
+      <|> makeTerm <$> symbol ExceptionVariable <*> children (many expression)
 
 begin :: Assignment
-begin = makeTerm <$> symbol Begin <*> children (Statement.Try <$> statements <*> many rescue)
+begin = makeTerm <$> symbol Begin <*> children (Statement.Try <$> expressions <*> many rescue)
 
 assignment' :: Assignment
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lhs <*> rhs)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lhs >>= \ var -> Statement.Assignment var <$>
-         (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus var      <$> statement)
+         (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus var      <$> expression)
-      <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus var     <$> statement)
+      <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus var     <$> expression)
-      <|> makeTerm <$> symbol AnonStarEqual               <*> (Expression.Times var     <$> statement)
+      <|> makeTerm <$> symbol AnonStarEqual               <*> (Expression.Times var     <$> expression)
-      <|> makeTerm <$> symbol AnonStarStarEqual           <*> (Expression.Power var     <$> statement)
+      <|> makeTerm <$> symbol AnonStarStarEqual           <*> (Expression.Power var     <$> expression)
-      <|> makeTerm <$> symbol AnonSlashEqual              <*> (Expression.DividedBy var <$> statement)
+      <|> makeTerm <$> symbol AnonSlashEqual              <*> (Expression.DividedBy var <$> expression)
-      <|> makeTerm <$> symbol AnonPipePipeEqual           <*> (Expression.And var       <$> statement)
+      <|> makeTerm <$> symbol AnonPipePipeEqual           <*> (Expression.And var       <$> expression)
-      <|> makeTerm <$> symbol AnonPipeEqual               <*> (Expression.BOr var       <$> statement)
+      <|> makeTerm <$> symbol AnonPipeEqual               <*> (Expression.BOr var       <$> expression)
-      <|> makeTerm <$> symbol AnonAmpersandAmpersandEqual <*> (Expression.And var       <$> statement)
+      <|> makeTerm <$> symbol AnonAmpersandAmpersandEqual <*> (Expression.And var       <$> expression)
-      <|> makeTerm <$> symbol AnonAmpersandEqual          <*> (Expression.BAnd var      <$> statement)
+      <|> makeTerm <$> symbol AnonAmpersandEqual          <*> (Expression.BAnd var      <$> expression)
-      <|> makeTerm <$> symbol AnonPercentEqual            <*> (Expression.Modulo var    <$> statement)
+      <|> makeTerm <$> symbol AnonPercentEqual            <*> (Expression.Modulo var    <$> expression)
-      <|> makeTerm <$> symbol AnonRAngleRAngleEqual       <*> (Expression.RShift var    <$> statement)
+      <|> makeTerm <$> symbol AnonRAngleRAngleEqual       <*> (Expression.RShift var    <$> expression)
-      <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> statement)
+      <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
-      <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> statement)))
+      <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
   where
     lhs = makeTerm <$> symbol LeftAssignmentList <*> children (many expr) <|> expr
     rhs = makeTerm <$> symbol RightAssignmentList <*> children (many expr) <|> expr
@@ -336,15 +333,15 @@ assignment'
 
 unary :: Assignment
 unary = symbol Unary >>= \ location ->
-      makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> statement )
+      makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
-  <|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> statement )
+  <|> makeTerm location . Expression.Not <$> children ( symbol AnonBang *> expression )
-  <|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> statement )
+  <|> makeTerm location . Expression.Not <$> children ( symbol AnonNot *> expression )
-  <|> makeTerm location <$> children (Expression.Call <$> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier <$> source)) <*> some statement <*> emptyTerm)
+  <|> makeTerm location <$> children (Expression.Call <$> (makeTerm <$> symbol AnonDefinedQuestion <*> (Syntax.Identifier <$> source)) <*> some expression <*> emptyTerm)
-  <|> children ( symbol AnonPlus *> statement )
+  <|> children ( symbol AnonPlus *> expression )
-  <|> makeTerm location . Expression.Negate <$> children identifier -- Unary minus (e.g. `-a`). HiddenUnaryMinus nodes are hidden, so we can't match on the symbol.
+  <|> makeTerm location . Expression.Negate <$> children expression -- Unary minus (e.g. `-a`). HiddenUnaryMinus nodes are hidden, so we can't match on the symbol.
 
 binary  :: Assignment
-binary = symbol Binary >>= \ loc -> children $ statement >>= \ lexpression -> go loc lexpression
+binary = symbol Binary >>= \ loc -> children $ expression >>= \ lexpression -> go loc lexpression
   where
     go loc lexpression
        =  mk AnonAnd Expression.And
@@ -375,14 +372,14 @@ binary = symbol Binary >>= \ loc -> children $ statement >>= \ lexpression -> go
       <|> mk AnonSlash Expression.DividedBy
       <|> mk AnonPercent Expression.Modulo
       <|> mk AnonStarStar Expression.Power
-      where mk s constr = makeTerm loc <$> (symbol s *> (constr lexpression <$> statement))
+      where mk s constr = makeTerm loc <$> (symbol s *> (constr lexpression <$> expression))
-            mkNot s constr = makeTerm loc <$ symbol s <*> (Expression.Not <$> (makeTerm <$> location <*> (constr lexpression <$> statement)))
+            mkNot s constr = makeTerm loc <$ symbol s <*> (Expression.Not <$> (makeTerm <$> location <*> (constr lexpression <$> expression)))
 
 conditional :: Assignment
-conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> statement <*> statement <*> statement)
+conditional = makeTerm <$> symbol Conditional <*> children (Statement.If <$> expression <*> expression <*> expression)
 
 emptyStatement :: Assignment
-emptyStatement = makeTerm <$> symbol EmptyStatement <*> pure Syntax.Empty
+emptyStatement = makeTerm <$> symbol EmptyStatement <*> (Syntax.Empty <$ source <|> pure Syntax.Empty)
 
 
 -- Helper functions

test/Data/Syntax/Assignment/Spec.hs

@@ -13,107 +13,200 @@ spec :: Spec
 spec = do
   describe "Applicative" $
     it "matches in sequence" $
-      runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []])
+      fst <$> runAssignment "helloworld" headF ((,) <$> red <*> red) (makeState [node Red 0 5 [], node Red 5 10 []])
       `shouldBe`
-        Right ((Out "hello", Out "world"), AssignmentState 10 (Info.Pos 1 11) Nothing "helloworld" [])
+        Right (Out "hello", Out "world")
 
   describe "Alternative" $ do
     it "attempts multiple alternatives" $
-      runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []])
+      fst <$> runAssignment "hello" headF (green <|> red) (makeState [node Red 0 5 []])
       `shouldBe`
-        Right (Out "hello", AssignmentState 5 (Info.Pos 1 6) Nothing "hello" [])
+        Right (Out "hello")
 
     it "matches repetitions" $
       let s = "colourless green ideas sleep furiously"
           w = words s
           (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
-      runAssignment headF (many red) (makeState (fromBytes s) nodes)
+      fst <$> runAssignment (fromBytes s) headF (many red) (makeState nodes)
       `shouldBe`
-        Right (Out <$> w, AssignmentState (B.length s)
+        Right (Out <$> w)
-                                          (Info.Pos 1 (succ (B.length s)))
-                                          (Just (Error (Info.Pos 1 39) (UnexpectedEndOfInput [Red])))
-                                          (fromBytes s)
-                                          [])
 
     it "matches one-or-more repetitions against one or more input nodes" $
-      runAssignment headF (some red) (makeState "hello" [node Red 0 5 []])
+      fst <$> runAssignment "hello" headF (some red) (makeState [node Red 0 5 []])
       `shouldBe`
-        Right ([Out "hello"], AssignmentState 5
+        Right [Out "hello"]
-                                              (Info.Pos 1 6)
-                                              (Just (Error (Info.Pos 1 6) (UnexpectedEndOfInput [Red])))
-                                              "hello"
-                                              [])
 
   describe "symbol" $ do
     it "matches nodes with the same symbol" $
-      fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Right (Out "hello")
+      fst <$> runAssignment "hello" headF red (makeState [node Red 0 5 []]) `shouldBe` Right (Out "hello")
 
     it "does not advance past the current node" $
-      let initialState = makeState "hi" [ node Red 0 2 [] ] in
+      let initialState = makeState [ node Red 0 2 [] ] in
-      snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Right initialState
+      snd <$> runAssignment "hi" headF (symbol Red) initialState `shouldBe` Right initialState
+
+  describe "without catchError" $ do
+    it "assignment returns UnexpectedSymbol" $
+      runAssignment "A" headF
+        red
+        (makeState [node Green 0 1 []])
+        `shouldBe`
+          Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
+
+    it "assignment returns UnexpectedEndOfInput" $
+      runAssignment "A" headF
+        (symbol Green *> children (some red))
+        (makeState [node Green 0 1 []])
+        `shouldBe`
+          Left (Error (Info.Pos 1 1) (UnexpectedEndOfInput [Red]))
+
+  describe "catchError" $ do
+    it "handler that always matches" $
+      fst <$> runAssignment "A" headF
+        (red `catchError` (\ _ -> OutError <$ location <*> source))
+        (makeState [node Green 0 1 []])
+        `shouldBe`
+          Right (OutError "A")
+
+    it "handler that matches" $
+      fst <$> runAssignment "A" headF
+        (red `catchError` const green)
+        (makeState [node Green 0 1 []])
+        `shouldBe`
+          Right (Out "A")
+
+    it "handler that doesn't match produces error" $
+      runAssignment "A" headF
+        (red `catchError` const blue)
+        (makeState [node Green 0 1 []])
+        `shouldBe`
+          Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Blue] Green))
+
+    describe "in many" $ do
+      it "handler that always matches" $
+        fst <$> runAssignment "PG" headF
+          (symbol Palette *> children (
+            many (red `catchError` (\ _ -> OutError <$ location <*> source))
+          ))
+          (makeState [node Palette 0 1 [node Green 1 2 []]])
+          `shouldBe`
+            Right [OutError "G"]
+
+      it "handler that matches" $
+        fst <$> runAssignment "PG" headF
+          (symbol Palette *> children ( many (red `catchError` const green) ))
+          (makeState [node Palette 0 1 [node Green 1 2 []]])
+          `shouldBe`
+            Right [Out "G"]
+
+      it "handler that doesn't match produces error" $
+        runAssignment "PG" headF
+          (symbol Palette *> children ( many (red `catchError` const blue) ))
+          (makeState [node Palette 0 1 [node Green 1 2 []]])
+          `shouldBe`
+            Left (Error (Info.Pos 1 2) (UnexpectedSymbol [Blue] Green))
+
+      it "handler that always matches with apply consumes and then errors" $
+        runAssignment "PG" headF
+          (symbol Palette *> children (
+            (,) <$> many (red `catchError` (\ _ -> OutError <$ location <*> source)) <*> green
+          ))
+          (makeState [node Palette 0 1 [node Green 1 2 []]])
+          `shouldBe`
+            Left (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green]))
+
+      it "handler that doesn't match with apply" $
+        fst <$> runAssignment "PG" headF
+          (symbol Palette *> children (
+            (,) <$> many (red `catchError` const blue) <*> green
+          ))
+          (makeState [node Palette 0 1 [node Green 1 2 []]])
+          `shouldBe`
+            Right ([], Out "G")
+
+  describe "many" $ do
+    it "takes ones and only one zero width repetition" $
+      fst <$> runAssignment "PGG" headF
+        (symbol Palette *> children ( many (green <|> pure (Out "always")) ))
+        (makeState [node Palette 0 1 [node Green 1 2 [], node Green 2 3 []]])
+        `shouldBe`
+          Right [Out "G", Out "G", Out "always"]
 
   describe "source" $ do
     it "produces the node’s source" $
       assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Right "hi"
 
     it "advances past the current node" $
-      snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Right (AssignmentState 2 (Info.Pos 1 3) Nothing "hi" [])
+      snd <$> runAssignment "hi" headF source (makeState [ node Red 0 2 [] ])
+      `shouldBe`
+        Right (AssignmentState 2 (Info.Pos 1 3) Nothing 1 [])
 
   describe "children" $ do
     it "advances past the current node" $
-      snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Right (AssignmentState 1 (Info.Pos 1 2) Nothing "a" [])
+      snd <$> runAssignment "a" headF (children (pure (Out ""))) (makeState [node Red 0 1 []])
+      `shouldBe`
+        Right (AssignmentState 1 (Info.Pos 1 2) Nothing 1 [])
 
     it "matches if its subrule matches" $
-      () <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Right ()
+      () <$ runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Red 0 1 []]])
+      `shouldBe`
+        Right ()
 
     it "does not match if its subrule does not match" $
-      runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]]) `shouldBe` Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
+      runAssignment "a" headF (children red) (makeState [node Blue 0 1 [node Green 0 1 []]])
+      `shouldBe`
+        Left (Error (Info.Pos 1 1) (UnexpectedSymbol [Red] Green))
 
     it "matches nested children" $
-      runAssignment headF
+      fst <$> runAssignment "1" headF
         (symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
-        (makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
+        (makeState [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
       `shouldBe`
-        Right ("1", AssignmentState 1 (Info.Pos 1 2) Nothing "1" [])
+        Right "1"
 
     it "continues after children" $
-      runAssignment headF
+      fst <$> runAssignment "BC" headF
         (many (symbol Red *> children (symbol Green *> source)
            <|> symbol Blue *> source))
-        (makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ]
+        (makeState [ node Red 0 1 [ node Green 0 1 [] ]
                    , node Blue 1 2 [] ])
       `shouldBe`
-        Right (["B", "C"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Red, Blue]))) "BC" [])
+        Right ["B", "C"]
 
     it "matches multiple nested children" $
-      runAssignment headF
+      fst <$> runAssignment "12" headF
         (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
-        (makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
+        (makeState [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
                                   , node Green 1 2 [ node Blue 1 2 [] ] ] ])
       `shouldBe`
-        Right (["1", "2"], AssignmentState 2 (Info.Pos 1 3) (Just (Error (Info.Pos 1 3) (UnexpectedEndOfInput [Green]))) "12" [])
+        Right ["1", "2"]
 
   describe "runAssignment" $ do
     it "drops anonymous nodes before matching symbols" $
-      runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right (Out "red", AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" [])
+      fst <$> runAssignment "magenta red" headF red (makeState [node Magenta 0 7 [], node Red 8 11 []])
+      `shouldBe`
+        Right (Out "red")
 
     it "does not drop anonymous nodes after matching" $
-      runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Right (Out "red", AssignmentState 3 (Info.Pos 1 4) Nothing "red magenta" [node Magenta 4 11 []])
+      stateNodes . snd <$> runAssignment "red magenta" headF red (makeState [node Red 0 3 [], node Magenta 4 11 []])
+      `shouldBe`
+        Right [node Magenta 4 11 []]
 
     it "does not drop anonymous nodes when requested" $
-      runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Right ((Out "magenta", Out "red"), AssignmentState 11 (Info.Pos 1 12) Nothing "magenta red" [])
+      fst <$> runAssignment "magenta red" headF ((,) <$> magenta <*> red) (makeState [node Magenta 0 7 [], node Red 8 11 []])
+      `shouldBe`
+        Right (Out "magenta", Out "red")
 
 node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol
 node symbol start end children = cofree $ Node symbol (Range start end) (Info.Span (Info.Pos 1 (succ start)) (Info.Pos 1 (succ end))) :< children
 
-data Grammar = Red | Green | Blue | Magenta
+data Grammar = Palette | Red | Green | Blue | Magenta
   deriving (Enum, Eq, Show)
 
 instance Symbol Grammar where
   symbolType Magenta = Anonymous
   symbolType _ = Regular
 
-data Out = Out ByteString
+data Out = Out ByteString | OutError ByteString
   deriving (Eq, Show)
 
 red :: Assignment (AST Grammar) Grammar Out

test/fixtures/python/if-statement.A.py

@@ -1,3 +1,9 @@
 if a:
   b
   c
+elif d:
+  a
+  b
+else:
+  x
+  y