From 965f716be1b6048a01c336008010dcb9abea7e0f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Mon, 14 Aug 2017 13:58:02 -0400
Subject: [PATCH] Add an advance rule to pass nodes.

---
 src/Data/Syntax/Assignment.hs | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index a6be43f5b..650368204 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -74,6 +74,7 @@ module Data.Syntax.Assignment
 , symbol
 , source
 , children
+, advance
 , while
 , until
 , manyThrough
@@ -129,6 +130,7 @@ data AssignmentF ast grammar a where
   Project :: HasCallStack => (forall x. F.Base ast x -> a) -> AssignmentF ast grammar a
   Source :: HasCallStack => AssignmentF ast grammar ByteString
   Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
+  Advance :: HasCallStack => AssignmentF ast grammar ()
   Choose :: HasCallStack => [grammar] -> IntMap.IntMap a -> AssignmentF ast grammar a
   Many :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar [a]
   Alt :: HasCallStack => NonEmpty a -> AssignmentF ast grammar a
@@ -162,6 +164,8 @@ source = withFrozenCallStack $ Source `Then` return
 children :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
 children forEach = withFrozenCallStack $ Children forEach `Then` return
 
+advance :: HasCallStack => Assignment ast grammar ()
+advance = withFrozenCallStack $ Advance `Then` return
 
 -- | Collect a list of values passing a predicate.
 while :: (Alternative m, Monad m, HasCallStack) => (a -> Bool) -> m a -> m [a]
@@ -245,6 +249,7 @@ runAssignment toNode source = \ assignment state -> go assignment state >>= requ
                   Children child -> do
                     (a, state') <- go child state { stateNodes = toList node } >>= requireExhaustive
                     yield a (advance state' { stateNodes = stateNodes })
+                  Advance -> yield () (advance state)
                   Choose _ choices | Just choice <- IntMap.lookup (toIndex (nodeSymbol (toNode node))) choices -> yield choice state
                   Catch during handler -> go during state `catchError` (flip go state . handler) >>= uncurry yield
                   _ -> anywhere (Just node)
@@ -261,6 +266,7 @@ runAssignment toNode source = \ assignment state -> go assignment state >>= requ
                   Project{} -> Left (makeError node)
                   Children{} -> Left (makeError node)
                   Source -> Left (makeError node)
+                  Advance{} -> Left (makeError node)
                   Label child label -> go child state `catchError` (\ err -> throwError err { errorExpected = [Left label] }) >>= uncurry yield
 
                 state@State{..} = if not (null expectedSymbols) && all ((== Regular) . symbolType) expectedSymbols then dropAnonymous initialState else initialState
@@ -362,6 +368,7 @@ instance MonadError (Error (Either String grammar)) (Assignment ast grammar) whe
 instance Show grammar => Show1 (AssignmentF ast grammar) where
   liftShowsPrec sp sl d a = case a of
     End -> showString "End" . showChar ' ' . sp d ()
+    Advance -> showString "Advance" . showChar ' ' . sp d ()
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.Span (Info.Pos 1 1) (Info.Pos 1 1) :. Nil)
     Project projection -> showsUnaryWith (const (const (showChar '_'))) "Project" d projection
     Source -> showString "Source" . showChar ' ' . sp d ""