From d5797eba1608261aa099b762ba0a3140664a7dba Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 25 Apr 2017 15:04:08 -0400
Subject: [PATCH 01/49] Define location assignment.

---
 src/Data/Syntax/Assignment.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index c7463da89..1af63a835 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -40,6 +40,7 @@ type Assignment node = Freer (AssignmentF node)
 data AssignmentF node a where
   Get :: AssignmentF node node
   State :: AssignmentF (Node grammar) (AssignmentState grammar)
+  Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
   Alt :: a -> a -> AssignmentF symbol a
@@ -61,7 +62,7 @@ state = State `Then` return
 --
 --   If assigning at the end of input or at the end of a list of children, the loccation will be returned as an empty Range and SourceSpan at the current offset. Otherwise, it will be the Range and SourceSpan of the current node.
 location :: Assignment (Node grammar) Location
-location = rtail <$> get <|> (\ (AssignmentState o p _ _) -> Info.Range o o :. Info.SourceSpan p p :. Nil) <$> state
+location = Location `Then` return
 
 -- | Zero-width match of a node with the given symbol.
 --
@@ -126,14 +127,16 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
   (State, state) -> yield state state
-  (assignment, AssignmentState offset _ source (subtree@(Rose node@(_ :. range :. _) children) : _)) -> case assignment of
+  (assignment, AssignmentState offset _ source (subtree@(Rose node@(_ :. range :. span :. Nil) children) : _)) -> case assignment of
     Get -> yield node state
+    Location -> yield (range :. span :. Nil) state
     Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
     Children childAssignment -> do
       c <- assignAllFrom childAssignment state { stateNodes = children }
       yield c (advanceState state)
     _ -> Error ["No rule to match " <> show subtree]
   (Get, AssignmentState{}) -> Error [ "Expected node but got end of input." ]
+  (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
   _ -> Error ["No rule to match at end of input."])
@@ -165,6 +168,7 @@ instance Show symbol => Show1 (AssignmentF symbol) where
   liftShowsPrec sp sl d a = case a of
     Get -> showString "Get"
     State -> showString "State" . sp d (AssignmentState 0 (Info.SourcePos 0 0) (Source.Source "") [])
+    Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
     Alt a b -> showsBinaryWith sp sp "Alt" d a b

From 335cb3194f8e1ce7943f1b45b270d95b1cbb20bc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 25 Apr 2017 15:05:04 -0400
Subject: [PATCH 02/49] :fire: State assignment.

---
 src/Data/Syntax/Assignment.hs | 10 ----------
 1 file changed, 10 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 1af63a835..feb8f4c02 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -2,7 +2,6 @@
 module Data.Syntax.Assignment
 ( Assignment
 , get
-, state
 , Location
 , location
 , symbol
@@ -39,7 +38,6 @@ type Assignment node = Freer (AssignmentF node)
 
 data AssignmentF node a where
   Get :: AssignmentF node node
-  State :: AssignmentF (Node grammar) (AssignmentState grammar)
   Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
@@ -52,12 +50,6 @@ data AssignmentF node a where
 get :: Assignment (Record fields) (Record fields)
 get = Get `Then` return
 
--- | Zero-width production of the current state.
---
---   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (state *> b)' is fine, but 'many state' is not.
-state :: Assignment (Node grammar) (AssignmentState grammar)
-state = State `Then` return
-
 -- | Zero-width production of the current location.
 --
 --   If assigning at the end of input or at the end of a list of children, the loccation will be returned as an empty Range and SourceSpan at the current offset. Otherwise, it will be the Range and SourceSpan of the current node.
@@ -126,7 +118,6 @@ runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
-  (State, state) -> yield state state
   (assignment, AssignmentState offset _ source (subtree@(Rose node@(_ :. range :. span :. Nil) children) : _)) -> case assignment of
     Get -> yield node state
     Location -> yield (range :. span :. Nil) state
@@ -167,7 +158,6 @@ instance Alternative (Assignment symbol) where
 instance Show symbol => Show1 (AssignmentF symbol) where
   liftShowsPrec sp sl d a = case a of
     Get -> showString "Get"
-    State -> showString "State" . sp d (AssignmentState 0 (Info.SourcePos 0 0) (Source.Source "") [])
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a

From 71515d73aebc2526109afce65ee21bd3da8f1cec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 25 Apr 2017 15:08:23 -0400
Subject: [PATCH 03/49] Reintroduce Symbol assignment.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index feb8f4c02..c5ba6bb4a 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -37,6 +37,7 @@ import Text.Show hiding (show)
 type Assignment node = Freer (AssignmentF node)
 
 data AssignmentF node a where
+  Symbol :: symbol -> AssignmentF (Node symbol) ()
   Get :: AssignmentF node node
   Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
@@ -59,8 +60,8 @@ location = Location `Then` return
 -- | Zero-width match of a node with the given symbol.
 --
 --   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not.
-symbol :: (HasField fields symbol, Eq symbol) => symbol -> Assignment (Record fields) ()
-symbol s = Get `Then` guard . (s ==) . getField
+symbol :: Eq symbol => symbol -> Assignment (Node symbol) ()
+symbol s = Symbol s `Then` return
 
 -- | Zero-width production of the current node’s range.
 --
@@ -118,7 +119,8 @@ runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
-  (assignment, AssignmentState offset _ source (subtree@(Rose node@(_ :. range :. span :. Nil) children) : _)) -> case assignment of
+  (assignment, AssignmentState offset _ source (subtree@(Rose node@(symbol :. range :. span :. Nil) children) : _)) -> case assignment of
+    Symbol s -> guard (s == symbol) >> yield () state
     Get -> yield node state
     Location -> yield (range :. span :. Nil) state
     Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
@@ -155,8 +157,9 @@ instance Alternative (Assignment symbol) where
   empty = Empty `Then` return
   (<|>) = (wrap .) . Alt
 
-instance Show symbol => Show1 (AssignmentF symbol) where
+instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of
+    Symbol s -> showsUnaryWith showsPrec "Symbol" d s
     Get -> showString "Get"
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""

From 7be5f34a3875cc5e6188087ec3d6b74c6072cc6f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 25 Apr 2017 15:09:34 -0400
Subject: [PATCH 04/49] :fire: range/sourceSpan.

---
 src/Data/Syntax/Assignment.hs | 14 --------------
 1 file changed, 14 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index c5ba6bb4a..6ea24bec9 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -5,8 +5,6 @@ module Data.Syntax.Assignment
 , Location
 , location
 , symbol
-, range
-, sourceSpan
 , source
 , children
 , Rose(..)
@@ -63,18 +61,6 @@ location = Location `Then` return
 symbol :: Eq symbol => symbol -> Assignment (Node symbol) ()
 symbol s = Symbol s `Then` return
 
--- | Zero-width production of the current node’s range.
---
---   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (range *> b)' is fine, but 'many range' is not.
-range :: HasField fields Info.Range => Assignment (Record fields) Info.Range
-range = Get `Then` return . getField
-
--- | Zero-width production of the current node’s sourceSpan.
---
---   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (sourceSpan *> b)' is fine, but 'many sourceSpan' is not.
-sourceSpan :: HasField fields Info.SourceSpan => Assignment (Record fields) Info.SourceSpan
-sourceSpan = Get `Then` return . getField
-
 -- | A rule to produce a node’s source as a ByteString.
 source :: Assignment symbol ByteString
 source = Source `Then` return

From 49f5e007dab7ea5bd7c0a3fda92e2fbff07f1ea3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Tue, 25 Apr 2017 15:09:41 -0400
Subject: [PATCH 05/49] :fire: Get assignment.

---
 src/Data/Syntax/Assignment.hs | 13 +------------
 1 file changed, 1 insertion(+), 12 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 6ea24bec9..09378392a 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,7 +1,6 @@
 {-# LANGUAGE DataKinds, GADTs, TypeFamilies #-}
 module Data.Syntax.Assignment
 ( Assignment
-, get
 , Location
 , location
 , symbol
@@ -36,19 +35,12 @@ type Assignment node = Freer (AssignmentF node)
 
 data AssignmentF node a where
   Symbol :: symbol -> AssignmentF (Node symbol) ()
-  Get :: AssignmentF node node
   Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
   Alt :: a -> a -> AssignmentF symbol a
   Empty :: AssignmentF symbol a
 
--- | Zero-width production of the current node.
---
---   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (get *> b)' is fine, but 'many get' is not.
-get :: Assignment (Record fields) (Record fields)
-get = Get `Then` return
-
 -- | Zero-width production of the current location.
 --
 --   If assigning at the end of input or at the end of a list of children, the loccation will be returned as an empty Range and SourceSpan at the current offset. Otherwise, it will be the Range and SourceSpan of the current node.
@@ -105,16 +97,14 @@ runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
-  (assignment, AssignmentState offset _ source (subtree@(Rose node@(symbol :. range :. span :. Nil) children) : _)) -> case assignment of
+  (assignment, AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _)) -> case assignment of
     Symbol s -> guard (s == symbol) >> yield () state
-    Get -> yield node state
     Location -> yield (range :. span :. Nil) state
     Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
     Children childAssignment -> do
       c <- assignAllFrom childAssignment state { stateNodes = children }
       yield c (advanceState state)
     _ -> Error ["No rule to match " <> show subtree]
-  (Get, AssignmentState{}) -> Error [ "Expected node but got end of input." ]
   (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
@@ -146,7 +136,6 @@ instance Alternative (Assignment symbol) where
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of
     Symbol s -> showsUnaryWith showsPrec "Symbol" d s
-    Get -> showString "Get"
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a

From 1fe76ee24c0d03c3e6490c794661989d5f9b981f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 09:33:36 -0400
Subject: [PATCH 06/49] Show the rest of assignments following Symbol rules.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 09378392a..076c59538 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -135,7 +135,7 @@ instance Alternative (Assignment symbol) where
 
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of
-    Symbol s -> showsUnaryWith showsPrec "Symbol" d s
+    Symbol s -> showsUnaryWith showsPrec "Symbol" d s . showChar ' ' . sp d ()
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a

From 122558da3be9bda932f59363588349b42e019095 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 10:44:06 -0400
Subject: [PATCH 07/49] Stub in a combinator for committed choice.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 076c59538..bbaba30d2 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -62,6 +62,10 @@ children :: Assignment symbol a -> Assignment symbol a
 children forEach = Children forEach `Then` return
 
 
+commit :: Assignment symbol a -> Assignment symbol a
+commit assignment = assignment
+
+
 -- | A rose tree.
 data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] }
   deriving (Eq, Functor, Show)
@@ -131,7 +135,7 @@ data AssignmentState grammar = AssignmentState
 
 instance Alternative (Assignment symbol) where
   empty = Empty `Then` return
-  (<|>) = (wrap .) . Alt
+  (<|>) = (wrap .) . Alt . commit
 
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of

From fe1a04dc9191f2ab683a73e0bea824b2a163a8ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:27:56 -0400
Subject: [PATCH 08/49] Differentiate between success and errors with no
 messages.

---
 test/Data/Syntax/Assignment/Spec.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 6c13c542c..54c04bf80 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -51,8 +51,8 @@ spec = do
       () <$ runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result ()
 
     it "does not match if its subrule does not match" $
-      let errors r = case r of { Result _ -> [] ; Error e -> e } in
-      Prologue.length (errors (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]]))) `shouldBe` 1
+      let errors r = case r of { Result _ -> Nothing ; Error e -> Just e } in
+      fmap Prologue.length (errors (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]]))) `shouldBe` Just 1
 
     it "matches nested children" $ do
       runAssignment

From 447412be869571c30ecd0c469fa6ecf74694e58b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:29:13 -0400
Subject: [PATCH 09/49] Define committed choice as a map of alternatives.

---
 src/Data/Syntax/Assignment.hs       | 14 ++++++++++----
 test/Data/Syntax/Assignment/Spec.hs |  2 +-
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index bbaba30d2..fb8177fac 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GADTs, TypeFamilies #-}
+{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeFamilies #-}
 module Data.Syntax.Assignment
 ( Assignment
 , Location
@@ -19,6 +19,7 @@ module Data.Syntax.Assignment
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
 import Data.Functor.Foldable hiding (Nil)
+import qualified Data.IntMap.Lazy as IntMap
 import Data.Record
 import Data.Text (unpack)
 import qualified Info
@@ -38,6 +39,7 @@ data AssignmentF node a where
   Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
+  Choose :: IntMap.IntMap a -> AssignmentF node a
   Alt :: a -> a -> AssignmentF symbol a
   Empty :: AssignmentF symbol a
 
@@ -86,10 +88,10 @@ data Result a = Result a | Error [Text]
 
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax, discarding any unparsed nodes.
-assignAll :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source.Source -> [AST grammar] -> Result a
+assignAll :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source.Source -> [AST grammar] -> Result a
 assignAll assignment = (assignAllFrom assignment .) . AssignmentState 0 (Info.SourcePos 1 1)
 
-assignAllFrom :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result a
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result a
 assignAllFrom assignment state = case runAssignment assignment state of
   Result (state, a) -> case stateNodes (dropAnonymous state) of
     [] -> Result a
@@ -97,7 +99,7 @@ assignAllFrom assignment state = case runAssignment assignment state of
   Error e -> Error e
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
+runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
@@ -108,6 +110,9 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
     Children childAssignment -> do
       c <- assignAllFrom childAssignment state { stateNodes = children }
       yield c (advanceState state)
+    Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
+      Just a -> yield a state
+      Nothing -> Error ["Expected " <> show ((toEnum :: Int -> grammar) <$> IntMap.keys choices) <> " but got " <> show subtree]
     _ -> Error ["No rule to match " <> show subtree]
   (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
@@ -143,6 +148,7 @@ instance Show symbol => Show1 (AssignmentF (Node symbol)) where
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
+    Choose choices -> showsUnaryWith (liftShowsPrec sp sl) "Choose" d choices
     Alt a b -> showsBinaryWith sp sp "Alt" d a b
     Empty -> showString "Empty"
 
diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 54c04bf80..561c96e4e 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -85,7 +85,7 @@ startingState :: ByteString -> [AST grammar] -> AssignmentState grammar
 startingState = AssignmentState 0 (Info.SourcePos 1 1) . Source
 
 data Grammar = Red | Green | Blue
-  deriving (Eq, Show)
+  deriving (Enum, Eq, Show)
 
 instance Symbol Grammar where
   symbolType _ = Regular

From 2154e4a4ad30d5e29afcffdd59f73a414f907982 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:29:24 -0400
Subject: [PATCH 10/49] Construct committed choices using the Alternative
 interface.

---
 src/Data/Syntax/Assignment.hs | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index fb8177fac..5117f3d22 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -64,10 +64,6 @@ children :: Assignment symbol a -> Assignment symbol a
 children forEach = Children forEach `Then` return
 
 
-commit :: Assignment symbol a -> Assignment symbol a
-commit assignment = assignment
-
-
 -- | A rose tree.
 data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] }
   deriving (Eq, Functor, Show)
@@ -138,9 +134,12 @@ data AssignmentState grammar = AssignmentState
   }
   deriving (Eq, Show)
 
-instance Alternative (Assignment symbol) where
+instance Enum symbol => Alternative (Assignment (Node symbol)) where
   empty = Empty `Then` return
-  (<|>) = (wrap .) . Alt . commit
+  a <|> b = case (a, b) of
+    (Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
+    (Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity
+    _ -> wrap $ Alt a b
 
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of

From b7899248d5269006be14582092d3bf64d64ba073 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:34:43 -0400
Subject: [PATCH 11/49] :fire: a redundant FIXME.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5117f3d22..c83193ef8 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -98,7 +98,7 @@ assignAllFrom assignment state = case runAssignment assignment state of
 runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
+  (Alt a b, state) -> yield a state <|> yield b state
   (assignment, AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _)) -> case assignment of
     Symbol s -> guard (s == symbol) >> yield () state
     Location -> yield (range :. span :. Nil) state

From b7d84470fb519e58997324884d0a832b1eb38b33 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:37:00 -0400
Subject: [PATCH 12/49] Extract how we show choices into the where clause.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index c83193ef8..192d19bcd 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -108,13 +108,15 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
       yield c (advanceState state)
     Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
       Just a -> yield a state
-      Nothing -> Error ["Expected " <> show ((toEnum :: Int -> grammar) <$> IntMap.keys choices) <> " but got " <> show subtree]
+      Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show subtree]
     _ -> Error ["No rule to match " <> show subtree]
   (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
   _ -> Error ["No rule to match at end of input."])
   . fmap (\ a state -> Result (state, a))
+  where showChoices :: IntMap.IntMap b -> Text
+        showChoices = show . fmap (toEnum :: Int -> grammar) . IntMap.keys
 
 dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar
 dropAnonymous state = state { stateNodes = dropWhile ((/= Regular) . symbolType . rhead . roseValue) (stateNodes state) }

From 6010bcb439d557d7490f16918486e0b7d013f4f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:39:32 -0400
Subject: [PATCH 13/49] Show a better error for committed choice at end of
 input.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 192d19bcd..5640eed19 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -113,6 +113,7 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
   (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
+  (Choose choices, AssignmentState{}) -> Error [ "Expected " <> showChoices choices <> " but got end of input." ]
   _ -> Error ["No rule to match at end of input."])
   . fmap (\ a state -> Result (state, a))
   where showChoices :: IntMap.IntMap b -> Text

From 61b3e3c71f871d827d5960795e35dd7bb8a422ff Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:40:59 -0400
Subject: [PATCH 14/49] Show a better error for symbol rules at end of input.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5640eed19..b35f5d85f 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -110,6 +110,7 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
       Just a -> yield a state
       Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show subtree]
     _ -> Error ["No rule to match " <> show subtree]
+  (Symbol s, AssignmentState{}) -> Error [ "Expected " <> show s <> " but got end of input." ]
   (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]

From d57df3f5fb14eb0f9043bd929bcd93d748a34d55 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:44:53 -0400
Subject: [PATCH 15/49] Show a better error for symbol rules.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index b35f5d85f..696045e2c 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -100,7 +100,10 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
   -- 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, state) -> yield a state <|> yield b state
   (assignment, AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _)) -> case assignment of
-    Symbol s -> guard (s == symbol) >> yield () state
+    Symbol s -> if s == symbol then
+      yield () state
+    else
+      Error [ "Expected " <> show s <> " but got " <> show symbol ]
     Location -> yield (range :. span :. Nil) state
     Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
     Children childAssignment -> do

From e89ea96739a6ca77d0f374985624930e650aeaec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:45:58 -0400
Subject: [PATCH 16/49] Test the specific error message we get for cascading
 children failures.

---
 test/Data/Syntax/Assignment/Spec.hs | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 561c96e4e..698552e6f 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -51,8 +51,7 @@ spec = do
       () <$ runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result ()
 
     it "does not match if its subrule does not match" $
-      let errors r = case r of { Result _ -> Nothing ; Error e -> Just e } in
-      fmap Prologue.length (errors (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]]))) `shouldBe` Just 1
+      (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Error [ "Expected Red but got Green" ]
 
     it "matches nested children" $ do
       runAssignment

From ffbca016dbde40662f2eb0b081c7174d138bae6b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:47:53 -0400
Subject: [PATCH 17/49] Avoid revisiting anonymous nodes.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 696045e2c..dd8a07972 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -99,7 +99,7 @@ runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Sh
 runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
   -- 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, state) -> yield a state <|> yield b state
-  (assignment, AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _)) -> case assignment of
+  (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
     Symbol s -> if s == symbol then
       yield () state
     else
@@ -114,7 +114,7 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
       Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show subtree]
     _ -> Error ["No rule to match " <> show subtree]
   (Symbol s, AssignmentState{}) -> Error [ "Expected " <> show s <> " but got end of input." ]
-  (Location, AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
+  (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
   (Choose choices, AssignmentState{}) -> Error [ "Expected " <> showChoices choices <> " but got end of input." ]

From c85081ea6bb7714b0ed88c7900001e819d0ae40a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 11:58:03 -0400
Subject: [PATCH 18/49] Show the symbol when choice fails.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index dd8a07972..cdb6dc431 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -111,7 +111,7 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
       yield c (advanceState state)
     Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
       Just a -> yield a state
-      Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show subtree]
+      Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show symbol]
     _ -> Error ["No rule to match " <> show subtree]
   (Symbol s, AssignmentState{}) -> Error [ "Expected " <> show s <> " but got end of input." ]
   (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state

From 38a92b7eda9d802cbe69ec2975aebc7c962332fa Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:00:51 -0400
Subject: [PATCH 19/49] Handle alternations of choices on the right.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index cdb6dc431..f65e91f7b 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -145,6 +145,7 @@ instance Enum symbol => Alternative (Assignment (Node symbol)) where
   empty = Empty `Then` return
   a <|> b = case (a, b) of
     (Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
+    (Symbol s `Then` _, Choose choices `Then` continue) -> Choose (IntMap.insertWith const (fromEnum s) a (fmap continue choices)) `Then` identity
     (Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity
     _ -> wrap $ Alt a b
 

From ffe7b2ff66feeb5cf905bb92edb1092c5567a265 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:04:34 -0400
Subject: [PATCH 20/49] Handle alternations of choices on both sides.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index f65e91f7b..b317bc718 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -147,6 +147,7 @@ instance Enum symbol => Alternative (Assignment (Node symbol)) where
     (Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
     (Symbol s `Then` _, Choose choices `Then` continue) -> Choose (IntMap.insertWith const (fromEnum s) a (fmap continue choices)) `Then` identity
     (Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity
+    (Choose choices1 `Then` continue1, Choose choices2 `Then` continue2) -> Choose (IntMap.union (fmap continue1 choices1) (fmap continue2 choices2)) `Then` identity
     _ -> wrap $ Alt a b
 
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where

From 77fe6aff313d30cec7d68ec87ccd092d8c457f0e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:05:49 -0400
Subject: [PATCH 21/49] empty is the left- and right-identity of <|>.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index b317bc718..6e96daf5b 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -144,6 +144,8 @@ data AssignmentState grammar = AssignmentState
 instance Enum symbol => Alternative (Assignment (Node symbol)) where
   empty = Empty `Then` return
   a <|> b = case (a, b) of
+    (_, Empty `Then` _) -> a
+    (Empty `Then` _, _) -> b
     (Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
     (Symbol s `Then` _, Choose choices `Then` continue) -> Choose (IntMap.insertWith const (fromEnum s) a (fmap continue choices)) `Then` identity
     (Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity

From 677031daaae1a17f7cea3a04a40d67ea47c8b60e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:07:33 -0400
Subject: [PATCH 22/49] =?UTF-8?q?Choices=E2=80=99=20errors=20note=20the=20?=
 =?UTF-8?q?choice.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 6e96daf5b..b8322acd3 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -111,13 +111,13 @@ runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAno
       yield c (advanceState state)
     Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
       Just a -> yield a state
-      Nothing -> Error ["Expected " <> showChoices choices <> " but got " <> show symbol]
+      Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
     _ -> Error ["No rule to match " <> show subtree]
   (Symbol s, AssignmentState{}) -> Error [ "Expected " <> show s <> " but got end of input." ]
   (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
-  (Choose choices, AssignmentState{}) -> Error [ "Expected " <> showChoices choices <> " but got end of input." ]
+  (Choose choices, AssignmentState{}) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
   _ -> Error ["No rule to match at end of input."])
   . fmap (\ a state -> Result (state, a))
   where showChoices :: IntMap.IntMap b -> Text

From d583b3cfcc7f58f5084b3655d95a47461c010653 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:11:03 -0400
Subject: [PATCH 23/49] Prevent forgetting to shadow the initial state.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index b8322acd3..b5c2950ac 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -96,7 +96,7 @@ assignAllFrom assignment state = case runAssignment assignment state of
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
 runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
-runAssignment = iterFreer (\ assignment yield state -> case (assignment, dropAnonymous state) of
+runAssignment = iterFreer (\ assignment yield initialState -> case (assignment, dropAnonymous initialState) of
   -- 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, state) -> yield a state <|> yield b state
   (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of

From c2df871607a9ae6597ca3ed82405fc54849f39aa Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:17:43 -0400
Subject: [PATCH 24/49] Replace Symbol with a unary Choose.

---
 src/Data/Syntax/Assignment.hs | 14 ++------------
 1 file changed, 2 insertions(+), 12 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index b5c2950ac..8634395f4 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -35,7 +35,6 @@ import Text.Show hiding (show)
 type Assignment node = Freer (AssignmentF node)
 
 data AssignmentF node a where
-  Symbol :: symbol -> AssignmentF (Node symbol) ()
   Location :: AssignmentF node Location
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
@@ -52,8 +51,8 @@ location = Location `Then` return
 -- | Zero-width match of a node with the given symbol.
 --
 --   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not.
-symbol :: Eq symbol => symbol -> Assignment (Node symbol) ()
-symbol s = Symbol s `Then` return
+symbol :: (Enum symbol, Eq symbol) => symbol -> Assignment (Node symbol) ()
+symbol s = Choose (IntMap.singleton (fromEnum s) ()) `Then` return
 
 -- | A rule to produce a node’s source as a ByteString.
 source :: Assignment symbol ByteString
@@ -100,10 +99,6 @@ runAssignment = iterFreer (\ assignment yield initialState -> case (assignment,
   -- 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, state) -> yield a state <|> yield b state
   (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
-    Symbol s -> if s == symbol then
-      yield () state
-    else
-      Error [ "Expected " <> show s <> " but got " <> show symbol ]
     Location -> yield (range :. span :. Nil) state
     Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
     Children childAssignment -> do
@@ -113,7 +108,6 @@ runAssignment = iterFreer (\ assignment yield initialState -> case (assignment,
       Just a -> yield a state
       Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
     _ -> Error ["No rule to match " <> show subtree]
-  (Symbol s, AssignmentState{}) -> Error [ "Expected " <> show s <> " but got end of input." ]
   (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
   (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
@@ -146,15 +140,11 @@ instance Enum symbol => Alternative (Assignment (Node symbol)) where
   a <|> b = case (a, b) of
     (_, Empty `Then` _) -> a
     (Empty `Then` _, _) -> b
-    (Symbol s1 `Then` _, Symbol s2 `Then` _) -> Choose (IntMap.fromListWith (flip const) [(fromEnum s1, a), (fromEnum s2, b)]) `Then` identity
-    (Symbol s `Then` _, Choose choices `Then` continue) -> Choose (IntMap.insertWith const (fromEnum s) a (fmap continue choices)) `Then` identity
-    (Choose choices `Then` continue, Symbol s `Then` _) -> Choose (IntMap.insertWith (flip const) (fromEnum s) b (fmap continue choices)) `Then` identity
     (Choose choices1 `Then` continue1, Choose choices2 `Then` continue2) -> Choose (IntMap.union (fmap continue1 choices1) (fmap continue2 choices2)) `Then` identity
     _ -> wrap $ Alt a b
 
 instance Show symbol => Show1 (AssignmentF (Node symbol)) where
   liftShowsPrec sp sl d a = case a of
-    Symbol s -> showsUnaryWith showsPrec "Symbol" d s . showChar ' ' . sp d ()
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a

From 129d962041ef76b71e98cbfd187b2f5f37a57dc7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:31:00 -0400
Subject: [PATCH 25/49] Add a leaf combinator.

---
 src/Language/Ruby/Syntax.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 443eb4585..05bf3be4b 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -105,6 +105,9 @@ literal  =  term <*> (Literal.true <$ symbol Language.Ruby.Syntax.True <* source
 term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location) -> Term Syntax Location)
 term =  (\ a f -> cofree $ a :< inj f) <$> location
 
+leaf :: (Enum symbol, Eq symbol, InUnion Syntax' f) => (ByteString -> f (Term Syntax Location)) -> symbol -> Assignment (Node symbol) (Term Syntax Location)
+leaf f s = symbol s *> pure (\ a -> cofree . (a :<) . inj . f) <*> location <*> source
+
 optional :: Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
 optional a = a <|> term <*> pure Syntax.Empty
 

From 860138fe195fa64791cc134a568d14c2ef2626de Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:33:37 -0400
Subject: [PATCH 26/49] :fire: an extra space.

---
 src/Language/Ruby/Syntax.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 05bf3be4b..be4cd4389 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -103,7 +103,7 @@ literal  =  term <*> (Literal.true <$ symbol Language.Ruby.Syntax.True <* source
 
 -- | Assignment of the current node’s annotation.
 term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location) -> Term Syntax Location)
-term =  (\ a f -> cofree $ a :< inj f) <$> location
+term = (\ a f -> cofree $ a :< inj f) <$> location
 
 leaf :: (Enum symbol, Eq symbol, InUnion Syntax' f) => (ByteString -> f (Term Syntax Location)) -> symbol -> Assignment (Node symbol) (Term Syntax Location)
 leaf f s = symbol s *> pure (\ a -> cofree . (a :<) . inj . f) <*> location <*> source

From 620b1ebd49aa220987de937946a8ab73b7f8c626 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:33:51 -0400
Subject: [PATCH 27/49] =?UTF-8?q?Flip=20leaf=E2=80=99s=20argument=20order.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Language/Ruby/Syntax.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index be4cd4389..2c90d8e7d 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -105,8 +105,8 @@ literal  =  term <*> (Literal.true <$ symbol Language.Ruby.Syntax.True <* source
 term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location) -> Term Syntax Location)
 term = (\ a f -> cofree $ a :< inj f) <$> location
 
-leaf :: (Enum symbol, Eq symbol, InUnion Syntax' f) => (ByteString -> f (Term Syntax Location)) -> symbol -> Assignment (Node symbol) (Term Syntax Location)
-leaf f s = symbol s *> pure (\ a -> cofree . (a :<) . inj . f) <*> location <*> source
+leaf :: (Enum symbol, Eq symbol, InUnion Syntax' f) => symbol -> (ByteString -> f (Term Syntax Location)) -> Assignment (Node symbol) (Term Syntax Location)
+leaf s f = symbol s *> pure (\ a -> cofree . (a :<) . inj . f) <*> location <*> source
 
 optional :: Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
 optional a = a <|> term <*> pure Syntax.Empty

From 34e945d1fadc3e61f7bc81c805d0dce58dfdba70 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:34:34 -0400
Subject: [PATCH 28/49] Use the leaf combinator to assign literals & comments.

---
 src/Language/Ruby/Syntax.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 2c90d8e7d..92484a681 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -81,7 +81,7 @@ statement  =  exit Statement.Return Return
   where exit construct sym = term <*> (construct <$ symbol sym <*> children (optional (symbol ArgumentList *> children statement)))
 
 comment :: Assignment (Node Grammar) (Term Syntax Location)
-comment = term <*> (Comment.Comment <$ symbol Comment <*> source)
+comment = leaf Comment Comment.Comment
 
 if' :: Assignment (Node Grammar) (Term Syntax Location)
 if' = go If
@@ -97,9 +97,9 @@ unlessModifier :: Assignment (Node Grammar) (Term Syntax Location)
 unlessModifier = term <* symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> (term <*> (Expression.Not <$> statement)) <*> (term <*> pure Syntax.Empty))
 
 literal :: Assignment (Node Grammar) (Term Syntax Location)
-literal  =  term <*> (Literal.true <$ symbol Language.Ruby.Syntax.True <* source)
-        <|> term <*> (Literal.false <$ symbol Language.Ruby.Syntax.False <* source)
-        <|> term <*> (Literal.Integer <$ symbol Language.Ruby.Syntax.Integer <*> source)
+literal  =  leaf Language.Ruby.Syntax.True (const Literal.true)
+        <|> leaf Language.Ruby.Syntax.False (const Literal.false)
+        <|> leaf Language.Ruby.Syntax.Integer Literal.Integer
 
 -- | Assignment of the current node’s annotation.
 term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location) -> Term Syntax Location)

From b9027441e26d9e9e9e43658038f42aaecc6d5624 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 12:37:13 -0400
Subject: [PATCH 29/49] Use the leaf combinator to assign constants and
 identifiers.

---
 src/Language/Ruby/Syntax.hs | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 92484a681..8826778b7 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -59,10 +59,10 @@ class' = term <*  symbol Class
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
 constant :: Assignment (Node Grammar) (Term Syntax Location)
-constant = term <*> (Syntax.Identifier <$ symbol Constant <*> source)
+constant = leaf Constant Syntax.Identifier
 
 identifier :: Assignment (Node Grammar) (Term Syntax Location)
-identifier = term <*> (Syntax.Identifier <$ symbol Identifier <*> source)
+identifier = leaf Identifier Syntax.Identifier
 
 method :: Assignment (Node Grammar) (Term Syntax Location)
 method = term <*  symbol Method

From 296717777d353169bedb0f45d886a777a1eaeff8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:18:40 -0400
Subject: [PATCH 30/49] Rearrange leaf to put the fmap first.

---
 src/Language/Ruby/Syntax.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 8826778b7..d4c2ae4d8 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -106,7 +106,7 @@ term :: InUnion Syntax' f => Assignment (Node grammar) (f (Term Syntax Location)
 term = (\ a f -> cofree $ a :< inj f) <$> location
 
 leaf :: (Enum symbol, Eq symbol, InUnion Syntax' f) => symbol -> (ByteString -> f (Term Syntax Location)) -> Assignment (Node symbol) (Term Syntax Location)
-leaf s f = symbol s *> pure (\ a -> cofree . (a :<) . inj . f) <*> location <*> source
+leaf s f = (\ a -> cofree . (a :<) . inj . f) <$ symbol s <*> location <*> source
 
 optional :: Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
 optional a = a <|> term <*> pure Syntax.Empty

From e67f5a9398c162575881ddf7e20f5aba1fba7986 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:19:10 -0400
Subject: [PATCH 31/49] Guard terms with symbols.

---
 src/Language/Ruby/Syntax.hs | 16 +++++++---------
 1 file changed, 7 insertions(+), 9 deletions(-)

diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index d4c2ae4d8..f406d8da2 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -53,8 +53,7 @@ declaration :: Assignment (Node Grammar) (Term Syntax Location)
 declaration = comment <|> class' <|> method
 
 class' :: Assignment (Node Grammar) (Term Syntax Location)
-class' = term <*  symbol Class
-              <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
+class' = symbol Class *> term <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
@@ -65,8 +64,7 @@ identifier :: Assignment (Node Grammar) (Term Syntax Location)
 identifier = leaf Identifier Syntax.Identifier
 
 method :: Assignment (Node Grammar) (Term Syntax Location)
-method = term <*  symbol Method
-              <*> children (Declaration.Method <$> identifier <*> pure [] <*> (term <*> many statement))
+method = symbol Method *> term <*> children (Declaration.Method <$> identifier <*> pure [] <*> (term <*> many statement))
 
 statement :: Assignment (Node Grammar) (Term Syntax Location)
 statement  =  exit Statement.Return Return
@@ -78,23 +76,23 @@ statement  =  exit Statement.Return Return
           <|> unless
           <|> unlessModifier
           <|> literal
-  where exit construct sym = term <*> (construct <$ symbol sym <*> children (optional (symbol ArgumentList *> children statement)))
+  where exit construct sym = symbol sym *> term <*> (children (construct <$> optional (symbol ArgumentList *> children statement)))
 
 comment :: Assignment (Node Grammar) (Term Syntax Location)
 comment = leaf Comment Comment.Comment
 
 if' :: Assignment (Node Grammar) (Term Syntax Location)
 if' = go If
-  where go s = term <* symbol s <*> children (Statement.If <$> statement <*> (term <*> many statement) <*> optional (go Elsif <|> term <* symbol Else <*> children (many statement)))
+  where go s = symbol s *> term <*> children (Statement.If <$> statement <*> (term <*> many statement) <*> optional (go Elsif <|> symbol Else *> term <*> children (many statement)))
 
 ifModifier :: Assignment (Node Grammar) (Term Syntax Location)
-ifModifier = term <* symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> (term <*> pure Syntax.Empty))
+ifModifier = symbol IfModifier *> term <*> children (flip Statement.If <$> statement <*> statement <*> (term <*> pure Syntax.Empty))
 
 unless :: Assignment (Node Grammar) (Term Syntax Location)
-unless = term <* symbol Unless <*> children (Statement.If <$> (term <*> (Expression.Not <$> statement)) <*> (term <*> many statement) <*> optional (term <* symbol Else <*> children (many statement)))
+unless = symbol Unless *> term <*> children (Statement.If <$> (term <*> (Expression.Not <$> statement)) <*> (term <*> many statement) <*> optional (symbol Else *> term <*> children (many statement)))
 
 unlessModifier :: Assignment (Node Grammar) (Term Syntax Location)
-unlessModifier = term <* symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> (term <*> (Expression.Not <$> statement)) <*> (term <*> pure Syntax.Empty))
+unlessModifier = symbol UnlessModifier *> term <*> children (flip Statement.If <$> statement <*> (term <*> (Expression.Not <$> statement)) <*> (term <*> pure Syntax.Empty))
 
 literal :: Assignment (Node Grammar) (Term Syntax Location)
 literal  =  leaf Language.Ruby.Syntax.True (const Literal.true)

From a430b444f59909332e5f1e23bdf075e3767d6835 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:23:07 -0400
Subject: [PATCH 32/49] Pull the runAssignment iterator into the where clause.

---
 src/Data/Syntax/Assignment.hs | 41 ++++++++++++++++++-----------------
 1 file changed, 21 insertions(+), 20 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 8634395f4..8349da1ce 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -95,26 +95,27 @@ assignAllFrom assignment state = case runAssignment assignment state of
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
 runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
-runAssignment = iterFreer (\ assignment yield initialState -> case (assignment, dropAnonymous initialState) of
-  -- 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, state) -> yield a state <|> yield b state
-  (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
-    Location -> yield (range :. span :. Nil) state
-    Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
-    Children childAssignment -> do
-      c <- assignAllFrom childAssignment state { stateNodes = children }
-      yield c (advanceState state)
-    Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
-      Just a -> yield a state
-      Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
-    _ -> Error ["No rule to match " <> show subtree]
-  (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-  (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
-  (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
-  (Choose choices, AssignmentState{}) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
-  _ -> Error ["No rule to match at end of input."])
-  . fmap (\ a state -> Result (state, a))
-  where showChoices :: IntMap.IntMap b -> Text
+runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
+  where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result (AssignmentState grammar, a)) -> AssignmentState grammar -> Result (AssignmentState grammar, a)
+        run assignment yield initialState = case (assignment, dropAnonymous initialState) of
+          -- 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, state) -> yield a state <|> yield b state
+          (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
+            Location -> yield (range :. span :. Nil) state
+            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
+            Children childAssignment -> do
+              c <- assignAllFrom childAssignment state { stateNodes = children }
+              yield c (advanceState state)
+            Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
+              Just a -> yield a state
+              Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
+            _ -> Error ["No rule to match " <> show subtree]
+          (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
+          (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
+          (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
+          (Choose choices, AssignmentState{}) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
+          _ -> Error ["No rule to match at end of input."]
+        showChoices :: IntMap.IntMap b -> Text
         showChoices = show . fmap (toEnum :: Int -> grammar) . IntMap.keys
 
 dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar

From b392c9d6b761e6ca7824ecfa597e70ad5f489897 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:24:04 -0400
Subject: [PATCH 33/49] Bind the post-drop state in the where clause.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 8349da1ce..f04e36348 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -97,7 +97,7 @@ assignAllFrom assignment state = case runAssignment assignment state of
 runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
 runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
   where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result (AssignmentState grammar, a)) -> AssignmentState grammar -> Result (AssignmentState grammar, a)
-        run assignment yield initialState = case (assignment, dropAnonymous initialState) of
+        run assignment yield initialState = case (assignment, state) of
           -- 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, state) -> yield a state <|> yield b state
           (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
@@ -115,6 +115,8 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
           (Choose choices, AssignmentState{}) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
           _ -> Error ["No rule to match at end of input."]
+          where state@AssignmentState{..} = dropAnonymous initialState
+
         showChoices :: IntMap.IntMap b -> Text
         showChoices = show . fmap (toEnum :: Int -> grammar) . IntMap.keys
 

From 4103936ca289deac328a018b547ed19a3e2bbcec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:28:04 -0400
Subject: [PATCH 34/49] =?UTF-8?q?Use=20the=20where=20clause=E2=80=99s=20bi?=
 =?UTF-8?q?nding=20for=20the=20offset.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index f04e36348..6f9f19bac 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -100,9 +100,9 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
         run assignment yield initialState = case (assignment, state) of
           -- 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, state) -> yield a state <|> yield b state
-          (assignment, state@(AssignmentState offset _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
+          (assignment, state@(AssignmentState _ _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
             Location -> yield (range :. span :. Nil) state
-            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate offset)) source)) (advanceState state)
+            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) source)) (advanceState state)
             Children childAssignment -> do
               c <- assignAllFrom childAssignment state { stateNodes = children }
               yield c (advanceState state)

From e9bff3be5a0199448c4bcbd32407ae44db11318b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:28:34 -0400
Subject: [PATCH 35/49] =?UTF-8?q?Use=20the=20where=20clause=E2=80=99s=20bi?=
 =?UTF-8?q?nding=20for=20the=20source.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 6f9f19bac..066304509 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -100,9 +100,9 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
         run assignment yield initialState = case (assignment, state) of
           -- 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, state) -> yield a state <|> yield b state
-          (assignment, state@(AssignmentState _ _ source (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
+          (assignment, state@(AssignmentState _ _ _ (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
             Location -> yield (range :. span :. Nil) state
-            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) source)) (advanceState state)
+            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
             Children childAssignment -> do
               c <- assignAllFrom childAssignment state { stateNodes = children }
               yield c (advanceState state)

From 3de156447fbd035588f9653e3867b0fd70f0a982 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:30:07 -0400
Subject: [PATCH 36/49] Match against the nodes.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 066304509..748cc72e6 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -97,10 +97,10 @@ assignAllFrom assignment state = case runAssignment assignment state of
 runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> AssignmentState grammar -> Result (AssignmentState grammar, a)
 runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
   where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result (AssignmentState grammar, a)) -> AssignmentState grammar -> Result (AssignmentState grammar, a)
-        run assignment yield initialState = case (assignment, state) of
+        run assignment yield initialState = case (assignment, stateNodes) of
           -- 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, state) -> yield a state <|> yield b state
-          (assignment, state@(AssignmentState _ _ _ (subtree@(Rose (symbol :. range :. span :. Nil) children) : _))) -> case assignment of
+          (Alt a b, _) -> yield a state <|> yield b state
+          (assignment, subtree@(Rose (symbol :. range :. span :. Nil) children) : _) -> case assignment of
             Location -> yield (range :. span :. Nil) state
             Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
             Children childAssignment -> do
@@ -110,10 +110,10 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
               Just a -> yield a state
               Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
             _ -> Error ["No rule to match " <> show subtree]
-          (Location, state@AssignmentState{..}) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (Source, AssignmentState{}) -> Error [ "Expected leaf node but got end of input." ]
-          (Children _, AssignmentState{}) -> Error [ "Expected branch node but got end of input." ]
-          (Choose choices, AssignmentState{}) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
+          (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
+          (Source, []) -> Error [ "Expected leaf node but got end of input." ]
+          (Children _, []) -> Error [ "Expected branch node but got end of input." ]
+          (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
           _ -> Error ["No rule to match at end of input."]
           where state@AssignmentState{..} = dropAnonymous initialState
 

From 2db005505ed2ef4c7e87710ad9ebb3e5b9393760 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:31:26 -0400
Subject: [PATCH 37/49] Pull the Location case up a level.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 748cc72e6..c309b9314 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -100,8 +100,8 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
         run assignment yield initialState = case (assignment, stateNodes) of
           -- 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, _) -> yield a state <|> yield b state
-          (assignment, subtree@(Rose (symbol :. range :. span :. Nil) children) : _) -> case assignment of
-            Location -> yield (range :. span :. Nil) state
+          (Location, Rose (_ :. location) _ : _) -> yield location state
+          (assignment, subtree@(Rose (symbol :. range :. _ :. Nil) children) : _) -> case assignment of
             Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
             Children childAssignment -> do
               c <- assignAllFrom childAssignment state { stateNodes = children }

From f781118abbb76279383c9d1bb79a50d5a65e4089 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:32:24 -0400
Subject: [PATCH 38/49] Move the location at end case up.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index c309b9314..3656eaead 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -101,6 +101,7 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           -- 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, _) -> yield a state <|> yield b state
           (Location, Rose (_ :. location) _ : _) -> yield location state
+          (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (assignment, subtree@(Rose (symbol :. range :. _ :. Nil) children) : _) -> case assignment of
             Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
             Children childAssignment -> do
@@ -110,7 +111,6 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
               Just a -> yield a state
               Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
             _ -> Error ["No rule to match " <> show subtree]
-          (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, []) -> Error [ "Expected leaf node but got end of input." ]
           (Children _, []) -> Error [ "Expected branch node but got end of input." ]
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]

From a6b5fa06342b8a53514a33409ca6d77f300f30a3 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:33:52 -0400
Subject: [PATCH 39/49] Pull the Source case up a level.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 3656eaead..2fe08e811 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -102,8 +102,9 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Alt a b, _) -> yield a state <|> yield b state
           (Location, Rose (_ :. location) _ : _) -> yield location state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (assignment, subtree@(Rose (symbol :. range :. _ :. Nil) children) : _) -> case assignment of
-            Source -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
+          (Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
+          (Source, []) -> Error [ "Expected leaf node but got end of input." ]
+          (assignment, subtree@(Rose (symbol :. _) children) : _) -> case assignment of
             Children childAssignment -> do
               c <- assignAllFrom childAssignment state { stateNodes = children }
               yield c (advanceState state)
@@ -111,7 +112,6 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
               Just a -> yield a state
               Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
             _ -> Error ["No rule to match " <> show subtree]
-          (Source, []) -> Error [ "Expected leaf node but got end of input." ]
           (Children _, []) -> Error [ "Expected branch node but got end of input." ]
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
           _ -> Error ["No rule to match at end of input."]

From 095e279380cd0c4704f0c98cdc15ea03351dfef4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:35:21 -0400
Subject: [PATCH 40/49] Pull the Children case up a level.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 2fe08e811..776195429 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -104,15 +104,15 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
           (Source, []) -> Error [ "Expected leaf node but got end of input." ]
-          (assignment, subtree@(Rose (symbol :. _) children) : _) -> case assignment of
-            Children childAssignment -> do
-              c <- assignAllFrom childAssignment state { stateNodes = children }
-              yield c (advanceState state)
+          (Children childAssignment, Rose _ children : _) -> do
+            c <- assignAllFrom childAssignment state { stateNodes = children }
+            yield c (advanceState state)
+          (Children _, []) -> Error [ "Expected branch node but got end of input." ]
+          (assignment, subtree@(Rose (symbol :. _) _) : _) -> case assignment of
             Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
               Just a -> yield a state
               Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
             _ -> Error ["No rule to match " <> show subtree]
-          (Children _, []) -> Error [ "Expected branch node but got end of input." ]
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
           _ -> Error ["No rule to match at end of input."]
           where state@AssignmentState{..} = dropAnonymous initialState

From 89b30a51242d251af2e908abc2e29977ec69d1c9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:36:57 -0400
Subject: [PATCH 41/49] Pull the Choose case up a level.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 776195429..8377ca7c1 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -108,12 +108,12 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
             c <- assignAllFrom childAssignment state { stateNodes = children }
             yield c (advanceState state)
           (Children _, []) -> Error [ "Expected branch node but got end of input." ]
-          (assignment, subtree@(Rose (symbol :. _) _) : _) -> case assignment of
-            Choose choices -> case IntMap.lookup (fromEnum symbol) choices of
-              Just a -> yield a state
-              Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
-            _ -> Error ["No rule to match " <> show subtree]
+          (Choose choices, Rose (symbol :. _) _ : _) -> case IntMap.lookup (fromEnum symbol) choices of
+            Just a -> yield a state
+            Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
+          (assignment, subtree : _) -> case assignment of
+            _ -> Error ["No rule to match " <> show subtree]
           _ -> Error ["No rule to match at end of input."]
           where state@AssignmentState{..} = dropAnonymous initialState
 

From d2da6e1ad7ffef35a65300ba4992f7f99bdb3186 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:37:48 -0400
Subject: [PATCH 42/49] Move the Alt rule down to reflect constructor order.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 8377ca7c1..26589ff93 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -98,8 +98,6 @@ runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Sh
 runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
   where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result (AssignmentState grammar, a)) -> AssignmentState grammar -> Result (AssignmentState grammar, a)
         run assignment yield initialState = case (assignment, stateNodes) of
-          -- 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, _) -> yield a state <|> yield b state
           (Location, Rose (_ :. location) _ : _) -> yield location state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
@@ -112,6 +110,8 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
             Just a -> yield a state
             Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
+          -- 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, _) -> yield a state <|> yield b state
           (assignment, subtree : _) -> case assignment of
             _ -> Error ["No rule to match " <> show subtree]
           _ -> Error ["No rule to match at end of input."]

From 52aa3800b7ec4f385f72c560f0cebad05bda1c01 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:39:42 -0400
Subject: [PATCH 43/49] =?UTF-8?q?Don=E2=80=99t=20use=20Result=E2=80=99s=20?=
 =?UTF-8?q?Monad=20instance=20for=20Children=20rules.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 26589ff93..36fb47768 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -102,9 +102,9 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
           (Source, []) -> Error [ "Expected leaf node but got end of input." ]
-          (Children childAssignment, Rose _ children : _) -> do
-            c <- assignAllFrom childAssignment state { stateNodes = children }
-            yield c (advanceState state)
+          (Children childAssignment, Rose _ children : _) -> case assignAllFrom childAssignment state { stateNodes = children } of
+            Result c -> yield c (advanceState state)
+            Error e -> Error e
           (Children _, []) -> Error [ "Expected branch node but got end of input." ]
           (Choose choices, Rose (symbol :. _) _ : _) -> case IntMap.lookup (fromEnum symbol) choices of
             Just a -> yield a state

From 59be638d702e628907a12e0a229d474d0906579c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:40:03 -0400
Subject: [PATCH 44/49] :fire: the unlawful Monad instance for Result.

---
 src/Data/Syntax/Assignment.hs | 5 -----
 1 file changed, 5 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 36fb47768..40ec08540 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -182,8 +182,3 @@ instance Alternative Result where
   Result a <|> _ = Result a
   _ <|> Result b = Result b
   Error a <|> Error b = Error (a <> b)
-
-instance Monad Result where
-  return = pure
-  Error a >>= _ = Error a
-  Result a >>= f = f a

From dfab45dc65fb80802b284da5f2f1c9c0bd632464 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 13:50:45 -0400
Subject: [PATCH 45/49] Tidy up handling of Empty rules.

---
 src/Data/Syntax/Assignment.hs | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 40ec08540..5b28f4d1f 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -112,9 +112,7 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
           -- 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, _) -> yield a state <|> yield b state
-          (assignment, subtree : _) -> case assignment of
-            _ -> Error ["No rule to match " <> show subtree]
-          _ -> Error ["No rule to match at end of input."]
+          _ -> Error ["No rule to match at " <> maybe "end of input" show (listToMaybe stateNodes)]
           where state@AssignmentState{..} = dropAnonymous initialState
 
         showChoices :: IntMap.IntMap b -> Text

From d9d7f98921f1abcd18be9685a35b0897c09b33cd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 14:37:07 -0400
Subject: [PATCH 46/49] Consolidate error reporting.

---
 src/Data/Syntax/Assignment.hs | 18 ++++++++----------
 1 file changed, 8 insertions(+), 10 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5b28f4d1f..25c4f261c 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -101,22 +101,20 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Location, Rose (_ :. location) _ : _) -> yield location state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, Rose (_ :. range :. _) _ : _) -> yield (Source.sourceText (Source.slice (offsetRange range (negate stateOffset)) stateSource)) (advanceState state)
-          (Source, []) -> Error [ "Expected leaf node but got end of input." ]
           (Children childAssignment, Rose _ children : _) -> case assignAllFrom childAssignment state { stateNodes = children } of
             Result c -> yield c (advanceState state)
             Error e -> Error e
-          (Children _, []) -> Error [ "Expected branch node but got end of input." ]
-          (Choose choices, Rose (symbol :. _) _ : _) -> case IntMap.lookup (fromEnum symbol) choices of
-            Just a -> yield a state
-            Nothing -> Error ["Expected one of " <> showChoices choices <> " but got " <> show symbol]
-          (Choose choices, []) -> Error [ "Expected one of " <> showChoices choices <> " but got end of input." ]
+          (Choose choices, Rose (symbol :. _) _ : _) | Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a 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, _) -> yield a state <|> yield b state
-          _ -> Error ["No rule to match at " <> maybe "end of input" show (listToMaybe stateNodes)]
+          _ -> Error [expectation <> maybe "end of input" (show . rhead . roseValue) (listToMaybe stateNodes)]
           where state@AssignmentState{..} = dropAnonymous initialState
-
-        showChoices :: IntMap.IntMap b -> Text
-        showChoices = show . fmap (toEnum :: Int -> grammar) . IntMap.keys
+                expectation = case assignment of
+                  Source -> "Expected a leaf node but got "
+                  Children _ -> "Expected a branch node but got "
+                  Choose choices | [(i, _)] <- IntMap.toList choices -> "Expected " <> show ((toEnum :: Int -> grammar) i) <> " but got "
+                                 | otherwise -> "Expected one of " <> show ((toEnum :: Int -> grammar) <$> IntMap.keys choices) <> " but got "
+                  _ -> "No rule to match at "
 
 dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar
 dropAnonymous state = state { stateNodes = dropWhile ((/= Regular) . symbolType . rhead . roseValue) (stateNodes state) }

From f991988eeaaa1052f5b9b2bb3ac0f7f81a27dcee Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 14:54:29 -0400
Subject: [PATCH 47/49] Show the source of errors.

---
 src/Data/Syntax/Assignment.hs       | 4 +++-
 test/Data/Syntax/Assignment/Spec.hs | 2 +-
 2 files changed, 4 insertions(+), 2 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 25c4f261c..190473ae6 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -17,9 +17,11 @@ module Data.Syntax.Assignment
 ) where
 
 import Control.Monad.Free.Freer
+import qualified Data.ByteString.Char8 as B
 import Data.Functor.Classes
 import Data.Functor.Foldable hiding (Nil)
 import qualified Data.IntMap.Lazy as IntMap
+import Data.List ((!!))
 import Data.Record
 import Data.Text (unpack)
 import qualified Info
@@ -107,7 +109,7 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Choose choices, Rose (symbol :. _) _ : _) | Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a 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, _) -> yield a state <|> yield b state
-          _ -> Error [expectation <> maybe "end of input" (show . rhead . roseValue) (listToMaybe stateNodes)]
+          _ -> Error [expectation <> maybe "end of input" (show . rhead . roseValue) (listToMaybe stateNodes) <> ":\n" <> toS (B.lines (Source.sourceText stateSource) !! pred (Info.line statePos)) <> "\n" <> toS (replicate (pred (Info.column statePos)) ' ') <> "^\n"]
           where state@AssignmentState{..} = dropAnonymous initialState
                 expectation = case assignment of
                   Source -> "Expected a leaf node but got "
diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 698552e6f..34ce0c74f 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -51,7 +51,7 @@ spec = do
       () <$ runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result ()
 
     it "does not match if its subrule does not match" $
-      (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Error [ "Expected Red but got Green" ]
+      (runAssignment (children red) (startingState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Error [ "Expected Red but got Green:\na\n^" ]
 
     it "matches nested children" $ do
       runAssignment

From d6b7e408e317204218559e73967e854d4eefb115 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 15:27:30 -0400
Subject: [PATCH 48/49] =?UTF-8?q?Don=E2=80=99t=20add=20a=20newline=20after?=
 =?UTF-8?q?=20the=20caret.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 190473ae6..de0fcaf58 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -109,7 +109,7 @@ runAssignment = iterFreer run . fmap (\ a state -> Result (state, a))
           (Choose choices, Rose (symbol :. _) _ : _) | Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a 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, _) -> yield a state <|> yield b state
-          _ -> Error [expectation <> maybe "end of input" (show . rhead . roseValue) (listToMaybe stateNodes) <> ":\n" <> toS (B.lines (Source.sourceText stateSource) !! pred (Info.line statePos)) <> "\n" <> toS (replicate (pred (Info.column statePos)) ' ') <> "^\n"]
+          _ -> Error [expectation <> maybe "end of input" (show . rhead . roseValue) (listToMaybe stateNodes) <> ":\n" <> toS (B.lines (Source.sourceText stateSource) !! pred (Info.line statePos)) <> "\n" <> toS (replicate (pred (Info.column statePos)) ' ') <> "^"]
           where state@AssignmentState{..} = dropAnonymous initialState
                 expectation = case assignment of
                   Source -> "Expected a leaf node but got "

From d1b088eda532fbc31459888fbcb542b10e74e89e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 26 Apr 2017 18:39:39 -0400
Subject: [PATCH 49/49] Work around the lack of Show1 for IntMap in lts.

---
 src/Data/Syntax/Assignment.hs | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index de0fcaf58..3c222e568 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -149,7 +149,7 @@ instance Show symbol => Show1 (AssignmentF (Node symbol)) where
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
-    Choose choices -> showsUnaryWith (liftShowsPrec sp sl) "Choose" d choices
+    Choose choices -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Choose" d (IntMap.toList choices)
     Alt a b -> showsBinaryWith sp sp "Alt" d a b
     Empty -> showString "Empty"