From a5c74c4270b993381a9943b8d8333350ffbc5410 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 11:45:06 -0400
Subject: [PATCH 01/89] Define Rose as a type synonym for Cofree [].

---
 src/Data/Syntax/Assignment.hs | 32 ++++++++++----------------------
 src/TreeSitter.hs             |  4 ++--
 2 files changed, 12 insertions(+), 24 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index a87346858..324f42ad8 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -66,8 +66,7 @@ module Data.Syntax.Assignment
 , symbol
 , source
 , children
-, Rose(..)
-, RoseF(..)
+, Rose
 , Node
 , AST
 , Result(..)
@@ -84,7 +83,6 @@ module Data.Syntax.Assignment
 import Control.Monad.Free.Freer
 import Data.ByteString (isSuffixOf)
 import Data.Functor.Classes
-import Data.Functor.Foldable hiding (Nil)
 import qualified Data.IntMap.Lazy as IntMap
 import Data.Ix (inRange)
 import Data.List.NonEmpty (nonEmpty)
@@ -136,8 +134,7 @@ children forEach = withFrozenCallStack $ Children forEach `Then` return
 
 
 -- | A rose tree.
-data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] }
-  deriving (Eq, Functor, Show)
+type Rose = Cofree []
 
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = Record '[Info.Range, Info.SourceSpan]
@@ -208,8 +205,7 @@ assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Ass
 assignAllFrom assignment state = case runAssignment assignment state of
   Result err (Just (state, a)) -> case stateNodes (dropAnonymous state) of
     [] -> Result Nothing (Just (state, a))
-    Rose (Just s :. _) _ :_ -> Result (err <|> Just (Error (statePos state) (UnexpectedSymbol [] s))) Nothing
-    Rose (Nothing :. _) _ :_ -> Result (err <|> Just (Error (statePos state) (ParseError []))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (rhead (extract node))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
@@ -217,13 +213,13 @@ runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, Ha
 runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
   where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
         run assignment yield initialState = case (assignment, stateNodes) of
-          (Location, Rose (_ :. location) _ : _) -> yield location state
+          (Location, node : _) -> yield (rtail (extract node)) 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)
-          (Children childAssignment, Rose _ children : _) -> case assignAllFrom childAssignment state { stateNodes = children } of
+          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
+          (Children childAssignment, node : _) -> case assignAllFrom childAssignment state { stateNodes = unwrap node } of
             Result _ (Just (state', a)) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, Rose (Just symbol :. _) _ : _) | Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | (Just symbol :. _) :< _ <- runCofree node, 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -231,7 +227,7 @@ runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
             Result _ (Just (state', a)) -> Result Nothing (Just (state', a))
             Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, Rose (symbol :. _ :. nodeSpan :. Nil) _:_) -> Result (Just (maybe (Error (Info.spanStart nodeSpan) (ParseError expectedSymbols)) (Error (Info.spanStart nodeSpan) . UnexpectedSymbol expectedSymbols) symbol)) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (rhead (extract node)))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous initialState
                   _ -> initialState
@@ -241,12 +237,12 @@ runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
                 choiceSymbols choices = ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
 
 dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar
-dropAnonymous state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . rhead . roseValue) (stateNodes state) }
+dropAnonymous state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . rhead . extract) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
 advanceState :: AssignmentState grammar -> AssignmentState grammar
 advanceState state@AssignmentState{..}
-  | Rose (_ :. range :. span :. _) _ : rest <- stateNodes = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
+  | node : rest <- stateNodes, (_ :. range :. span :. _) :< _ <- runCofree node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
@@ -285,14 +281,6 @@ instance Show symbol => Show1 (AssignmentF (Node symbol)) where
     Throw e -> showsUnaryWith showsPrec "Throw" d e
     Catch during handler -> showsBinaryWith sp (const (const (showChar '_'))) "Catch" d during handler
 
-type instance Base (Rose a) = RoseF a
-
-data RoseF a f = RoseF a [f]
-  deriving (Eq, Foldable, Functor, Show, Traversable)
-
-instance Recursive (Rose a) where project (Rose a as) = RoseF a as
-instance Corecursive (Rose a) where embed (RoseF a as) = Rose a as
-
 instance Show2 Result where
   liftShowsPrec2 sp1 sl1 sp2 sl2 d (Result es a) = showsBinaryWith (liftShowsPrec (liftShowsPrec sp1 sl1) (liftShowList sp1 sl1)) (liftShowsPrec sp2 sl2) "Result" d es a
 
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index fc6d63d21..02ab8748b 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -54,13 +54,13 @@ parseToAST language source = bracket ts_document_new ts_document_free $ \ docume
 
   anaM toAST root
 
-toAST :: (Bounded grammar, Enum grammar) => Node -> IO (A.RoseF (A.Node grammar) Node)
+toAST :: (Bounded grammar, Enum grammar) => Node -> IO (CofreeF [] (A.Node grammar) Node)
 toAST node@Node{..} = do
   let count = fromIntegral nodeChildCount
   children <- allocaArray count $ \ childNodesPtr -> do
     _ <- with nodeTSNode (\ nodePtr -> ts_node_copy_child_nodes nullPtr nodePtr childNodesPtr (fromIntegral count))
     peekArray count childNodesPtr
-  pure $ A.RoseF (safeToEnum (fromIntegral nodeSymbol) :. nodeRange node :. nodeSpan node :. Nil) children
+  pure $ (safeToEnum (fromIntegral nodeSymbol) :. nodeRange node :. nodeSpan node :. Nil) :< children
 
 anaM :: (Corecursive t, Monad m, Traversable (Base t)) => (a -> m (Base t a)) -> a -> m t
 anaM g = a where a = pure . embed <=< traverse a <=< g

From 3944a3198836092423c8f86002ee58ab274be19a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 11:49:41 -0400
Subject: [PATCH 02/89] Parameterize Assignment by the grammar type, not the
 node type.

---
 src/Data/Syntax/Assignment.hs | 30 +++++------
 src/Language/Python/Syntax.hs | 94 +++++++++++++++++------------------
 src/Language/Ruby/Syntax.hs   | 42 ++++++++--------
 src/Parser.hs                 |  6 +--
 4 files changed, 86 insertions(+), 86 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 324f42ad8..5fe4acf51 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -109,19 +109,19 @@ data AssignmentF node a where
   Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF node a
   Alt :: HasCallStack => a -> a -> AssignmentF symbol a
   Empty :: HasCallStack => AssignmentF symbol a
-  Throw :: HasCallStack => Error symbol -> AssignmentF (Node symbol) a
-  Catch :: HasCallStack => a -> (Error symbol -> a) -> AssignmentF (Node symbol) a
+  Throw :: HasCallStack => Error symbol -> AssignmentF symbol a
+  Catch :: HasCallStack => a -> (Error symbol -> a) -> AssignmentF symbol a
 
 -- | 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.
-location :: HasCallStack => Assignment (Node grammar) Location
+location :: HasCallStack => Assignment grammar Location
 location = Location `Then` return
 
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
 --   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 :: (Enum symbol, Eq symbol, HasCallStack) => symbol -> Assignment (Node symbol) Location
+symbol :: (Enum symbol, Eq symbol, HasCallStack) => symbol -> Assignment symbol Location
 symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
 
 -- | A rule to produce a node’s source as a ByteString.
@@ -198,10 +198,10 @@ showSourcePos :: Maybe FilePath -> Info.SourcePos -> ShowS
 showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows line . showChar ':' . shows column
 
 -- | Run an assignment over an AST exhaustively.
-assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment (Node grammar) a -> Source.Source -> AST grammar -> Result grammar a
+assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
 assign assignment source = fmap snd . assignAllFrom assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
 assignAllFrom assignment state = case runAssignment assignment state of
   Result err (Just (state, a)) -> case stateNodes (dropAnonymous state) of
     [] -> Result Nothing (Just (state, a))
@@ -209,9 +209,9 @@ assignAllFrom assignment state = case runAssignment assignment state of
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment (Node grammar) a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
+runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
 runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
-  where run :: AssignmentF (Node grammar) x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
+  where run :: AssignmentF grammar x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (extract node)) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
@@ -260,17 +260,17 @@ makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 -- Instances
 
-instance Enum symbol => Alternative (Assignment (Node symbol)) where
-  empty :: HasCallStack => Assignment (Node symbol) a
+instance Enum symbol => Alternative (Assignment symbol) where
+  empty :: HasCallStack => Assignment symbol a
   empty = Empty `Then` return
-  (<|>) :: HasCallStack => Assignment (Node symbol) a -> Assignment (Node symbol) a -> Assignment (Node symbol) a
+  (<|>) :: HasCallStack => Assignment symbol a -> Assignment symbol a -> Assignment symbol a
   a <|> b = case (a, b) of
     (_, Empty `Then` _) -> a
     (Empty `Then` _, _) -> b
     (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
+instance Show symbol => Show1 (AssignmentF symbol) where
   liftShowsPrec sp sl d a = case a of
     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 ""
@@ -305,9 +305,9 @@ instance Alternative (Result symbol) where
   Result e (Just a) <|> _ = Result e (Just a)
   Result e1 Nothing <|> Result e2 b = Result (e1 <|> e2) b
 
-instance MonadError (Error symbol) (Assignment (Node symbol)) where
-  throwError :: HasCallStack => Error symbol -> Assignment (Node symbol) a
+instance MonadError (Error symbol) (Assignment symbol) where
+  throwError :: HasCallStack => Error symbol -> Assignment symbol a
   throwError error = withFrozenCallStack $ Throw error `Then` return
 
-  catchError :: HasCallStack => Assignment (Node symbol) a -> (Error symbol -> Assignment (Node symbol) a) -> Assignment (Node symbol) a
+  catchError :: HasCallStack => Assignment symbol a -> (Error symbol -> Assignment symbol a) -> Assignment symbol a
   catchError during handler = withFrozenCallStack $ Catch during handler `Then` identity
diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index 158849b9d..e03959d0a 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -80,13 +80,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+assignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+declaration :: HasCallStack => Assignment Grammar (Term Syntax Location)
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+statement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -99,10 +99,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+expressionStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+expression :: HasCallStack => Assignment Grammar (Term Syntax Location)
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -122,13 +122,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+dottedName :: HasCallStack => Assignment Grammar (Term Syntax Location)
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+ellipsis :: HasCallStack => Assignment Grammar (Term Syntax Location)
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+comparisonOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -143,26 +143,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+notOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+keywordIdentifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+tuple :: HasCallStack => Assignment Grammar (Term Syntax Location)
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+expressionList :: HasCallStack => Assignment Grammar (Term Syntax Location)
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+unaryOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+binaryOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -180,17 +180,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+booleanOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+assignment' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+augmentedAssignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -205,56 +205,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+yield :: HasCallStack => Assignment Grammar (Term Syntax Location)
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+rvalue :: HasCallStack => Assignment Grammar (Term Syntax Location)
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+identifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+literal :: HasCallStack => Assignment Grammar (Term Syntax Location)
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+set :: HasCallStack => Assignment Grammar (Term Syntax Location)
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+dictionary :: HasCallStack => Assignment Grammar (Term Syntax Location)
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+list' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+string :: HasCallStack => Assignment Grammar (Term Syntax Location)
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+concatenatedString :: HasCallStack => Assignment Grammar (Term Syntax Location)
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+float :: HasCallStack => Assignment Grammar (Term Syntax Location)
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+integer :: HasCallStack => Assignment Grammar (Term Syntax Location)
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+comment :: HasCallStack => Assignment Grammar (Term Syntax Location)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+import' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+importFrom :: HasCallStack => Assignment Grammar (Term Syntax Location)
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+assertStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+printStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -265,47 +265,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+globalStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+await :: HasCallStack => Assignment Grammar (Term Syntax Location)
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+returnStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+ifStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+memberAccess :: HasCallStack => Assignment Grammar (Term Syntax Location)
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+subscript :: HasCallStack => Assignment Grammar (Term Syntax Location)
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+call :: HasCallStack => Assignment Grammar (Term Syntax Location)
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+boolean :: HasCallStack => Assignment Grammar (Term Syntax Location)
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+none :: HasCallStack => Assignment Grammar (Term Syntax Location)
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+lambda :: HasCallStack => Assignment Grammar (Term Syntax Location)
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+comprehension :: HasCallStack => Assignment Grammar (Term Syntax Location)
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -316,16 +316,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+conditionalExpression :: HasCallStack => Assignment Grammar (Term Syntax Location)
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
 makeTerm :: HasCallStack => InUnion Syntax' f => a -> f (Term Syntax a) -> Term Syntax a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax Location)
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
+handleError :: HasCallStack => Assignment Grammar (Term Syntax Location) -> Assignment Grammar (Term Syntax Location)
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index a03c3fb14..bb21afa22 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -57,30 +57,30 @@ type Error = Assignment.Error Grammar
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+assignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+declaration :: HasCallStack => Assignment Grammar (Term Syntax Location)
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+class' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+constant :: HasCallStack => Assignment Grammar (Term Syntax Location)
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+identifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+method :: HasCallStack => Assignment Grammar (Term Syntax Location)
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+statements :: HasCallStack => Assignment Grammar (Term Syntax Location)
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+statement :: HasCallStack => Assignment Grammar (Term Syntax Location)
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -95,36 +95,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+lvalue :: HasCallStack => Assignment Grammar (Term Syntax Location)
 lvalue = identifier
 
-expression :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+expression :: HasCallStack => Assignment Grammar (Term Syntax Location)
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+comment :: HasCallStack => Assignment Grammar (Term Syntax Location)
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+if' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+unless :: HasCallStack => Assignment Grammar (Term Syntax Location)
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+while :: HasCallStack => Assignment Grammar (Term Syntax Location)
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+until :: HasCallStack => Assignment Grammar (Term Syntax Location)
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+for :: HasCallStack => Assignment Grammar (Term Syntax Location)
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+assignment' :: HasCallStack => Assignment Grammar (Term Syntax Location)
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -142,23 +142,23 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+literal :: HasCallStack => Assignment Grammar (Term Syntax Location)
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment (Node grammar) (Term (Union fs) Location) -> Assignment (Node grammar) (Term (Union fs) Location)
+invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term (Union fs) Location) -> Assignment grammar (Term (Union fs) Location)
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location)
+emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax Location)
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment (Node Grammar) (Term Syntax Location) -> Assignment (Node Grammar) (Term Syntax Location)
+handleError :: HasCallStack => Assignment Grammar (Term Syntax Location) -> Assignment Grammar (Term Syntax Location)
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Parser.hs b/src/Parser.hs
index 975260534..b1340bb57 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -33,9 +33,9 @@ data Parser term where
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
   AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
-                   => Parser (AST grammar)                                 -- ^ A parser producing 'AST'.
-                   -> Assignment (Node grammar) (Term (Union fs) Location) -- ^ An assignment from 'AST' onto 'Term's.
-                   -> Parser (Term (Union fs) Location)                    -- ^ A parser of 'Term's.
+                   => Parser (AST grammar)                          -- ^ A parser producing 'AST'.
+                   -> Assignment grammar (Term (Union fs) Location) -- ^ An assignment from 'AST' onto 'Term's.
+                   -> Parser (Term (Union fs) Location)             -- ^ A parser of 'Term's.
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.

From 4a59d3e5ed387ef314a7be5ae620d852261ddd1c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 11:51:21 -0400
Subject: [PATCH 03/89] =?UTF-8?q?Consistently=20call=20the=20parameter=20?=
 =?UTF-8?q?=E2=80=9Cgrammar.=E2=80=9D?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 5fe4acf51..2f14ddd4f 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -100,17 +100,17 @@ import Text.Show hiding (show)
 -- | Assignment from an AST with some set of 'symbol's onto some other value.
 --
 --   This is essentially a parser.
-type Assignment node = Freer (AssignmentF node)
+type Assignment grammar = Freer (AssignmentF grammar)
 
 data AssignmentF node a where
-  Location :: HasCallStack => AssignmentF node Location
-  Source :: HasCallStack => AssignmentF symbol ByteString
-  Children :: HasCallStack => Assignment symbol a -> AssignmentF symbol a
-  Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF node a
-  Alt :: HasCallStack => a -> a -> AssignmentF symbol a
-  Empty :: HasCallStack => AssignmentF symbol a
-  Throw :: HasCallStack => Error symbol -> AssignmentF symbol a
-  Catch :: HasCallStack => a -> (Error symbol -> a) -> AssignmentF symbol a
+  Location :: HasCallStack => AssignmentF grammar Location
+  Source :: HasCallStack => AssignmentF grammar ByteString
+  Children :: HasCallStack => Assignment grammar a -> AssignmentF grammar a
+  Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF grammar a
+  Alt :: HasCallStack => a -> a -> AssignmentF grammar a
+  Empty :: HasCallStack => AssignmentF grammar a
+  Throw :: HasCallStack => Error grammar -> AssignmentF grammar a
+  Catch :: HasCallStack => a -> (Error grammar -> a) -> AssignmentF grammar a
 
 -- | Zero-width production of the current location.
 --
@@ -121,15 +121,15 @@ location = Location `Then` return
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
 --   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 :: (Enum symbol, Eq symbol, HasCallStack) => symbol -> Assignment symbol Location
+symbol :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment grammar Location
 symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
 
 -- | A rule to produce a node’s source as a ByteString.
-source :: HasCallStack => Assignment symbol ByteString
+source :: HasCallStack => Assignment grammar ByteString
 source = withFrozenCallStack $ Source `Then` return
 
 -- | Match a node by applying an assignment to its children.
-children :: HasCallStack => Assignment symbol a -> Assignment symbol a
+children :: HasCallStack => Assignment grammar a -> Assignment grammar a
 children forEach = withFrozenCallStack $ Children forEach `Then` return
 
 
@@ -147,27 +147,27 @@ type AST grammar = Rose (Node grammar)
 
 
 -- | The result of assignment, possibly containing an error.
-data Result symbol a = Result { resultError :: Maybe (Error symbol), resultValue :: Maybe a }
+data Result grammar a = Result { resultError :: Maybe (Error grammar), resultValue :: Maybe a }
   deriving (Eq, Foldable, Functor, Traversable)
 
-data Error symbol where
+data Error grammar where
   Error
     :: HasCallStack
     => { errorPos :: Info.SourcePos
-       , errorCause :: ErrorCause symbol
-       } -> Error symbol
+       , errorCause :: ErrorCause grammar
+       } -> Error grammar
 
-deriving instance Eq symbol => Eq (Error symbol)
-deriving instance Show symbol => Show (Error symbol)
+deriving instance Eq grammar => Eq (Error grammar)
+deriving instance Show grammar => Show (Error grammar)
 
-data ErrorCause symbol
-  = UnexpectedSymbol [symbol] symbol
-  | UnexpectedEndOfInput [symbol]
-  | ParseError [symbol]
+data ErrorCause grammar
+  = UnexpectedSymbol [grammar] grammar
+  | UnexpectedEndOfInput [grammar]
+  | ParseError [grammar]
   deriving (Eq, Show)
 
 -- | Pretty-print an Error with reference to the source where it occurred.
-showError :: Show symbol => Source.Source -> Error symbol -> String
+showError :: Show grammar => Source.Source -> Error grammar -> String
 showError source error@Error{..}
   = withSGRCode [SetConsoleIntensity BoldIntensity] (showSourcePos Nothing errorPos) . showString ": " . withSGRCode [SetColor Foreground Vivid Red] (showString "error") . showString ": " . showExpectation error . showChar '\n'
   . showString (toS context) . (if isSuffixOf "\n" context then identity else showChar '\n')
@@ -180,14 +180,14 @@ showError source error@Error{..}
         showSGRCode = showString . setSGRCode
         withSGRCode code s = showSGRCode code . s . showSGRCode []
 
-showExpectation :: Show symbol => Error symbol -> ShowS
+showExpectation :: Show grammar => Error grammar -> ShowS
 showExpectation Error{..} = case errorCause of
   UnexpectedEndOfInput [] -> showString "no rule to match at end of input nodes"
   UnexpectedEndOfInput symbols -> showString "expected " . showSymbols symbols . showString " at end of input nodes"
   UnexpectedSymbol symbols a -> showString "expected " . showSymbols symbols . showString ", but got " . shows a
   ParseError symbols -> showString "expected " . showSymbols symbols . showString ", but got parse error"
 
-showSymbols :: Show symbol => [symbol] -> ShowS
+showSymbols :: Show grammar => [grammar] -> ShowS
 showSymbols [] = showString "end of input nodes"
 showSymbols [symbol] = shows symbol
 showSymbols [a, b] = shows a . showString " or " . shows b
@@ -260,17 +260,17 @@ makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 -- Instances
 
-instance Enum symbol => Alternative (Assignment symbol) where
-  empty :: HasCallStack => Assignment symbol a
+instance Enum grammar => Alternative (Assignment grammar) where
+  empty :: HasCallStack => Assignment grammar a
   empty = Empty `Then` return
-  (<|>) :: HasCallStack => Assignment symbol a -> Assignment symbol a -> Assignment symbol a
+  (<|>) :: HasCallStack => Assignment grammar a -> Assignment grammar a -> Assignment grammar a
   a <|> b = case (a, b) of
     (_, Empty `Then` _) -> a
     (Empty `Then` _, _) -> b
     (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 symbol) where
+instance Show grammar => Show1 (AssignmentF grammar) where
   liftShowsPrec sp sl d a = case a of
     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 ""
@@ -284,7 +284,7 @@ instance Show symbol => Show1 (AssignmentF symbol) where
 instance Show2 Result where
   liftShowsPrec2 sp1 sl1 sp2 sl2 d (Result es a) = showsBinaryWith (liftShowsPrec (liftShowsPrec sp1 sl1) (liftShowList sp1 sl1)) (liftShowsPrec sp2 sl2) "Result" d es a
 
-instance (Show symbol, Show a) => Show (Result symbol a) where
+instance (Show grammar, Show a) => Show (Result grammar a) where
   showsPrec = showsPrec2
 
 instance Show1 Error where
@@ -296,18 +296,18 @@ instance Show1 ErrorCause where
     UnexpectedEndOfInput expected -> showsUnaryWith (liftShowsPrec sp sl) "UnexpectedEndOfInput" d expected
     ParseError expected -> showsUnaryWith (liftShowsPrec sp sl) "ParseError" d expected
 
-instance Applicative (Result symbol) where
+instance Applicative (Result grammar) where
   pure = Result Nothing . Just
   Result e1 f <*> Result e2 a = Result (e1 <|> e2) (f <*> a)
 
-instance Alternative (Result symbol) where
+instance Alternative (Result grammar) where
   empty = Result Nothing Nothing
   Result e (Just a) <|> _ = Result e (Just a)
   Result e1 Nothing <|> Result e2 b = Result (e1 <|> e2) b
 
-instance MonadError (Error symbol) (Assignment symbol) where
-  throwError :: HasCallStack => Error symbol -> Assignment symbol a
+instance MonadError (Error grammar) (Assignment grammar) where
+  throwError :: HasCallStack => Error grammar -> Assignment grammar a
   throwError error = withFrozenCallStack $ Throw error `Then` return
 
-  catchError :: HasCallStack => Assignment symbol a -> (Error symbol -> Assignment symbol a) -> Assignment symbol a
+  catchError :: HasCallStack => Assignment grammar a -> (Error grammar -> Assignment grammar a) -> Assignment grammar a
   catchError during handler = withFrozenCallStack $ Catch during handler `Then` identity

From 08e15321c25b09dfe7bc551521bb0313f9ac40d0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 12:05:46 -0400
Subject: [PATCH 04/89] Parameterize assignment by a function producing the
 symbol.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 2f14ddd4f..9416b6462 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -199,27 +199,30 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 
 -- | Run an assignment over an AST exhaustively.
 assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
-assign assignment source = fmap snd . assignAllFrom assignment . makeState source . pure
+assign = assignBy identity
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
-assignAllFrom assignment state = case runAssignment assignment state of
-  Result err (Just (state, a)) -> case stateNodes (dropAnonymous state) of
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
+assignBy toSymbol assignment source = fmap snd . assignAllFrom toSymbol assignment . makeState source . pure
+
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
+assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
+  Result err (Just (state, a)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> Result Nothing (Just (state, a))
-    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (rhead (extract node))))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (rhead (extract node)))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
-runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)) -> AssignmentState grammar -> Result grammar (AssignmentState grammar, a)
+runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
+runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (AssignmentState node, a)) -> AssignmentState node -> Result grammar (AssignmentState node, a)
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (extract node)) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
-          (Children childAssignment, node : _) -> case assignAllFrom childAssignment state { stateNodes = unwrap node } of
+          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (rtail (extract node))) (negate stateOffset)) stateSource)) (advanceState state)
+          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = unwrap node } of
             Result _ (Just (state', a)) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, node : _) | (Just symbol :. _) :< _ <- runCofree node, Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | Just symbol <- toSymbol (rhead (extract node)), 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -227,34 +230,34 @@ runAssignment = iterFreer run . fmap (\ a state -> pure (state, a))
             Result _ (Just (state', a)) -> Result Nothing (Just (state', a))
             Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (rhead (extract node)))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (rhead (extract node))))) Nothing
           where state@AssignmentState{..} = case assignment of
-                  Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous initialState
+                  Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
                   _ -> initialState
                 expectedSymbols = case assignment of
                   Choose choices -> choiceSymbols choices
                   _ -> []
                 choiceSymbols choices = ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
 
-dropAnonymous :: Symbol grammar => AssignmentState grammar -> AssignmentState grammar
-dropAnonymous state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . rhead . extract) (stateNodes state) }
+dropAnonymous :: Symbol grammar => (node -> Maybe grammar) -> AssignmentState node -> AssignmentState node
+dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . rhead . extract) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: AssignmentState grammar -> AssignmentState grammar
+advanceState :: AssignmentState node -> AssignmentState node
 advanceState state@AssignmentState{..}
   | node : rest <- stateNodes, (_ :. range :. span :. _) :< _ <- runCofree node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
-data AssignmentState grammar = AssignmentState
+data AssignmentState node = AssignmentState
   { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
   , statePos :: Info.SourcePos -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
-  , stateNodes :: [AST grammar] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
+  , stateNodes :: [Cofree [] (Record '[ node, Info.Range, Info.SourceSpan ])] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [AST grammar] -> AssignmentState grammar
+makeState :: Source.Source -> [Cofree [] (Record '[ node, Info.Range, Info.SourceSpan ])] -> AssignmentState node
 makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 

From 9f4f37025c191b0e1cd36556a77987d6ba28eaeb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 12:09:59 -0400
Subject: [PATCH 05/89] Generalize the symbolizing function to take the whole
 CofreeF.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 9416b6462..52e0cff39 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GADTs, InstanceSigs, MultiParamTypeClasses, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
+{-# LANGUAGE DataKinds, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
 -- | Assignment of AST onto some other structure (typically terms).
 --
 --   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
@@ -199,20 +199,20 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 
 -- | Run an assignment over an AST exhaustively.
 assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
-assign = assignBy identity
+assign = assignBy (rhead . headF)
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
 assignBy toSymbol assignment source = fmap snd . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (state, a)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> Result Nothing (Just (state, a))
-    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (rhead (extract node)))))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (runCofree node))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (node -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
+runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
 runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
   where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (AssignmentState node, a)) -> AssignmentState node -> Result grammar (AssignmentState node, a)
         run assignment yield initialState = case (assignment, stateNodes) of
@@ -222,7 +222,7 @@ runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
           (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = unwrap node } of
             Result _ (Just (state', a)) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, node : _) | Just symbol <- toSymbol (rhead (extract node)), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | Just symbol <- toSymbol (runCofree node), 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -230,7 +230,7 @@ runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
             Result _ (Just (state', a)) -> Result Nothing (Just (state', a))
             Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (rhead (extract node))))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (runCofree node)))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
                   _ -> initialState
@@ -239,8 +239,8 @@ runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
                   _ -> []
                 choiceSymbols choices = ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
 
-dropAnonymous :: Symbol grammar => (node -> Maybe grammar) -> AssignmentState node -> AssignmentState node
-dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . rhead . extract) (stateNodes state) }
+dropAnonymous :: Symbol grammar => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> AssignmentState node -> AssignmentState node
+dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
 advanceState :: AssignmentState node -> AssignmentState node

From 5e1cfe76074cb8c1a714f145e77a85f3f54974b2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 12:15:22 -0400
Subject: [PATCH 06/89] Swap the ordering of the result fields.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 52e0cff39..6dd75b213 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -202,32 +202,32 @@ assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment
 assign = assignBy (rhead . headF)
 
 assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
-assignBy toSymbol assignment source = fmap snd . assignAllFrom toSymbol assignment . makeState source . pure
+assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
-  Result err (Just (state, a)) -> case stateNodes (dropAnonymous toSymbol state) of
-    [] -> Result Nothing (Just (state, a))
+  Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
+    [] -> Result Nothing (Just (a, state))
     node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (runCofree node))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (AssignmentState node, a)
-runAssignment toSymbol = iterFreer run . fmap (\ a state -> pure (state, a))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (AssignmentState node, a)) -> AssignmentState node -> Result grammar (AssignmentState node, a)
+runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
+runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (a, AssignmentState node)) -> AssignmentState node -> Result grammar (a, AssignmentState node)
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (extract node)) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (rtail (extract node))) (negate stateOffset)) stateSource)) (advanceState state)
           (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = unwrap node } of
-            Result _ (Just (state', a)) -> yield a (advanceState state' { stateNodes = stateNodes })
+            Result _ (Just (a, state')) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
           (Choose choices, node : _) | Just symbol <- toSymbol (runCofree node), 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
           (Throw e, _) -> Result (Just e) Nothing
           (Catch during handler, _) -> case yield during state of
-            Result _ (Just (state', a)) -> Result Nothing (Just (state', a))
+            Result _ (Just (a, state')) -> Result Nothing (Just (a, state'))
             Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
           (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (runCofree node)))) Nothing

From 6c69d315a0432751bf5862fee2d9b33a05fd4fac Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 12:17:13 -0400
Subject: [PATCH 07/89] Simplify result production in a couple of places.

---
 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 6dd75b213..26cce5cb4 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -207,7 +207,7 @@ assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignme
 assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
-    [] -> Result Nothing (Just (a, state))
+    [] -> pure (a, state)
     node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (runCofree node))))) Nothing
   r -> r
 
@@ -227,8 +227,8 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
           (Alt a b, _) -> yield a state <|> yield b state
           (Throw e, _) -> Result (Just e) Nothing
           (Catch during handler, _) -> case yield during state of
-            Result _ (Just (a, state')) -> Result Nothing (Just (a, state'))
-            Result err Nothing -> maybe (Result Nothing Nothing) (flip yield state . handler) err
+            Result _ (Just (a, state')) -> pure (a, state')
+            Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
           (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (runCofree node)))) Nothing
           where state@AssignmentState{..} = case assignment of

From 54bb4f94556787fbd765f2dcd44c228b621c0c8f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 12:39:44 -0400
Subject: [PATCH 08/89] =?UTF-8?q?Rename=20AssignmentF=E2=80=99s=20grammar?=
 =?UTF-8?q?=20parameter=20to=20match=20every=20use=20of=20it.?=
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 26cce5cb4..6aaca5df9 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -102,7 +102,7 @@ import Text.Show hiding (show)
 --   This is essentially a parser.
 type Assignment grammar = Freer (AssignmentF grammar)
 
-data AssignmentF node a where
+data AssignmentF grammar a where
   Location :: HasCallStack => AssignmentF grammar Location
   Source :: HasCallStack => AssignmentF grammar ByteString
   Children :: HasCallStack => Assignment grammar a -> AssignmentF grammar a

From 713844423f884f633f18ad755a889b218eb1116b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 13:51:01 -0400
Subject: [PATCH 09/89] Clean up the selection of errors using the Alternative
 instance.

---
 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 6aaca5df9..bb954e561 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -230,7 +230,7 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
             Result _ (Just (a, state')) -> pure (a, state')
             Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Just (maybe (Error startPos (ParseError expectedSymbols)) (Error startPos . UnexpectedSymbol expectedSymbols) (toSymbol (runCofree node)))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (runCofree node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
                   _ -> initialState

From 52be6902a8ea80f585e4bdaf39c470c50776b66c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:15:36 -0400
Subject: [PATCH 10/89] :fire: redundant parens.

---
 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 bb954e561..a19e36de1 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -237,7 +237,7 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
                 expectedSymbols = case assignment of
                   Choose choices -> choiceSymbols choices
                   _ -> []
-                choiceSymbols choices = ((toEnum :: Int -> grammar) <$> IntMap.keys choices)
+                choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
 dropAnonymous :: Symbol grammar => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> AssignmentState node -> AssignmentState node
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }

From af80bca937e85ebee489cdd96fe7883266cfccb0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:23:33 -0400
Subject: [PATCH 11/89] :fire: Rose.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index a19e36de1..f3dc4c262 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -66,7 +66,6 @@ module Data.Syntax.Assignment
 , symbol
 , source
 , children
-, Rose
 , Node
 , AST
 , Result(..)
@@ -133,9 +132,6 @@ children :: HasCallStack => Assignment grammar a -> Assignment grammar a
 children forEach = withFrozenCallStack $ Children forEach `Then` return
 
 
--- | A rose tree.
-type Rose = Cofree []
-
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = Record '[Info.Range, Info.SourceSpan]
 
@@ -143,7 +139,7 @@ type Location = Record '[Info.Range, Info.SourceSpan]
 type Node grammar = Record '[Maybe grammar, Info.Range, Info.SourceSpan]
 
 -- | An abstract syntax tree in some 'grammar', with symbols and location information annotating each node.
-type AST grammar = Rose (Node grammar)
+type AST grammar = Cofree [] (Node grammar)
 
 
 -- | The result of assignment, possibly containing an error.

From ddc58d3f83603d93fa17a4bcfeafe317048c585b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:23:37 -0400
Subject: [PATCH 12/89] Rename rec to node.

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

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 0c9af36bf..4f8f166c0 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -14,50 +14,50 @@ spec :: Spec
 spec = do
   describe "Applicative" $
     it "matches in sequence" $
-      runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (rec Red 0 5) [], Rose (rec Red 5 10) []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
+      runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (node Red 0 5) [], Rose (node Red 5 10) []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
 
   describe "Alternative" $ do
     it "attempts multiple alternatives" $
-      runAssignment (green <|> red) (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
+      runAssignment (green <|> red) (makeState "hello" [Rose (node Red 0 5) []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
 
     it "matches repetitions" $
       let s = "colourless green ideas sleep furiously"
           w = words s
-          (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [Rose (rec Red i (i + B.length word)) []])) (0, []) w in
+          (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [Rose (node Red i (i + B.length word)) []])) (0, []) w in
       resultValue (runAssignment (many red) (makeState (Source s) nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) "" [], Out <$> w)
 
     it "matches one-or-more repetitions against one or more input nodes" $
-      resultValue (runAssignment (some red) (makeState "hello" [Rose (rec Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
+      resultValue (runAssignment (some red) (makeState "hello" [Rose (node Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
 
   describe "symbol" $ do
     it "matches nodes with the same symbol" $
-      snd <$> runAssignment red (makeState "hello" [Rose (rec Red 0 5) []]) `shouldBe` Result Nothing (Just (Out "hello"))
+      snd <$> runAssignment red (makeState "hello" [Rose (node Red 0 5) []]) `shouldBe` Result Nothing (Just (Out "hello"))
 
     it "does not advance past the current node" $
-      let initialState = makeState "hi" [ Rose (rec Red 0 2) [] ] in
+      let initialState = makeState "hi" [ Rose (node Red 0 2) [] ] in
       fst <$> runAssignment (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
 
   describe "source" $ do
     it "produces the node’s source" $
-      assign source "hi" (Rose (rec Red 0 2) []) `shouldBe` Result Nothing (Just "hi")
+      assign source "hi" (Rose (node Red 0 2) []) `shouldBe` Result Nothing (Just "hi")
 
     it "advances past the current node" $
-      fst <$> runAssignment source (makeState "hi" [ Rose (rec Red 0 2) [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
+      fst <$> runAssignment source (makeState "hi" [ Rose (node Red 0 2) [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
 
   describe "children" $ do
     it "advances past the current node" $
-      fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (rec Red 0 1) []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
+      fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (node Red 0 1) []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
 
     it "matches if its subrule matches" $
-      () <$ runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Red 0 1) []]]) `shouldBe` Result Nothing (Just ())
+      () <$ runAssignment (children red) (makeState "a" [Rose (node Blue 0 1) [Rose (node Red 0 1) []]]) `shouldBe` Result Nothing (Just ())
 
     it "does not match if its subrule does not match" $
-      (runAssignment (children red) (makeState "a" [Rose (rec Blue 0 1) [Rose (rec Green 0 1) []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
+      (runAssignment (children red) (makeState "a" [Rose (node Blue 0 1) [Rose (node Green 0 1) []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
 
     it "matches nested children" $
       runAssignment
         (symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
-        (makeState "1" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ] ] ])
+        (makeState "1" [ Rose (node Red 0 1) [ Rose (node Green 0 1) [ Rose (node Blue 0 1) [] ] ] ])
       `shouldBe`
         Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
 
@@ -65,31 +65,31 @@ spec = do
       resultValue (runAssignment
         (many (symbol Red *> children (symbol Green *> source)
            <|> symbol Blue *> source))
-        (makeState "BC" [ Rose (rec Red 0 1) [ Rose (rec Green 0 1) [] ]
-                        , Rose (rec Blue 1 2) [] ]))
+        (makeState "BC" [ Rose (node Red 0 1) [ Rose (node Green 0 1) [] ]
+                        , Rose (node Blue 1 2) [] ]))
       `shouldBe`
         Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["B", "C"])
 
     it "matches multiple nested children" $
       runAssignment
         (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
-        (makeState "12" [ Rose (rec Red 0 2) [ Rose (rec Green 0 1) [ Rose (rec Blue 0 1) [] ]
-                                             , Rose (rec Green 1 2) [ Rose (rec Blue 1 2) [] ] ] ])
+        (makeState "12" [ Rose (node Red 0 2) [ Rose (node Green 0 1) [ Rose (node Blue 0 1) [] ]
+                                              , Rose (node Green 1 2) [ Rose (node Blue 1 2) [] ] ] ])
       `shouldBe`
         Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
 
   describe "runAssignment" $ do
     it "drops anonymous nodes before matching symbols" $
-      runAssignment red (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
+      runAssignment red (makeState "magenta red" [Rose (node Magenta 0 7) [], Rose (node Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
 
     it "does not drop anonymous nodes after matching" $
-      runAssignment red (makeState "red magenta" [Rose (rec Red 0 3) [], Rose (rec Magenta 4 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (rec Magenta 4 11) []], Out "red"))
+      runAssignment red (makeState "red magenta" [Rose (node Red 0 3) [], Rose (node Magenta 4 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (node Magenta 4 11) []], Out "red"))
 
     it "does not drop anonymous nodes when requested" $
-      runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (rec Magenta 0 7) [], Rose (rec Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
+      runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (node Magenta 0 7) [], Rose (node Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
 
-rec :: symbol -> Int -> Int -> Record '[Maybe symbol, Range, SourceSpan]
-rec symbol start end = Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
+node :: symbol -> Int -> Int -> Record '[Maybe symbol, Range, SourceSpan]
+node symbol start end = Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
 
 data Grammar = Red | Green | Blue | Magenta
   deriving (Enum, Eq, Show)

From a66a76bb0149cfcf4b976ef72094767187a0ff2a Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:26:21 -0400
Subject: [PATCH 13/89] Construct the input AST using the node constructor.

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

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index 4f8f166c0..ab3c52169 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -14,50 +14,50 @@ spec :: Spec
 spec = do
   describe "Applicative" $
     it "matches in sequence" $
-      runAssignment ((,) <$> red <*> red) (makeState "helloworld" [Rose (node Red 0 5) [], Rose (node Red 5 10) []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
+      runAssignment ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
 
   describe "Alternative" $ do
     it "attempts multiple alternatives" $
-      runAssignment (green <|> red) (makeState "hello" [Rose (node Red 0 5) []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
+      runAssignment (green <|> red) (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
 
     it "matches repetitions" $
       let s = "colourless green ideas sleep furiously"
           w = words s
-          (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [Rose (node Red i (i + B.length word)) []])) (0, []) w in
+          (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
       resultValue (runAssignment (many red) (makeState (Source s) nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) "" [], Out <$> w)
 
     it "matches one-or-more repetitions against one or more input nodes" $
-      resultValue (runAssignment (some red) (makeState "hello" [Rose (node Red 0 5) []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
+      resultValue (runAssignment (some red) (makeState "hello" [node Red 0 5 []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
 
   describe "symbol" $ do
     it "matches nodes with the same symbol" $
-      snd <$> runAssignment red (makeState "hello" [Rose (node Red 0 5) []]) `shouldBe` Result Nothing (Just (Out "hello"))
+      snd <$> runAssignment red (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello"))
 
     it "does not advance past the current node" $
-      let initialState = makeState "hi" [ Rose (node Red 0 2) [] ] in
+      let initialState = makeState "hi" [ node Red 0 2 [] ] in
       fst <$> runAssignment (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
 
   describe "source" $ do
     it "produces the node’s source" $
-      assign source "hi" (Rose (node Red 0 2) []) `shouldBe` Result Nothing (Just "hi")
+      assign source "hi" (node Red 0 2 []) `shouldBe` Result Nothing (Just "hi")
 
     it "advances past the current node" $
-      fst <$> runAssignment source (makeState "hi" [ Rose (node Red 0 2) [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
+      fst <$> runAssignment source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
 
   describe "children" $ do
     it "advances past the current node" $
-      fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [Rose (node Red 0 1) []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
+      fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
 
     it "matches if its subrule matches" $
-      () <$ runAssignment (children red) (makeState "a" [Rose (node Blue 0 1) [Rose (node Red 0 1) []]]) `shouldBe` Result Nothing (Just ())
+      () <$ runAssignment (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Result Nothing (Just ())
 
     it "does not match if its subrule does not match" $
-      (runAssignment (children red) (makeState "a" [Rose (node Blue 0 1) [Rose (node Green 0 1) []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
+      (runAssignment (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
 
     it "matches nested children" $
       runAssignment
         (symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
-        (makeState "1" [ Rose (node Red 0 1) [ Rose (node Green 0 1) [ Rose (node Blue 0 1) [] ] ] ])
+        (makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
       `shouldBe`
         Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
 
@@ -65,31 +65,31 @@ spec = do
       resultValue (runAssignment
         (many (symbol Red *> children (symbol Green *> source)
            <|> symbol Blue *> source))
-        (makeState "BC" [ Rose (node Red 0 1) [ Rose (node Green 0 1) [] ]
-                        , Rose (node Blue 1 2) [] ]))
+        (makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ]
+                        , node Blue 1 2 [] ]))
       `shouldBe`
         Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["B", "C"])
 
     it "matches multiple nested children" $
       runAssignment
         (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
-        (makeState "12" [ Rose (node Red 0 2) [ Rose (node Green 0 1) [ Rose (node Blue 0 1) [] ]
-                                              , Rose (node Green 1 2) [ Rose (node Blue 1 2) [] ] ] ])
+        (makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
+                                       , node Green 1 2 [ node Blue 1 2 [] ] ] ])
       `shouldBe`
         Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
 
   describe "runAssignment" $ do
     it "drops anonymous nodes before matching symbols" $
-      runAssignment red (makeState "magenta red" [Rose (node Magenta 0 7) [], Rose (node Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
+      runAssignment red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
 
     it "does not drop anonymous nodes after matching" $
-      runAssignment red (makeState "red magenta" [Rose (node Red 0 3) [], Rose (node Magenta 4 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [Rose (node Magenta 4 11) []], Out "red"))
+      runAssignment red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [node Magenta 4 11 []], Out "red"))
 
     it "does not drop anonymous nodes when requested" $
-      runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [Rose (node Magenta 0 7) [], Rose (node Red 8 11) []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
+      runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
 
-node :: symbol -> Int -> Int -> Record '[Maybe symbol, Range, SourceSpan]
-node symbol start end = Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil
+node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol
+node symbol start end children = cofree $ (Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil) :< children
 
 data Grammar = Red | Green | Blue | Magenta
   deriving (Enum, Eq, Show)

From 84c15e3e658e61e95e8f5d7304875058e68c19ed Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:27:01 -0400
Subject: [PATCH 14/89] =?UTF-8?q?Don=E2=80=99t=20specify=20Node=20in=20the?=
 =?UTF-8?q?=20assignment=20spec.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index ab3c52169..c31d08895 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -101,14 +101,14 @@ instance Symbol Grammar where
 data Out = Out ByteString
   deriving (Eq, Show)
 
-red :: Assignment (Node Grammar) Out
+red :: Assignment Grammar Out
 red = Out <$ symbol Red <*> source
 
-green :: Assignment (Node Grammar) Out
+green :: Assignment Grammar Out
 green = Out <$ symbol Green <*> source
 
-blue :: Assignment (Node Grammar) Out
+blue :: Assignment Grammar Out
 blue = Out <$ symbol Blue <*> source
 
-magenta :: Assignment (Node Grammar) Out
+magenta :: Assignment Grammar Out
 magenta = Out <$ symbol Magenta <*> source

From c0763f7a239eaee401d188ccc71ed4fc5a301144 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:31:37 -0400
Subject: [PATCH 15/89] Redefine Location as just the list of fields.

---
 src/Data/Syntax/Assignment.hs | 12 ++---
 src/Language/Python/Syntax.hs | 95 ++++++++++++++++++-----------------
 src/Language/Ruby/Syntax.hs   | 43 ++++++++--------
 src/Parser.hs                 | 12 ++---
 4 files changed, 82 insertions(+), 80 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index f3dc4c262..fc8642e62 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies #-}
+{-# LANGUAGE DataKinds, GADTs, InstanceSigs, MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeFamilies, TypeOperators #-}
 -- | Assignment of AST onto some other structure (typically terms).
 --
 --   Parsing yields an AST represented as a Rose tree labelled with symbols in the language’s grammar and source locations (byte Range and SourceSpan). An Assignment represents a (partial) map from AST nodes onto some other structure; in essence, it’s a parser that operates over trees. (For our purposes, this structure is typically Terms annotated with source locations.) Assignments are able to match based on symbol, sequence, and hierarchy; thus, in @x = y@, both @x@ and @y@ might have the same symbol, @Identifier@, the left can be assigned to a variable declaration, while the right can be assigned to a variable reference.
@@ -102,7 +102,7 @@ import Text.Show hiding (show)
 type Assignment grammar = Freer (AssignmentF grammar)
 
 data AssignmentF grammar a where
-  Location :: HasCallStack => AssignmentF grammar Location
+  Location :: HasCallStack => AssignmentF grammar (Record Location)
   Source :: HasCallStack => AssignmentF grammar ByteString
   Children :: HasCallStack => Assignment grammar a -> AssignmentF grammar a
   Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF grammar a
@@ -114,13 +114,13 @@ data AssignmentF grammar a where
 -- | 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.
-location :: HasCallStack => Assignment grammar Location
+location :: HasCallStack => Assignment grammar (Record Location)
 location = Location `Then` return
 
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
 --   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 :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment grammar Location
+symbol :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment grammar (Record Location)
 symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
 
 -- | A rule to produce a node’s source as a ByteString.
@@ -133,10 +133,10 @@ children forEach = withFrozenCallStack $ Children forEach `Then` return
 
 
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
-type Location = Record '[Info.Range, Info.SourceSpan]
+type Location = '[Info.Range, Info.SourceSpan]
 
 -- | The label annotating a node in the AST, specified as the pairing of its symbol and location information.
-type Node grammar = Record '[Maybe grammar, Info.Range, Info.SourceSpan]
+type Node grammar = Record (Maybe grammar ': Location)
 
 -- | An abstract syntax tree in some 'grammar', with symbols and location information annotating each node.
 type AST grammar = Cofree [] (Node grammar)
diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index e03959d0a..5d27957cd 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -11,6 +11,7 @@ import Data.Align.Generic
 import Data.Functor.Classes.Eq.Generic
 import Data.Functor.Classes.Show.Generic
 import Data.Functor.Union
+import Data.Record
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment hiding (Error)
 import qualified Data.Syntax.Assignment as Assignment
@@ -80,13 +81,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
+assignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term Syntax Location)
+declaration :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+statement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -99,10 +100,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+expressionStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment Grammar (Term Syntax Location)
+expression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -122,13 +123,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment Grammar (Term Syntax Location)
+dottedName :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment Grammar (Term Syntax Location)
+ellipsis :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
+comparisonOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -143,26 +144,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
+notOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
+keywordIdentifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment Grammar (Term Syntax Location)
+tuple :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment Grammar (Term Syntax Location)
+expressionList :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
+unaryOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
+binaryOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -180,17 +181,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment Grammar (Term Syntax Location)
+booleanOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+assignment' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
+augmentedAssignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -205,56 +206,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment Grammar (Term Syntax Location)
+yield :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment Grammar (Term Syntax Location)
+rvalue :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
+identifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment Grammar (Term Syntax Location)
+literal :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment Grammar (Term Syntax Location)
+set :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment Grammar (Term Syntax Location)
+dictionary :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+list' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment Grammar (Term Syntax Location)
+string :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment Grammar (Term Syntax Location)
+concatenatedString :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment Grammar (Term Syntax Location)
+float :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment Grammar (Term Syntax Location)
+integer :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment Grammar (Term Syntax Location)
+comment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+import' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment Grammar (Term Syntax Location)
+importFrom :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+assertStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+printStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -265,47 +266,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+globalStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment Grammar (Term Syntax Location)
+await :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+returnStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+ifStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment Grammar (Term Syntax Location)
+memberAccess :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment Grammar (Term Syntax Location)
+subscript :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment Grammar (Term Syntax Location)
+call :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment Grammar (Term Syntax Location)
+boolean :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment Grammar (Term Syntax Location)
+none :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment Grammar (Term Syntax Location)
+lambda :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment Grammar (Term Syntax Location)
+comprehension :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -316,16 +317,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment Grammar (Term Syntax Location)
+conditionalExpression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
 makeTerm :: HasCallStack => InUnion Syntax' f => a -> f (Term Syntax a) -> Term Syntax a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax Location)
+emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term Syntax Location) -> Assignment Grammar (Term Syntax Location)
+handleError :: HasCallStack => Assignment Grammar (Term Syntax (Record Location)) -> Assignment Grammar (Term Syntax (Record Location))
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index bb21afa22..402fabb85 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -8,6 +8,7 @@ module Language.Ruby.Syntax
 ) where
 
 import Data.Functor.Union
+import Data.Record
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment hiding (Error)
 import qualified Data.Syntax.Assignment as Assignment
@@ -57,30 +58,30 @@ type Error = Assignment.Error Grammar
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment Grammar (Term Syntax Location)
+assignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term Syntax Location)
+declaration :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+class' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment Grammar (Term Syntax Location)
+constant :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment Grammar (Term Syntax Location)
+identifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment Grammar (Term Syntax Location)
+method :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment Grammar (Term Syntax Location)
+statements :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment Grammar (Term Syntax Location)
+statement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -95,36 +96,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment Grammar (Term Syntax Location)
+lvalue :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 lvalue = identifier
 
-expression :: HasCallStack => Assignment Grammar (Term Syntax Location)
+expression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment Grammar (Term Syntax Location)
+comment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+if' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment Grammar (Term Syntax Location)
+unless :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment Grammar (Term Syntax Location)
+while :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment Grammar (Term Syntax Location)
+until :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment Grammar (Term Syntax Location)
+for :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment Grammar (Term Syntax Location)
+assignment' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -142,23 +143,23 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment Grammar (Term Syntax Location)
+literal :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term (Union fs) Location) -> Assignment grammar (Term (Union fs) Location)
+invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term (Union fs) (Record Location)) -> Assignment grammar (Term (Union fs) (Record Location))
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax Location)
+emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term Syntax Location) -> Assignment Grammar (Term Syntax Location)
+handleError :: HasCallStack => Assignment Grammar (Term Syntax (Record Location)) -> Assignment Grammar (Term Syntax (Record Location))
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Parser.hs b/src/Parser.hs
index b1340bb57..af595db49 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -33,9 +33,9 @@ data Parser term where
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
   AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
-                   => Parser (AST grammar)                          -- ^ A parser producing 'AST'.
-                   -> Assignment grammar (Term (Union fs) Location) -- ^ An assignment from 'AST' onto 'Term's.
-                   -> Parser (Term (Union fs) Location)             -- ^ A parser of 'Term's.
+                   => Parser (AST grammar)                                   -- ^ A parser producing 'AST'.
+                   -> Assignment grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
+                   -> Parser (Term (Union fs) (Record Location))             -- ^ A parser of 'Term's.
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.
@@ -54,10 +54,10 @@ parserForLanguage (Just language) = case language of
   TypeScript -> TreeSitterParser TypeScript tree_sitter_typescript
   _ -> LineByLineParser
 
-rubyParser :: Parser (Term (Union Ruby.Syntax') Location)
+rubyParser :: Parser (Term (Union Ruby.Syntax') (Record Location))
 rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
 
-pythonParser :: Parser (Term (Union Python.Syntax') Location)
+pythonParser :: Parser (Term (Union Python.Syntax') (Record Location))
 pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
 
 runParser :: Parser term -> Source -> IO term
@@ -80,7 +80,7 @@ runParser parser = case parser of
   where showSGRCode = showString . setSGRCode
         withSGRCode code s = showSGRCode code . s . showSGRCode []
 
-errorTerm :: InUnion fs (Syntax.Error (Error grammar)) => Source -> Maybe (Error grammar) -> Term (Union fs) Location
+errorTerm :: InUnion fs (Syntax.Error (Error grammar)) => Source -> Maybe (Error grammar) -> Term (Union fs) (Record Location)
 errorTerm source err = cofree ((totalRange source :. totalSpan source :. Nil) :< inj (Syntax.Error (fromMaybe (Error (SourcePos 0 0) (UnexpectedEndOfInput [])) err)))
 
 termErrors :: (InUnion fs (Syntax.Error (Error grammar)), Functor (Union fs), Foldable (Union fs)) => Term (Union fs) a -> [Error grammar]

From a8bf5b5e71fffecf30475fbe2f25cd0f8c99f7a4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:34:32 -0400
Subject: [PATCH 16/89] Redefine the Syntax type synonyms as just the list of
 type constructors.

---
 src/Language/Python/Syntax.hs | 100 +++++++++++++++++-----------------
 src/Language/Ruby/Syntax.hs   |  44 +++++++--------
 src/Parser.hs                 |   4 +-
 3 files changed, 72 insertions(+), 76 deletions(-)

diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index 5d27957cd..20ce8655b 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -2,7 +2,6 @@
 module Language.Python.Syntax
 ( assignment
 , Syntax
-, Syntax'
 , Grammar
 , Error
 ) where
@@ -26,8 +25,7 @@ import Language.Python.Grammar as Grammar
 import Prologue hiding (Location)
 import Term
 
-type Syntax = Union Syntax'
-type Syntax' =
+type Syntax =
   '[ Comment.Comment
    , Declaration.Comprehension
    , Declaration.Function
@@ -81,13 +79,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+assignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+declaration :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+statement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -100,10 +98,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+expressionStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+expression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -123,13 +121,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+dottedName :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+ellipsis :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+comparisonOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -144,26 +142,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+notOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+keywordIdentifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+tuple :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+expressionList :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+unaryOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+binaryOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -181,17 +179,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+booleanOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+assignment' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+augmentedAssignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -206,56 +204,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+yield :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+rvalue :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+identifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+literal :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+set :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+dictionary :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+list' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+string :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+concatenatedString :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+float :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+integer :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+comment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+import' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+importFrom :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+assertStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+printStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -266,47 +264,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+globalStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+await :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+returnStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+ifStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+memberAccess :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+subscript :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+call :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+boolean :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+none :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+lambda :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+comprehension :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -317,16 +315,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+conditionalExpression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
-makeTerm :: HasCallStack => InUnion Syntax' f => a -> f (Term Syntax a) -> Term Syntax a
+makeTerm :: (HasCallStack, InUnion fs f) => a -> f (Term (Union fs) a) -> Term (Union fs) a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+emptyTerm :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term Syntax (Record Location)) -> Assignment Grammar (Term Syntax (Record Location))
+handleError :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location)) -> Assignment Grammar (Term (Union Syntax) (Record Location))
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 402fabb85..2220abe72 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -2,7 +2,6 @@
 module Language.Ruby.Syntax
 ( assignment
 , Syntax
-, Syntax'
 , Grammar
 , Error
 ) where
@@ -23,8 +22,7 @@ import Prologue hiding (for, get, Location, state, unless)
 import Term
 
 -- | The type of Ruby syntax.
-type Syntax = Union Syntax'
-type Syntax' =
+type Syntax =
   '[Comment.Comment
   , Declaration.Class
   , Declaration.Method
@@ -58,30 +56,30 @@ type Error = Assignment.Error Grammar
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+assignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+declaration :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+class' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+constant :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+identifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+method :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+statements :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+statement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -96,36 +94,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+lvalue :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 lvalue = identifier
 
-expression :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+expression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+comment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+if' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+unless :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+while :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+until :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+for :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+assignment' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -143,7 +141,7 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+literal :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
@@ -156,10 +154,10 @@ invert term = makeTerm <$> location <*> fmap Expression.Not term
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term Syntax (Record Location))
+emptyTerm :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term Syntax (Record Location)) -> Assignment Grammar (Term Syntax (Record Location))
+handleError :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location)) -> Assignment Grammar (Term (Union Syntax) (Record Location))
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Parser.hs b/src/Parser.hs
index af595db49..58ba8d712 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -54,10 +54,10 @@ parserForLanguage (Just language) = case language of
   TypeScript -> TreeSitterParser TypeScript tree_sitter_typescript
   _ -> LineByLineParser
 
-rubyParser :: Parser (Term (Union Ruby.Syntax') (Record Location))
+rubyParser :: Parser (Term (Union Ruby.Syntax) (Record Location))
 rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
 
-pythonParser :: Parser (Term (Union Python.Syntax') (Record Location))
+pythonParser :: Parser (Term (Union Python.Syntax) (Record Location))
 pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
 
 runParser :: Parser term -> Source -> IO term

From 156fa1723c3b8a7511c06d65a9c22a5907bb951f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:51:08 -0400
Subject: [PATCH 17/89] :fire: Node.

---
 src/Data/Syntax/Assignment.hs | 6 +-----
 src/TreeSitter.hs             | 2 +-
 2 files changed, 2 insertions(+), 6 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index fc8642e62..2c4735745 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -66,7 +66,6 @@ module Data.Syntax.Assignment
 , symbol
 , source
 , children
-, Node
 , AST
 , Result(..)
 , Error(..)
@@ -135,11 +134,8 @@ children forEach = withFrozenCallStack $ Children forEach `Then` return
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = '[Info.Range, Info.SourceSpan]
 
--- | The label annotating a node in the AST, specified as the pairing of its symbol and location information.
-type Node grammar = Record (Maybe grammar ': Location)
-
 -- | An abstract syntax tree in some 'grammar', with symbols and location information annotating each node.
-type AST grammar = Cofree [] (Node grammar)
+type AST grammar = Cofree [] (Record (Maybe grammar ': Location))
 
 
 -- | The result of assignment, possibly containing an error.
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index 02ab8748b..73258583f 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -54,7 +54,7 @@ parseToAST language source = bracket ts_document_new ts_document_free $ \ docume
 
   anaM toAST root
 
-toAST :: (Bounded grammar, Enum grammar) => Node -> IO (CofreeF [] (A.Node grammar) Node)
+toAST :: (Bounded grammar, Enum grammar) => Node -> IO (Base (A.AST grammar) Node)
 toAST node@Node{..} = do
   let count = fromIntegral nodeChildCount
   children <- allocaArray count $ \ childNodesPtr -> do

From 698b0ac5fe39b084bd4bbd876da99b262bc9de49 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 14:55:23 -0400
Subject: [PATCH 18/89] Use the Location synonym more widely.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 2c4735745..13b4b7c4d 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -193,10 +193,10 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
 assign = assignBy (rhead . headF)
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
 assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> pure (a, state)
@@ -204,7 +204,7 @@ assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
+runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
 runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
   where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (a, AssignmentState node)) -> AssignmentState node -> Result grammar (a, AssignmentState node)
         run assignment yield initialState = case (assignment, stateNodes) of
@@ -231,7 +231,7 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
                   _ -> []
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
-dropAnonymous :: Symbol grammar => (forall x. CofreeF [] (Record '[ node, Info.Range, Info.SourceSpan ]) x -> Maybe grammar) -> AssignmentState node -> AssignmentState node
+dropAnonymous :: Symbol grammar => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> AssignmentState node -> AssignmentState node
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
@@ -245,11 +245,11 @@ data AssignmentState node = AssignmentState
   { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
   , statePos :: Info.SourcePos -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
-  , stateNodes :: [Cofree [] (Record '[ node, Info.Range, Info.SourceSpan ])] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
+  , stateNodes :: [Cofree [] (Record (node ': Location))] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [Cofree [] (Record '[ node, Info.Range, Info.SourceSpan ])] -> AssignmentState node
+makeState :: Source.Source -> [Cofree [] (Record (node ': Location))] -> AssignmentState node
 makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 

From f7c1992db1bbb707cd7cf1d95f384a82e023240b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:01:24 -0400
Subject: [PATCH 19/89] Parameterize AssignmentState by the term type.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 13b4b7c4d..9fe50e3d6 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -196,7 +196,7 @@ assign = assignBy (rhead . headF)
 assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
 assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> pure (a, state)
@@ -204,9 +204,9 @@ assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState node -> Result grammar (a, AssignmentState node)
+runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
 runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState node -> Result grammar (a, AssignmentState node)) -> AssignmentState node -> Result grammar (a, AssignmentState node)
+  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))) -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (extract node)) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
@@ -231,25 +231,25 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
                   _ -> []
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
-dropAnonymous :: Symbol grammar => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> AssignmentState node -> AssignmentState node
+dropAnonymous :: Symbol grammar => (forall x. CofreeF f a x -> Maybe grammar) -> AssignmentState (Cofree f a) -> AssignmentState (Cofree f a)
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: AssignmentState node -> AssignmentState node
+advanceState :: AssignmentState (Cofree [] (Record (node ': Location))) -> AssignmentState (Cofree [] (Record (node ': Location)))
 advanceState state@AssignmentState{..}
   | node : rest <- stateNodes, (_ :. range :. span :. _) :< _ <- runCofree node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
-data AssignmentState node = AssignmentState
+data AssignmentState term = AssignmentState
   { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
   , statePos :: Info.SourcePos -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
-  , stateNodes :: [Cofree [] (Record (node ': Location))] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
+  , stateNodes :: [term] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [Cofree [] (Record (node ': Location))] -> AssignmentState node
+makeState :: Source.Source -> [Cofree [] (Record (node ': Location))] -> AssignmentState (Cofree [] (Record (node ': Location)))
 makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 

From 9d4fb0920b070ce09f43fcc9cf8406c48f564cef Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:01:52 -0400
Subject: [PATCH 20/89] Generalize advanceState over the syntax functor.

---
 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 9fe50e3d6..9baea72e4 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -235,7 +235,7 @@ dropAnonymous :: Symbol grammar => (forall x. CofreeF f a x -> Maybe grammar) ->
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: AssignmentState (Cofree [] (Record (node ': Location))) -> AssignmentState (Cofree [] (Record (node ': Location)))
+advanceState :: AssignmentState (Cofree f (Record (node ': Location))) -> AssignmentState (Cofree f (Record (node ': Location)))
 advanceState state@AssignmentState{..}
   | node : rest <- stateNodes, (_ :. range :. span :. _) :< _ <- runCofree node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state

From 360ef63ab42bb851d96e965e11c94ded32232bb7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:02:20 -0400
Subject: [PATCH 21/89] Generalize makeState to arbitrary term types.

---
 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 9baea72e4..0b5b3dac3 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -249,7 +249,7 @@ data AssignmentState term = AssignmentState
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [Cofree [] (Record (node ': Location))] -> AssignmentState (Cofree [] (Record (node ': Location)))
+makeState :: Source.Source -> [term] -> AssignmentState term
 makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 

From 407f68faaccb357847ba0b1f759c74b5d342b4ec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:03:36 -0400
Subject: [PATCH 22/89] =?UTF-8?q?Simplify=20advanceState=E2=80=99s=20selec?=
 =?UTF-8?q?tion=20of=20the=20record.?=
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 0b5b3dac3..3c27ebfe0 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -235,9 +235,9 @@ dropAnonymous :: Symbol grammar => (forall x. CofreeF f a x -> Maybe grammar) ->
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: AssignmentState (Cofree f (Record (node ': Location))) -> AssignmentState (Cofree f (Record (node ': Location)))
+advanceState :: Functor f => AssignmentState (Cofree f (Record (node ': Location))) -> AssignmentState (Cofree f (Record (node ': Location)))
 advanceState state@AssignmentState{..}
-  | node : rest <- stateNodes, (_ :. range :. span :. _) :< _ <- runCofree node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
+  | node : rest <- stateNodes, _ :. range :. span :. _ <- extract node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.

From d3e411729549cc1d885f5491f6095f29dc4c7b69 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:08:37 -0400
Subject: [PATCH 23/89] Generalize runAssignment &c. over the record fields.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 3c27ebfe0..a05ebc915 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -193,10 +193,10 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
 assign = assignBy (rhead . headF)
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record '[node, Info.Range, Info.SourceSpan]) -> Result grammar a
+assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record fields) -> Result grammar a
 assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
+assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> pure (a, state)
@@ -204,13 +204,13 @@ assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar node a. (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record (node ': Location)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
+runAssignment :: forall grammar fields a. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
 runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))) -> AssignmentState (Cofree [] (Record (node ': Location))) -> Result grammar (a, AssignmentState (Cofree [] (Record (node ': Location))))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))) -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
         run assignment yield initialState = case (assignment, stateNodes) of
-          (Location, node : _) -> yield (rtail (extract node)) state
+          (Location, node : _) -> yield (Info.byteRange (extract node) :. Info.sourceSpan (extract node) :. Nil) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (rtail (extract node))) (negate stateOffset)) stateSource)) (advanceState state)
+          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
           (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = unwrap node } of
             Result _ (Just (a, state')) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
@@ -222,7 +222,7 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
             Result _ (Just (a, state')) -> pure (a, state')
             Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (rtail (extract node)) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (runCofree node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (runCofree node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
                   _ -> initialState
@@ -235,9 +235,11 @@ dropAnonymous :: Symbol grammar => (forall x. CofreeF f a x -> Maybe grammar) ->
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: Functor f => AssignmentState (Cofree f (Record (node ': Location))) -> AssignmentState (Cofree f (Record (node ': Location)))
+advanceState :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Functor f) => AssignmentState (Cofree f (Record fields)) -> AssignmentState (Cofree f (Record fields))
 advanceState state@AssignmentState{..}
-  | node : rest <- stateNodes, _ :. range :. span :. _ <- extract node = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
+  | node : rest <- stateNodes
+  , range <- Info.byteRange (extract node)
+  , span <- Info.sourceSpan (extract node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.

From 59b671a1446b1eeece18b764329dd1757563a664 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:09:47 -0400
Subject: [PATCH 24/89] Generalize dropAnonymous to Recursive functors.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index a05ebc915..9f5dab794 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -81,6 +81,7 @@ module Data.Syntax.Assignment
 import Control.Monad.Free.Freer
 import Data.ByteString (isSuffixOf)
 import Data.Functor.Classes
+import Data.Functor.Foldable hiding (Nil)
 import qualified Data.IntMap.Lazy as IntMap
 import Data.Ix (inRange)
 import Data.List.NonEmpty (nonEmpty)
@@ -231,8 +232,8 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
                   _ -> []
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
-dropAnonymous :: Symbol grammar => (forall x. CofreeF f a x -> Maybe grammar) -> AssignmentState (Cofree f a) -> AssignmentState (Cofree f a)
-dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . runCofree) (stateNodes state) }
+dropAnonymous :: (Symbol grammar, Recursive term) => (forall x. Base term x -> Maybe grammar) -> AssignmentState term -> AssignmentState term
+dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . project) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
 advanceState :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Functor f) => AssignmentState (Cofree f (Record fields)) -> AssignmentState (Cofree f (Record fields))

From bc4284c8a6b007daa8217746d9dda18ffe6476fc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:16:26 -0400
Subject: [PATCH 25/89] Generalize runAssignment &c. to Traversable syntax
 functors.

---
 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 9f5dab794..309e50db8 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -191,13 +191,13 @@ showSourcePos :: Maybe FilePath -> Info.SourcePos -> ShowS
 showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows line . showChar ':' . shows column
 
 -- | Run an assignment over an AST exhaustively.
-assign :: (Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => Assignment grammar a -> Source.Source -> AST grammar -> Result grammar a
-assign = assignBy (rhead . headF)
+assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
+assign = assignBy (getField . headF)
 
-assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree [] (Record fields) -> Result grammar a
+assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
 assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
+assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> pure (a, state)
@@ -205,14 +205,14 @@ assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar fields a. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, HasCallStack) => (forall x. CofreeF [] (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
+runAssignment :: forall grammar fields f a. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
 runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))) -> AssignmentState (Cofree [] (Record fields)) -> Result grammar (a, AssignmentState (Cofree [] (Record fields)))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))) -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (Info.byteRange (extract node) :. Info.sourceSpan (extract node) :. Nil) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
-          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = unwrap node } of
+          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = toList (unwrap node) } of
             Result _ (Just (a, state')) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
           (Choose choices, node : _) | Just symbol <- toSymbol (runCofree node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state

From 549d85a84d3c98533fd067d16cd28a8435707ea2 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:19:32 -0400
Subject: [PATCH 26/89] :fire: the AST type synonym.

---
 src/Data/Syntax/Assignment.hs | 5 -----
 src/Parser.hs                 | 8 ++++----
 src/TreeSitter.hs             | 6 +++---
 3 files changed, 7 insertions(+), 12 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 309e50db8..9cc80cb10 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -66,7 +66,6 @@ module Data.Syntax.Assignment
 , symbol
 , source
 , children
-, AST
 , Result(..)
 , Error(..)
 , ErrorCause(..)
@@ -135,10 +134,6 @@ children forEach = withFrozenCallStack $ Children forEach `Then` return
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = '[Info.Range, Info.SourceSpan]
 
--- | An abstract syntax tree in some 'grammar', with symbols and location information annotating each node.
-type AST grammar = Cofree [] (Record (Maybe grammar ': Location))
-
-
 -- | The result of assignment, possibly containing an error.
 data Result grammar a = Result { resultError :: Maybe (Error grammar), resultValue :: Maybe a }
   deriving (Eq, Foldable, Functor, Traversable)
diff --git a/src/Parser.hs b/src/Parser.hs
index 58ba8d712..1c4ff1485 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GADTs, ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeOperators #-}
 module Parser where
 
 import Data.Functor.Union
@@ -30,10 +30,10 @@ import TreeSitter
 -- | A parser from 'Source' onto some term type.
 data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
-  ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (AST grammar)
+  ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (Cofree [] (Record (Maybe grammar ': Location)))
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
-                   => Parser (AST grammar)                                   -- ^ A parser producing 'AST'.
+  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs), Traversable f)
+                   => Parser (Cofree f (Record (Maybe grammar ': Location))) -- ^ A parser producing 'AST'.
                    -> Assignment grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
                    -> Parser (Term (Union fs) (Record Location))             -- ^ A parser of 'Term's.
   -- | A tree-sitter parser.
diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs
index 73258583f..4786bdc30 100644
--- a/src/TreeSitter.hs
+++ b/src/TreeSitter.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, ScopedTypeVariables #-}
+{-# LANGUAGE DataKinds, ScopedTypeVariables, TypeOperators #-}
 module TreeSitter
 ( treeSitterParser
 , parseToAST
@@ -42,7 +42,7 @@ treeSitterParser language grammar source = bracket ts_document_new ts_document_f
 
 
 -- | Parse 'Source' with the given 'TS.Language' and return its AST.
-parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Source -> IO (A.AST grammar)
+parseToAST :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Source -> IO (Cofree [] (Record (Maybe grammar ': A.Location)))
 parseToAST language source = bracket ts_document_new ts_document_free $ \ document -> do
   ts_document_set_language document language
   root <- withCStringLen (toText source) $ \ (source, len) -> do
@@ -54,7 +54,7 @@ parseToAST language source = bracket ts_document_new ts_document_free $ \ docume
 
   anaM toAST root
 
-toAST :: (Bounded grammar, Enum grammar) => Node -> IO (Base (A.AST grammar) Node)
+toAST :: (Bounded grammar, Enum grammar) => Node -> IO (CofreeF [] (Record (Maybe grammar ': A.Location)) Node)
 toAST node@Node{..} = do
   let count = fromIntegral nodeChildCount
   children <- allocaArray count $ \ childNodesPtr -> do

From a8ff3bb588b8400037845f10dbb5449bdcaf97a8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:29:03 -0400
Subject: [PATCH 27/89] Generalize to arbitrary comonads.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 9cc80cb10..d8d957dfb 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -189,28 +189,28 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
 assign = assignBy (getField . headF)
 
-assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
+assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> w (Record fields) -> Result grammar a
 assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
 
-assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
+assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
 assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
     [] -> pure (a, state)
-    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (runCofree node))))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (project node))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar fields f a. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => (forall x. CofreeF f (Record fields) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
+runAssignment :: forall grammar fields a w. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
 runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))) -> AssignmentState (Cofree f (Record fields)) -> Result grammar (a, AssignmentState (Cofree f (Record fields)))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))) -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (Info.byteRange (extract node) :. Info.sourceSpan (extract node) :. Nil) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
           (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
-          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = toList (unwrap node) } of
+          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = toList (project node) } of
             Result _ (Just (a, state')) -> yield a (advanceState state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, node : _) | Just symbol <- toSymbol (runCofree node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | Just symbol <- toSymbol (project node), 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -218,7 +218,7 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
             Result _ (Just (a, state')) -> pure (a, state')
             Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (runCofree node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (project node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
                   _ -> initialState
@@ -231,7 +231,7 @@ dropAnonymous :: (Symbol grammar, Recursive term) => (forall x. Base term x -> M
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . project) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Functor f) => AssignmentState (Cofree f (Record fields)) -> AssignmentState (Cofree f (Record fields))
+advanceState :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Comonad w) => AssignmentState (w (Record fields)) -> AssignmentState (w (Record fields))
 advanceState state@AssignmentState{..}
   | node : rest <- stateNodes
   , range <- Info.byteRange (extract node)

From 0599ae2286a37c8a2d1a0439528d95f06d046649 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:43:21 -0400
Subject: [PATCH 28/89] Extend the projection function to return the location
 as well.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index d8d957dfb..81d92a34d 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -187,30 +187,30 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 
 -- | Run an assignment over an AST exhaustively.
 assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
-assign = assignBy (getField . headF)
+assign = assignBy (\ (r :< _) -> getField r :. getField r :. getField r :. Nil)
 
-assignBy :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> Source.Source -> w (Record fields) -> Result grammar a
-assignBy toSymbol assignment source = fmap fst . assignAllFrom toSymbol assignment . makeState source . pure
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> Source.Source -> term -> Result grammar a
+assignBy toRecord assignment source = fmap fst . assignAllFrom toRecord assignment . makeState source . pure
 
-assignAllFrom :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
-assignAllFrom toSymbol assignment state = case runAssignment toSymbol assignment state of
-  Result err (Just (a, state)) -> case stateNodes (dropAnonymous toSymbol state) of
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState term -> Result grammar (a, AssignmentState term)
+assignAllFrom toRecord assignment state = case runAssignment toRecord assignment state of
+  Result err (Just (a, state)) -> case stateNodes (dropAnonymous (rhead . toRecord) state) of
     [] -> pure (a, state)
-    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (toSymbol (project node))))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (rhead (toRecord (project node)))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar fields a w. (HasField fields Info.Range, HasField fields Info.SourceSpan, Symbol grammar, Enum grammar, Eq grammar, Comonad w, Recursive (w (Record fields)), Foldable (Base (w (Record fields))), HasCallStack) => (forall x. Base (w (Record fields)) x -> Maybe grammar) -> Assignment grammar a -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
-runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))) -> AssignmentState (w (Record fields)) -> Result grammar (a, AssignmentState (w (Record fields)))
+runAssignment :: forall grammar a term. (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState term -> Result grammar (a, AssignmentState term)
+runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
+  where run :: AssignmentF grammar x -> (x -> AssignmentState term -> Result grammar (a, AssignmentState term)) -> AssignmentState term -> Result grammar (a, AssignmentState term)
         run assignment yield initialState = case (assignment, stateNodes) of
-          (Location, node : _) -> yield (Info.byteRange (extract node) :. Info.sourceSpan (extract node) :. Nil) state
+          (Location, node : _) -> yield (rtail (toRecord (project node))) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (extract node)) (negate stateOffset)) stateSource)) (advanceState state)
-          (Children childAssignment, node : _) -> case assignAllFrom toSymbol childAssignment state { stateNodes = toList (project node) } of
-            Result _ (Just (a, state')) -> yield a (advanceState state' { stateNodes = stateNodes })
+          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (toRecord (project node))) (negate stateOffset)) stateSource)) (advanceState (rtail . toRecord) state)
+          (Children childAssignment, node : _) -> case assignAllFrom toRecord childAssignment state { stateNodes = toList (project node) } of
+            Result _ (Just (a, state')) -> yield a (advanceState (rtail . toRecord) state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, node : _) | Just symbol <- toSymbol (project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | Just symbol :. _ <- toRecord (project node), 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -218,9 +218,9 @@ runAssignment toSymbol = iterFreer run . fmap ((pure .) . (,))
             Result _ (Just (a, state')) -> pure (a, state')
             Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (extract node) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> toSymbol (project node) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (toRecord (project node)) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> rhead (toRecord (project node)) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
           where state@AssignmentState{..} = case assignment of
-                  Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous toSymbol initialState
+                  Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous (rhead . toRecord) initialState
                   _ -> initialState
                 expectedSymbols = case assignment of
                   Choose choices -> choiceSymbols choices
@@ -231,11 +231,10 @@ dropAnonymous :: (Symbol grammar, Recursive term) => (forall x. Base term x -> M
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . project) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: (HasField fields Info.Range, HasField fields Info.SourceSpan, Comonad w) => AssignmentState (w (Record fields)) -> AssignmentState (w (Record fields))
-advanceState state@AssignmentState{..}
+advanceState :: Recursive term => (forall x. Base term x -> Record Location) -> AssignmentState term -> AssignmentState term
+advanceState toLocation state@AssignmentState{..}
   | node : rest <- stateNodes
-  , range <- Info.byteRange (extract node)
-  , span <- Info.sourceSpan (extract node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
+  , range :. span :. Nil <- toLocation (project node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.

From 4b4e6871b4703c390342af859800aaedab3fb756 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:44:43 -0400
Subject: [PATCH 29/89] Rename the term parameter to ast.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 81d92a34d..e0f6b4aa8 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -189,10 +189,10 @@ showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "inter
 assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
 assign = assignBy (\ (r :< _) -> getField r :. getField r :. getField r :. Nil)
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> Source.Source -> term -> Result grammar a
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> Source.Source -> ast -> Result grammar a
 assignBy toRecord assignment source = fmap fst . assignAllFrom toRecord assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState term -> Result grammar (a, AssignmentState term)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
 assignAllFrom toRecord assignment state = case runAssignment toRecord assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous (rhead . toRecord) state) of
     [] -> pure (a, state)
@@ -200,9 +200,9 @@ assignAllFrom toRecord assignment state = case runAssignment toRecord assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar a term. (Symbol grammar, Enum grammar, Eq grammar, Recursive term, Foldable (Base term), HasCallStack) => (forall x. Base term x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState term -> Result grammar (a, AssignmentState term)
+runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
 runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState term -> Result grammar (a, AssignmentState term)) -> AssignmentState term -> Result grammar (a, AssignmentState term)
+  where run :: AssignmentF grammar x -> (x -> AssignmentState ast -> Result grammar (a, AssignmentState ast)) -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (toRecord (project node))) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
@@ -227,26 +227,26 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
                   _ -> []
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
-dropAnonymous :: (Symbol grammar, Recursive term) => (forall x. Base term x -> Maybe grammar) -> AssignmentState term -> AssignmentState term
+dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Maybe grammar) -> AssignmentState ast -> AssignmentState ast
 dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . project) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
-advanceState :: Recursive term => (forall x. Base term x -> Record Location) -> AssignmentState term -> AssignmentState term
+advanceState :: Recursive ast => (forall x. Base ast x -> Record Location) -> AssignmentState ast -> AssignmentState ast
 advanceState toLocation state@AssignmentState{..}
   | node : rest <- stateNodes
   , range :. span :. Nil <- toLocation (project node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
-data AssignmentState term = AssignmentState
+data AssignmentState ast = AssignmentState
   { stateOffset :: Int -- ^ The offset into the Source thus far reached, measured in bytes.
   , statePos :: Info.SourcePos -- ^ The (1-indexed) line/column position in the Source thus far reached.
   , stateSource :: Source.Source -- ^ The remaining Source. Equal to dropping 'stateOffset' bytes off the original input Source.
-  , stateNodes :: [term] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
+  , stateNodes :: [ast] -- ^ The remaining nodes to assign. Note that 'children' rules recur into subterms, and thus this does not necessarily reflect all of the terms remaining to be assigned in the overall algorithm, only those “in scope.”
   }
   deriving (Eq, Show)
 
-makeState :: Source.Source -> [term] -> AssignmentState term
+makeState :: Source.Source -> [ast] -> AssignmentState ast
 makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 

From 845e0fa8d6f15fb1bbb82637357ba210f5b741b4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:53:36 -0400
Subject: [PATCH 30/89] Export Term type synonyms from Ruby and Python.

---
 src/Language/Python/Syntax.hs | 100 +++++++++++++++++-----------------
 src/Language/Ruby/Syntax.hs   |  48 ++++++++--------
 src/Parser.hs                 |   4 +-
 3 files changed, 78 insertions(+), 74 deletions(-)

diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index 20ce8655b..b56345f5e 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -4,6 +4,7 @@ module Language.Python.Syntax
 , Syntax
 , Grammar
 , Error
+, Term
 ) where
 
 import Data.Align.Generic
@@ -23,7 +24,7 @@ import GHC.Generics
 import GHC.Stack
 import Language.Python.Grammar as Grammar
 import Prologue hiding (Location)
-import Term
+import qualified Term
 
 type Syntax =
   '[ Comment.Comment
@@ -63,6 +64,7 @@ type Syntax =
    ]
 
 type Error = Assignment.Error Grammar
+type Term = Term.Term (Union Syntax) (Record Location)
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
@@ -79,13 +81,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+assignment :: HasCallStack => Assignment Grammar Term
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+declaration :: HasCallStack => Assignment Grammar Term
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+statement :: HasCallStack => Assignment Grammar Term
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -98,10 +100,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+expressionStatement :: HasCallStack => Assignment Grammar Term
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+expression :: HasCallStack => Assignment Grammar Term
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -121,13 +123,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+dottedName :: HasCallStack => Assignment Grammar Term
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+ellipsis :: HasCallStack => Assignment Grammar Term
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+comparisonOperator :: HasCallStack => Assignment Grammar Term
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -142,26 +144,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+notOperator :: HasCallStack => Assignment Grammar Term
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+keywordIdentifier :: HasCallStack => Assignment Grammar Term
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+tuple :: HasCallStack => Assignment Grammar Term
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+expressionList :: HasCallStack => Assignment Grammar Term
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+unaryOperator :: HasCallStack => Assignment Grammar Term
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+binaryOperator :: HasCallStack => Assignment Grammar Term
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -179,17 +181,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+booleanOperator :: HasCallStack => Assignment Grammar Term
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+assignment' :: HasCallStack => Assignment Grammar Term
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+augmentedAssignment :: HasCallStack => Assignment Grammar Term
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -204,56 +206,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+yield :: HasCallStack => Assignment Grammar Term
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+rvalue :: HasCallStack => Assignment Grammar Term
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+identifier :: HasCallStack => Assignment Grammar Term
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+literal :: HasCallStack => Assignment Grammar Term
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+set :: HasCallStack => Assignment Grammar Term
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+dictionary :: HasCallStack => Assignment Grammar Term
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+list' :: HasCallStack => Assignment Grammar Term
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+string :: HasCallStack => Assignment Grammar Term
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+concatenatedString :: HasCallStack => Assignment Grammar Term
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+float :: HasCallStack => Assignment Grammar Term
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+integer :: HasCallStack => Assignment Grammar Term
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+comment :: HasCallStack => Assignment Grammar Term
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+import' :: HasCallStack => Assignment Grammar Term
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+importFrom :: HasCallStack => Assignment Grammar Term
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+assertStatement :: HasCallStack => Assignment Grammar Term
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+printStatement :: HasCallStack => Assignment Grammar Term
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -264,47 +266,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+globalStatement :: HasCallStack => Assignment Grammar Term
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+await :: HasCallStack => Assignment Grammar Term
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+returnStatement :: HasCallStack => Assignment Grammar Term
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+ifStatement :: HasCallStack => Assignment Grammar Term
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+memberAccess :: HasCallStack => Assignment Grammar Term
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+subscript :: HasCallStack => Assignment Grammar Term
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+call :: HasCallStack => Assignment Grammar Term
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+boolean :: HasCallStack => Assignment Grammar Term
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+none :: HasCallStack => Assignment Grammar Term
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+lambda :: HasCallStack => Assignment Grammar Term
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+comprehension :: HasCallStack => Assignment Grammar Term
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -315,16 +317,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+conditionalExpression :: HasCallStack => Assignment Grammar Term
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
-makeTerm :: (HasCallStack, InUnion fs f) => a -> f (Term (Union fs) a) -> Term (Union fs) a
+makeTerm :: (HasCallStack, InUnion fs f) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+emptyTerm :: HasCallStack => Assignment Grammar Term
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location)) -> Assignment Grammar (Term (Union Syntax) (Record Location))
+handleError :: HasCallStack => Assignment Grammar Term -> Assignment Grammar Term
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 2220abe72..8e1efc82c 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -4,6 +4,7 @@ module Language.Ruby.Syntax
 , Syntax
 , Grammar
 , Error
+, Term
 ) where
 
 import Data.Functor.Union
@@ -19,7 +20,7 @@ import qualified Data.Syntax.Statement as Statement
 import GHC.Stack
 import Language.Ruby.Grammar as Grammar
 import Prologue hiding (for, get, Location, state, unless)
-import Term
+import qualified Term
 
 -- | The type of Ruby syntax.
 type Syntax =
@@ -53,33 +54,34 @@ type Syntax =
   ]
 
 type Error = Assignment.Error Grammar
+type Term = Term.Term (Union Syntax) (Record Location)
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+assignment :: HasCallStack => Assignment Grammar Term
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+declaration :: HasCallStack => Assignment Grammar Term
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+class' :: HasCallStack => Assignment Grammar Term
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+constant :: HasCallStack => Assignment Grammar Term
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+identifier :: HasCallStack => Assignment Grammar Term
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+method :: HasCallStack => Assignment Grammar Term
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+statements :: HasCallStack => Assignment Grammar Term
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+statement :: HasCallStack => Assignment Grammar Term
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -94,36 +96,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+lvalue :: HasCallStack => Assignment Grammar Term
 lvalue = identifier
 
-expression :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+expression :: HasCallStack => Assignment Grammar Term
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+comment :: HasCallStack => Assignment Grammar Term
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+if' :: HasCallStack => Assignment Grammar Term
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+unless :: HasCallStack => Assignment Grammar Term
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+while :: HasCallStack => Assignment Grammar Term
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+until :: HasCallStack => Assignment Grammar Term
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+for :: HasCallStack => Assignment Grammar Term
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+assignment' :: HasCallStack => Assignment Grammar Term
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -141,23 +143,23 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+literal :: HasCallStack => Assignment Grammar Term
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term (Union fs) (Record Location)) -> Assignment grammar (Term (Union fs) (Record Location))
+invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term.Term (Union fs) (Record Location)) -> Assignment grammar (Term.Term (Union fs) (Record Location))
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
-makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term (Union fs) a) -> (Term (Union fs) a)
+makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location))
+emptyTerm :: HasCallStack => Assignment Grammar Term
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar (Term (Union Syntax) (Record Location)) -> Assignment Grammar (Term (Union Syntax) (Record Location))
+handleError :: HasCallStack => Assignment Grammar Term -> Assignment Grammar Term
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Parser.hs b/src/Parser.hs
index 1c4ff1485..e79a91bc9 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -54,10 +54,10 @@ parserForLanguage (Just language) = case language of
   TypeScript -> TreeSitterParser TypeScript tree_sitter_typescript
   _ -> LineByLineParser
 
-rubyParser :: Parser (Term (Union Ruby.Syntax) (Record Location))
+rubyParser :: Parser Ruby.Term
 rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
 
-pythonParser :: Parser (Term (Union Python.Syntax) (Record Location))
+pythonParser :: Parser Python.Term
 pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
 
 runParser :: Parser term -> Source -> IO term

From 79724efd6754d1dd42402b776ebb20f465b1224b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:54:21 -0400
Subject: [PATCH 31/89] Clarify a doc comment.

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

diff --git a/src/Parser.hs b/src/Parser.hs
index e79a91bc9..39825648d 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -35,7 +35,7 @@ data Parser term where
   AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs), Traversable f)
                    => Parser (Cofree f (Record (Maybe grammar ': Location))) -- ^ A parser producing 'AST'.
                    -> Assignment grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
-                   -> Parser (Term (Union fs) (Record Location))             -- ^ A parser of 'Term's.
+                   -> Parser (Term (Union fs) (Record Location))             -- ^ A parser producing 'Term's.
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.

From 40f86f4b5901ad125468a4ab67791d297aea7b04 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 15:57:39 -0400
Subject: [PATCH 32/89] Define type synonyms for Ruby and Python assignment so
 as to not have to keep editing every type signature.

---
 src/Language/Python/Syntax.hs | 97 ++++++++++++++++++-----------------
 src/Language/Ruby/Syntax.hs   | 45 ++++++++--------
 2 files changed, 72 insertions(+), 70 deletions(-)

diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index b56345f5e..f208fd581 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -13,7 +13,7 @@ import Data.Functor.Classes.Show.Generic
 import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
-import Data.Syntax.Assignment hiding (Error)
+import Data.Syntax.Assignment hiding (Assignment, Error)
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@@ -65,6 +65,7 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
+type Assignment = Assignment.Assignment Grammar Term
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
@@ -81,13 +82,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment Grammar Term
+assignment :: HasCallStack => Assignment
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar Term
+declaration :: HasCallStack => Assignment
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment Grammar Term
+statement :: HasCallStack => Assignment
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -100,10 +101,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment Grammar Term
+expressionStatement :: HasCallStack => Assignment
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment Grammar Term
+expression :: HasCallStack => Assignment
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -123,13 +124,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment Grammar Term
+dottedName :: HasCallStack => Assignment
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment Grammar Term
+ellipsis :: HasCallStack => Assignment
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment Grammar Term
+comparisonOperator :: HasCallStack => Assignment
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -144,26 +145,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment Grammar Term
+notOperator :: HasCallStack => Assignment
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment Grammar Term
+keywordIdentifier :: HasCallStack => Assignment
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment Grammar Term
+tuple :: HasCallStack => Assignment
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment Grammar Term
+expressionList :: HasCallStack => Assignment
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment Grammar Term
+unaryOperator :: HasCallStack => Assignment
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment Grammar Term
+binaryOperator :: HasCallStack => Assignment
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -181,17 +182,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment Grammar Term
+booleanOperator :: HasCallStack => Assignment
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment Grammar Term
+assignment' :: HasCallStack => Assignment
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment Grammar Term
+augmentedAssignment :: HasCallStack => Assignment
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -206,56 +207,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment Grammar Term
+yield :: HasCallStack => Assignment
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment Grammar Term
+rvalue :: HasCallStack => Assignment
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment Grammar Term
+identifier :: HasCallStack => Assignment
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment Grammar Term
+literal :: HasCallStack => Assignment
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment Grammar Term
+set :: HasCallStack => Assignment
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment Grammar Term
+dictionary :: HasCallStack => Assignment
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment Grammar Term
+list' :: HasCallStack => Assignment
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment Grammar Term
+string :: HasCallStack => Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment Grammar Term
+concatenatedString :: HasCallStack => Assignment
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment Grammar Term
+float :: HasCallStack => Assignment
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment Grammar Term
+integer :: HasCallStack => Assignment
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment Grammar Term
+comment :: HasCallStack => Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment Grammar Term
+import' :: HasCallStack => Assignment
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment Grammar Term
+importFrom :: HasCallStack => Assignment
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment Grammar Term
+assertStatement :: HasCallStack => Assignment
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment Grammar Term
+printStatement :: HasCallStack => Assignment
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -266,47 +267,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment Grammar Term
+globalStatement :: HasCallStack => Assignment
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment Grammar Term
+await :: HasCallStack => Assignment
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment Grammar Term
+returnStatement :: HasCallStack => Assignment
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment Grammar Term
+ifStatement :: HasCallStack => Assignment
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment Grammar Term
+memberAccess :: HasCallStack => Assignment
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment Grammar Term
+subscript :: HasCallStack => Assignment
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment Grammar Term
+call :: HasCallStack => Assignment
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment Grammar Term
+boolean :: HasCallStack => Assignment
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment Grammar Term
+none :: HasCallStack => Assignment
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment Grammar Term
+lambda :: HasCallStack => Assignment
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment Grammar Term
+comprehension :: HasCallStack => Assignment
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -317,16 +318,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment Grammar Term
+conditionalExpression :: HasCallStack => Assignment
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
 makeTerm :: (HasCallStack, InUnion fs f) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment Grammar Term
+emptyTerm :: HasCallStack => Assignment
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar Term -> Assignment Grammar Term
+handleError :: HasCallStack => Assignment -> Assignment
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 8e1efc82c..4270f224f 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -10,7 +10,7 @@ module Language.Ruby.Syntax
 import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
-import Data.Syntax.Assignment hiding (Error)
+import Data.Syntax.Assignment hiding (Assignment, Error)
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@@ -55,33 +55,34 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
+type Assignment = Assignment.Assignment Grammar Term
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment Grammar Term
+assignment :: HasCallStack => Assignment
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment Grammar Term
+declaration :: HasCallStack => Assignment
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment Grammar Term
+class' :: HasCallStack => Assignment
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment Grammar Term
+constant :: HasCallStack => Assignment
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment Grammar Term
+identifier :: HasCallStack => Assignment
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment Grammar Term
+method :: HasCallStack => Assignment
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment Grammar Term
+statements :: HasCallStack => Assignment
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment Grammar Term
+statement :: HasCallStack => Assignment
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -96,36 +97,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment Grammar Term
+lvalue :: HasCallStack => Assignment
 lvalue = identifier
 
-expression :: HasCallStack => Assignment Grammar Term
+expression :: HasCallStack => Assignment
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment Grammar Term
+comment :: HasCallStack => Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment Grammar Term
+if' :: HasCallStack => Assignment
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment Grammar Term
+unless :: HasCallStack => Assignment
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment Grammar Term
+while :: HasCallStack => Assignment
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment Grammar Term
+until :: HasCallStack => Assignment
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment Grammar Term
+for :: HasCallStack => Assignment
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment Grammar Term
+assignment' :: HasCallStack => Assignment
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -143,23 +144,23 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment Grammar Term
+literal :: HasCallStack => Assignment
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment grammar (Term.Term (Union fs) (Record Location)) -> Assignment grammar (Term.Term (Union fs) (Record Location))
+invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment.Assignment grammar (Term.Term (Union fs) (Record Location)) -> Assignment.Assignment grammar (Term.Term (Union fs) (Record Location))
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment Grammar Term
+emptyTerm :: HasCallStack => Assignment
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment Grammar Term -> Assignment Grammar Term
+handleError :: HasCallStack => Assignment -> Assignment
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)

From cc90ee88b7bc11408afec4889a8454806b9116c9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:12:23 -0400
Subject: [PATCH 33/89] Add an ast type parameter to Assignment.

---
 src/Data/Syntax/Assignment.hs | 56 +++++++++++++++++++----------------
 src/Language/Python/Syntax.hs |  2 +-
 src/Language/Ruby/Syntax.hs   |  4 +--
 src/Parser.hs                 |  8 ++---
 4 files changed, 37 insertions(+), 33 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index e0f6b4aa8..9edf5b802 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -62,6 +62,7 @@
 module Data.Syntax.Assignment
 ( Assignment
 , Location
+, AST
 , location
 , symbol
 , source
@@ -98,42 +99,45 @@ import Text.Show hiding (show)
 -- | Assignment from an AST with some set of 'symbol's onto some other value.
 --
 --   This is essentially a parser.
-type Assignment grammar = Freer (AssignmentF grammar)
+type Assignment ast grammar = Freer (AssignmentF ast grammar)
 
-data AssignmentF grammar a where
-  Location :: HasCallStack => AssignmentF grammar (Record Location)
-  Source :: HasCallStack => AssignmentF grammar ByteString
-  Children :: HasCallStack => Assignment grammar a -> AssignmentF grammar a
-  Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF grammar a
-  Alt :: HasCallStack => a -> a -> AssignmentF grammar a
-  Empty :: HasCallStack => AssignmentF grammar a
-  Throw :: HasCallStack => Error grammar -> AssignmentF grammar a
-  Catch :: HasCallStack => a -> (Error grammar -> a) -> AssignmentF grammar a
+data AssignmentF ast grammar a where
+  Location :: HasCallStack => AssignmentF ast grammar (Record Location)
+  Source :: HasCallStack => AssignmentF ast grammar ByteString
+  Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
+  Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF ast grammar a
+  Alt :: HasCallStack => a -> a -> AssignmentF ast grammar a
+  Empty :: HasCallStack => AssignmentF ast grammar a
+  Throw :: HasCallStack => Error grammar -> AssignmentF ast grammar a
+  Catch :: HasCallStack => a -> (Error grammar -> a) -> AssignmentF ast grammar a
 
 -- | 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.
-location :: HasCallStack => Assignment grammar (Record Location)
+location :: HasCallStack => Assignment ast grammar (Record Location)
 location = Location `Then` return
 
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
 --   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 :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment grammar (Record Location)
+symbol :: (Enum grammar, Eq grammar, HasCallStack) => grammar -> Assignment ast grammar (Record Location)
 symbol s = withFrozenCallStack $ Choose (IntMap.singleton (fromEnum s) ()) `Then` (const location)
 
 -- | A rule to produce a node’s source as a ByteString.
-source :: HasCallStack => Assignment grammar ByteString
+source :: HasCallStack => Assignment ast grammar ByteString
 source = withFrozenCallStack $ Source `Then` return
 
 -- | Match a node by applying an assignment to its children.
-children :: HasCallStack => Assignment grammar a -> Assignment grammar a
+children :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a
 children forEach = withFrozenCallStack $ Children forEach `Then` return
 
 
 -- | A location specified as possibly-empty intervals of bytes and line/column positions.
 type Location = '[Info.Range, Info.SourceSpan]
 
+-- | An AST node labelled with symbols and source location.
+type AST grammar = Cofree [] (Record (Maybe grammar ': Location))
+
 -- | The result of assignment, possibly containing an error.
 data Result grammar a = Result { resultError :: Maybe (Error grammar), resultValue :: Maybe a }
   deriving (Eq, Foldable, Functor, Traversable)
@@ -186,13 +190,13 @@ showSourcePos :: Maybe FilePath -> Info.SourcePos -> ShowS
 showSourcePos path Info.SourcePos{..} = maybe (showParen True (showString "interactive")) showString path . showChar ':' . shows line . showChar ':' . shows column
 
 -- | Run an assignment over an AST exhaustively.
-assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
+assign :: (HasField fields Info.Range, HasField fields Info.SourceSpan, HasField fields (Maybe grammar), Symbol grammar, Enum grammar, Eq grammar, Traversable f, HasCallStack) => Assignment (Cofree f (Record fields)) grammar a -> Source.Source -> Cofree f (Record fields) -> Result grammar a
 assign = assignBy (\ (r :< _) -> getField r :. getField r :. getField r :. Nil)
 
-assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> Source.Source -> ast -> Result grammar a
+assignBy :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment ast grammar a -> Source.Source -> ast -> Result grammar a
 assignBy toRecord assignment source = fmap fst . assignAllFrom toRecord assignment . makeState source . pure
 
-assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
+assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment ast grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
 assignAllFrom toRecord assignment state = case runAssignment toRecord assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous (rhead . toRecord) state) of
     [] -> pure (a, state)
@@ -200,9 +204,9 @@ assignAllFrom toRecord assignment state = case runAssignment toRecord assignment
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
+runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Foldable (Base ast), HasCallStack) => (forall x. Base ast x -> Record (Maybe grammar ': Location)) -> Assignment ast grammar a -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
 runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
-  where run :: AssignmentF grammar x -> (x -> AssignmentState ast -> Result grammar (a, AssignmentState ast)) -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
+  where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast -> Result grammar (a, AssignmentState ast)) -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (toRecord (project node))) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
@@ -252,17 +256,17 @@ makeState source nodes = AssignmentState 0 (Info.SourcePos 1 1) source nodes
 
 -- Instances
 
-instance Enum grammar => Alternative (Assignment grammar) where
-  empty :: HasCallStack => Assignment grammar a
+instance Enum grammar => Alternative (Assignment ast grammar) where
+  empty :: HasCallStack => Assignment ast grammar a
   empty = Empty `Then` return
-  (<|>) :: HasCallStack => Assignment grammar a -> Assignment grammar a -> Assignment grammar a
+  (<|>) :: HasCallStack => Assignment ast grammar a -> Assignment ast grammar a -> Assignment ast grammar a
   a <|> b = case (a, b) of
     (_, Empty `Then` _) -> a
     (Empty `Then` _, _) -> b
     (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 grammar => Show1 (AssignmentF grammar) where
+instance Show grammar => Show1 (AssignmentF ast grammar) where
   liftShowsPrec sp sl d a = case a of
     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 ""
@@ -297,9 +301,9 @@ instance Alternative (Result grammar) where
   Result e (Just a) <|> _ = Result e (Just a)
   Result e1 Nothing <|> Result e2 b = Result (e1 <|> e2) b
 
-instance MonadError (Error grammar) (Assignment grammar) where
-  throwError :: HasCallStack => Error grammar -> Assignment grammar a
+instance MonadError (Error grammar) (Assignment ast grammar) where
+  throwError :: HasCallStack => Error grammar -> Assignment ast grammar a
   throwError error = withFrozenCallStack $ Throw error `Then` return
 
-  catchError :: HasCallStack => Assignment grammar a -> (Error grammar -> Assignment grammar a) -> Assignment grammar a
+  catchError :: HasCallStack => Assignment ast grammar a -> (Error grammar -> Assignment ast grammar a) -> Assignment ast grammar a
   catchError during handler = withFrozenCallStack $ Catch during handler `Then` identity
diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index f208fd581..4b28570aa 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -65,7 +65,7 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = Assignment.Assignment Grammar Term
+type Assignment = Assignment.Assignment (AST Grammar) Grammar Term
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index 4270f224f..a7c485a4b 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -55,7 +55,7 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = Assignment.Assignment Grammar Term
+type Assignment = Assignment.Assignment (AST Grammar) Grammar Term
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
@@ -151,7 +151,7 @@ literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Symbol <*> (Literal.Symbol <$> source)
         <|> makeTerm <$> symbol Range <*> children (Literal.Range <$> statement <*> statement) -- FIXME: represent the difference between .. and ...
 
-invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment.Assignment grammar (Term.Term (Union fs) (Record Location)) -> Assignment.Assignment grammar (Term.Term (Union fs) (Record Location))
+invert :: (InUnion fs Expression.Boolean, HasCallStack) => Assignment.Assignment ast grammar (Term.Term (Union fs) (Record Location)) -> Assignment.Assignment ast grammar (Term.Term (Union fs) (Record Location))
 invert term = makeTerm <$> location <*> fmap Expression.Not term
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
diff --git a/src/Parser.hs b/src/Parser.hs
index 39825648d..fcea1afaf 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -32,10 +32,10 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (Cofree [] (Record (Maybe grammar ': Location)))
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs), Traversable f)
-                   => Parser (Cofree f (Record (Maybe grammar ': Location))) -- ^ A parser producing 'AST'.
-                   -> Assignment grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
-                   -> Parser (Term (Union fs) (Record Location))             -- ^ A parser producing 'Term's.
+  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
+                   => Parser (AST grammar)                                                 -- ^ A parser producing 'AST'.
+                   -> Assignment (AST grammar) grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
+                   -> Parser (Term (Union fs) (Record Location))                           -- ^ A parser producing 'Term's.
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.

From 8730128c4cdfba124d531792e739d3717e1d63c5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:14:22 -0400
Subject: [PATCH 34/89] Define a WithNode rule for assignments.

---
 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 9edf5b802..854e51d1b 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -103,6 +103,7 @@ type Assignment ast grammar = Freer (AssignmentF ast grammar)
 
 data AssignmentF ast grammar a where
   Location :: HasCallStack => AssignmentF ast grammar (Record Location)
+  WithNode :: HasCallStack => (forall x. Base ast x -> a) -> AssignmentF ast grammar a
   Source :: HasCallStack => AssignmentF ast grammar ByteString
   Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
   Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF ast grammar a
@@ -269,6 +270,7 @@ instance Enum grammar => Alternative (Assignment ast grammar) where
 instance Show grammar => Show1 (AssignmentF ast grammar) where
   liftShowsPrec sp sl d a = case a of
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
+    WithNode projection -> showsUnaryWith (const (const (showChar '_'))) "WithNode" d projection
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
     Choose choices -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Choose" d (IntMap.toList choices)

From 90e7b5a5c2bbc49b36a58ba69b4456b2de96fa9b Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:16:10 -0400
Subject: [PATCH 35/89] Define the interpretation of WithNode assignments.

---
 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 854e51d1b..a189a4f1b 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -211,6 +211,7 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
         run assignment yield initialState = case (assignment, stateNodes) of
           (Location, node : _) -> yield (rtail (toRecord (project node))) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
+          (WithNode projection, node : _) -> yield (projection (project node)) state
           (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (toRecord (project node))) (negate stateOffset)) stateSource)) (advanceState (rtail . toRecord) state)
           (Children childAssignment, node : _) -> case assignAllFrom toRecord childAssignment state { stateNodes = toList (project node) } of
             Result _ (Just (a, state')) -> yield a (advanceState (rtail . toRecord) state' { stateNodes = stateNodes })

From 7707eb8991f3c248a41aa21f2eeecfca56f14479 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:17:51 -0400
Subject: [PATCH 36/89] Define a withNode smart constructor.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index a189a4f1b..9166d9db0 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -64,6 +64,7 @@ module Data.Syntax.Assignment
 , Location
 , AST
 , location
+, withNode
 , symbol
 , source
 , children
@@ -118,6 +119,12 @@ data AssignmentF ast grammar a where
 location :: HasCallStack => Assignment ast grammar (Record Location)
 location = Location `Then` return
 
+-- | Zero-width projection 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 (withNode f *> b)' is fine, but 'many (withNode f)' is not.
+withNode :: HasCallStack => (forall x. Base ast x -> a) -> Assignment ast grammar a
+withNode projection = WithNode projection `Then` return
+
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
 --   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.

From 28ee63a0468d93afc5ee573b5ceeb621126cac8e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:18:49 -0400
Subject: [PATCH 37/89] Stub in a module for Markdown assignment.

---
 semantic-diff.cabal             | 1 +
 src/Language/Markdown/Syntax.hs | 1 +
 2 files changed, 2 insertions(+)
 create mode 100644 src/Language/Markdown/Syntax.hs

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 02e3a95c1..14a6e1039 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -45,6 +45,7 @@ library
                      , Language
                      , Language.C
                      , Language.Markdown
+                     , Language.Markdown.Syntax
                      , Language.Go
                      , Language.Go.Syntax
                      , Language.Ruby
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
new file mode 100644
index 000000000..f197a41f0
--- /dev/null
+++ b/src/Language/Markdown/Syntax.hs
@@ -0,0 +1 @@
+module Language.Markdown.Syntax where

From d01f188d4d488e904b3fc88e3b9ee66eaceadb12 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 16:28:26 -0400
Subject: [PATCH 38/89] Stub in an assignment for Markdown.

---
 src/Language/Markdown/Syntax.hs | 57 ++++++++++++++++++++++++++++++++-
 1 file changed, 56 insertions(+), 1 deletion(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index f197a41f0..97909086c 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -1 +1,56 @@
-module Language.Markdown.Syntax where
+{-# LANGUAGE DataKinds, DeriveAnyClass #-}
+module Language.Markdown.Syntax
+( assignment
+, Syntax
+, Grammar
+, Error
+, Term
+) where
+
+import qualified CMark
+import Data.Align.Generic
+import Data.Functor.Classes.Eq.Generic
+import Data.Functor.Classes.Show.Generic
+import Data.Functor.Union
+import Data.Record
+import Data.Syntax.Assignment hiding (Assignment, Error)
+import GHC.Generics
+import GHC.Stack
+import qualified Data.Syntax.Assignment as Assignment
+import Prologue hiding (Location)
+import qualified Term
+import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
+
+data Grammar
+  = Document'
+  | Paragraph'
+  | Heading
+  deriving (Bounded, Enum, Eq, Ord, Show)
+
+instance Symbol Grammar where
+  symbolType _ = Regular
+
+type Syntax =
+  '[ Document
+   , Paragraph
+   ]
+
+newtype Document a = Document [a]
+ deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Document where liftEq = genericLiftEq
+instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
+
+newtype Paragraph a = Paragraph [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Paragraph where liftEq = genericLiftEq
+instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
+
+
+type Error = Assignment.Error Grammar
+type Term = Term.Term (Union Syntax) (Record Location)
+type Assignment = Assignment.Assignment CMark.NodeType Grammar Term
+
+assignment :: HasCallStack => Assignment
+assignment = empty

From 89c9e546ebf7f71f6bf0a083a8f9df8cd32e3833 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 17:26:04 -0400
Subject: [PATCH 39/89] Move the HasCallStack constraint into the Assignment
 type synonym.

---
 src/Language/Markdown/Syntax.hs |  6 +-
 src/Language/Python/Syntax.hs   | 98 ++++++++++++++++-----------------
 src/Language/Ruby/Syntax.hs     | 44 +++++++--------
 3 files changed, 74 insertions(+), 74 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 97909086c..f21c51f14 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DeriveAnyClass #-}
+{-# LANGUAGE DataKinds, DeriveAnyClass, RankNTypes #-}
 module Language.Markdown.Syntax
 ( assignment
 , Syntax
@@ -50,7 +50,7 @@ instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = Assignment.Assignment CMark.NodeType Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment CMark.NodeType Grammar Term
 
-assignment :: HasCallStack => Assignment
+assignment :: Assignment
 assignment = empty
diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs
index 4b28570aa..8b200450f 100644
--- a/src/Language/Python/Syntax.hs
+++ b/src/Language/Python/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DeriveAnyClass, GeneralizedNewtypeDeriving, TypeOperators #-}
+{-# LANGUAGE DataKinds, DeriveAnyClass, RankNTypes, TypeOperators #-}
 module Language.Python.Syntax
 ( assignment
 , Syntax
@@ -65,7 +65,7 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = Assignment.Assignment (AST Grammar) Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (AST Grammar) Grammar Term
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis
@@ -82,13 +82,13 @@ instance Eq1 Redirect where liftEq = genericLiftEq
 instance Show1 Redirect where liftShowsPrec = genericLiftShowsPrec
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
-assignment :: HasCallStack => Assignment
+assignment :: Assignment
 assignment = makeTerm <$> symbol Module <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment
+declaration :: Assignment
 declaration = handleError $ comment <|> statement <|> expression
 
-statement :: HasCallStack => Assignment
+statement :: Assignment
 statement = assertStatement
           <|> assignment'
           <|> augmentedAssignment
@@ -101,10 +101,10 @@ statement = assertStatement
           <|> printStatement
           <|> returnStatement
 
-expressionStatement :: HasCallStack => Assignment
+expressionStatement :: Assignment
 expressionStatement = symbol ExpressionStatement *> children expression
 
-expression :: HasCallStack => Assignment
+expression :: Assignment
 expression = await
           <|> binaryOperator
           <|> booleanOperator
@@ -124,13 +124,13 @@ expression = await
           <|> tuple
           <|> unaryOperator
 
-dottedName :: HasCallStack => Assignment
+dottedName :: Assignment
 dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
 
-ellipsis :: HasCallStack => Assignment
+ellipsis :: Assignment
 ellipsis = makeTerm <$> symbol Grammar.Ellipsis <*> (Language.Python.Syntax.Ellipsis <$ source)
 
-comparisonOperator :: HasCallStack => Assignment
+comparisonOperator :: Assignment
 comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression >>= \ lexpression -> makeComparison loc lexpression)
   where
     makeComparison loc lexpression =  makeTerm loc <$ symbol AnonLAngle      <*> (Expression.LessThan lexpression <$> expression)
@@ -145,26 +145,26 @@ comparisonOperator = symbol ComparisonOperator >>= \ loc -> children (expression
                                   <|> symbol AnonIs *> source *> (symbol AnonNot *> (makeTerm loc <$> Expression.Not <$> (makeTerm <$> location <*> (Expression.Equal lexpression <$> expression)))
                                                                 <|> (makeTerm loc <$> Expression.Equal lexpression <$> expression))
 
-notOperator :: HasCallStack => Assignment
+notOperator :: Assignment
 notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
 
-keywordIdentifier :: HasCallStack => Assignment
+keywordIdentifier :: Assignment
 keywordIdentifier = makeTerm <$> symbol KeywordIdentifier <*> children (Syntax.Identifier <$> source)
 
-tuple :: HasCallStack => Assignment
+tuple :: Assignment
 tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> (many expression))
 
 -- TODO: Consider flattening single element lists
-expressionList :: HasCallStack => Assignment
+expressionList :: Assignment
 expressionList = makeTerm <$> symbol ExpressionList <*> children (many expression)
 
-unaryOperator :: HasCallStack => Assignment
+unaryOperator :: Assignment
 unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
   where
     arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
     bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
 
-binaryOperator :: HasCallStack => Assignment
+binaryOperator :: Assignment
 binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>= \ lexpression ->
       makeTerm location <$> arithmetic lexpression
   <|> makeTerm location <$> bitwise lexpression)
@@ -182,17 +182,17 @@ binaryOperator = symbol BinaryOperator >>= \ location -> children (expression >>
                        <|> symbol AnonLAngleLAngle *> (Expression.LShift lexpression <$> expression)
                        <|> symbol AnonRAngleRAngle *> (Expression.RShift lexpression <$> expression)
 
-booleanOperator :: HasCallStack => Assignment
+booleanOperator :: Assignment
 booleanOperator = makeTerm <$> symbol BooleanOperator <*> children ( expression >>= booleanOperator' )
   where
     booleanOperator' lexpression =  symbol AnonAnd *> (Expression.And lexpression <$> expression)
                                 <|> symbol AnonOr *> (Expression.Or lexpression <$> expression)
 
-assignment' :: HasCallStack => Assignment
+assignment' :: Assignment
 assignment' =
   makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> expressionList <*> rvalue)
 
-augmentedAssignment :: HasCallStack => Assignment
+augmentedAssignment :: Assignment
 augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expressionList >>= \ lvalue -> Statement.Assignment lvalue <$>
          (makeTerm <$> symbol AnonPlusEqual               <*> (Expression.Plus lvalue      <$> rvalue)
       <|> makeTerm <$> symbol AnonMinusEqual              <*> (Expression.Minus lvalue     <$> rvalue)
@@ -207,56 +207,56 @@ augmentedAssignment = makeTerm <$> symbol AugmentedAssignment <*> children (expr
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift lvalue    <$> rvalue)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr lvalue      <$> rvalue)))
 
-yield :: HasCallStack => Assignment
+yield :: Assignment
 yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> expressionList <|> emptyTerm ))
 
-rvalue :: HasCallStack => Assignment
+rvalue :: Assignment
 rvalue  = expressionList <|> assignment' <|> augmentedAssignment <|> yield
 
-identifier :: HasCallStack => Assignment
+identifier :: Assignment
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-literal :: HasCallStack => Assignment
+literal :: Assignment
 literal = string <|> integer <|> float <|> boolean <|> none <|> concatenatedString <|> list' <|> dictionary <|> set
 
-set :: HasCallStack => Assignment
+set :: Assignment
 set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
 
-dictionary :: HasCallStack => Assignment
+dictionary :: Assignment
 dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many pairs)
   where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> expression <*> expression)
 
-list' :: HasCallStack => Assignment
+list' :: Assignment
 list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
 
 -- TODO: Wrap `Literal.TextElement` with a `Literal.String`
-string :: HasCallStack => Assignment
+string :: Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
-concatenatedString :: HasCallStack => Assignment
+concatenatedString :: Assignment
 concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (Literal.TextElement . mconcat <$> many (symbol String *> source))
 
-float :: HasCallStack => Assignment
+float :: Assignment
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
 
-integer :: HasCallStack => Assignment
+integer :: Assignment
 integer = makeTerm <$> symbol Integer <*> (Literal.Integer <$> source)
 
-comment :: HasCallStack => Assignment
+comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 -- TODO Possibly match against children for dotted name and identifiers
-import' :: HasCallStack => Assignment
+import' :: Assignment
 import' = makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
 
 -- TODO Possibly match against children nodes
-importFrom :: HasCallStack => Assignment
+importFrom :: Assignment
 importFrom = makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
 
-assertStatement :: HasCallStack => Assignment
+assertStatement :: Assignment
 assertStatement = makeTerm <$ symbol AssertStatement <*> location <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-printStatement :: HasCallStack => Assignment
+printStatement :: Assignment
 printStatement = do
   location <- symbol PrintStatement
   children $ do
@@ -267,47 +267,47 @@ printStatement = do
     redirectCallTerm location keyword = makeTerm location <$ symbol Chevron <*> (flip Redirect <$> children expression <*> printCallTerm location keyword)
     printCallTerm location keyword = makeTerm location . Expression.Call keyword <$> many expression
 
-globalStatement :: HasCallStack => Assignment
+globalStatement :: Assignment
 globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many identifier)
 
-await :: HasCallStack => Assignment
+await :: Assignment
 await = makeTerm <$> symbol Await <*> children (Expression.Call <$> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression)
 
-returnStatement :: HasCallStack => Assignment
+returnStatement :: Assignment
 returnStatement = makeTerm <$> symbol ReturnStatement <*> (Statement.Return <$> children expressionList)
 
 
-ifStatement :: HasCallStack => Assignment
+ifStatement :: Assignment
 ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> statement <*> (flip (foldr makeElif) <$> many elifClause <*> optionalElse))
   where elseClause = symbol ElseClause *> children statement
         elifClause = (,) <$ symbol ElifClause <*> location <*> children (Statement.If <$> expression <*> statement)
         optionalElse = fromMaybe <$> emptyTerm <*> optional elseClause
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
-memberAccess :: HasCallStack => Assignment
+memberAccess :: Assignment
 memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
 
-subscript :: HasCallStack => Assignment
+subscript :: Assignment
 subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
 
-call :: HasCallStack => Assignment
+call :: Assignment
 call = makeTerm <$> symbol Call <*> children (Expression.Call <$> identifier <*> (symbol ArgumentList *> children (many expression)
                                                                                 <|> some comprehension))
 
-boolean :: HasCallStack => Assignment
+boolean :: Assignment
 boolean =  makeTerm <$> symbol Grammar.True  <*> (Literal.true <$ source)
        <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
 
-none :: HasCallStack => Assignment
+none :: Assignment
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
-lambda :: HasCallStack => Assignment
+lambda :: Assignment
 lambda = makeTerm <$> symbol Lambda <*> children (Declaration.Function <$> lambdaIdentifier <*> lambdaParameters <*> lambdaBody)
   where lambdaIdentifier = makeTerm <$> symbol AnonLambda <*> (Syntax.Identifier <$> source)
         lambdaParameters = many identifier
         lambdaBody = expression
 
-comprehension :: HasCallStack => Assignment
+comprehension :: Assignment
 comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol ListComprehension <*> children (comprehensionDeclaration expression)
              <|> makeTerm <$> symbol SetComprehension <*> children (comprehensionDeclaration expression)
@@ -318,16 +318,16 @@ comprehension =  makeTerm <$> symbol GeneratorExpression <*> children (comprehen
     makeComprehension (loc, makeRest) rest = makeTerm loc (makeRest rest)
     nestedComprehension = (,) <$> location <*> (Declaration.Comprehension <$> expression <* symbol Variables <*> children (many expression))
 
-conditionalExpression :: HasCallStack => Assignment
+conditionalExpression :: Assignment
 conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (expression >>= \ thenBranch -> expression >>= \ conditional -> Statement.If conditional thenBranch <$> (expression <|> emptyTerm))
 
 makeTerm :: (HasCallStack, InUnion fs f) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree (a :< inj f)
 
-emptyTerm :: HasCallStack => Assignment
+emptyTerm :: Assignment
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment -> Assignment
+handleError :: Assignment -> Assignment
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)
diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs
index a7c485a4b..33a935539 100644
--- a/src/Language/Ruby/Syntax.hs
+++ b/src/Language/Ruby/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DataKinds, RankNTypes #-}
 module Language.Ruby.Syntax
 ( assignment
 , Syntax
@@ -55,34 +55,34 @@ type Syntax =
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = Assignment.Assignment (AST Grammar) Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (AST Grammar) Grammar Term
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: HasCallStack => Assignment
+assignment :: Assignment
 assignment = makeTerm <$> symbol Program <*> children (many declaration)
 
-declaration :: HasCallStack => Assignment
+declaration :: Assignment
 declaration = handleError $ comment <|> class' <|> method
 
-class' :: HasCallStack => Assignment
+class' :: Assignment
 class' = makeTerm <$> symbol Class <*> children (Declaration.Class <$> (constant <|> scopeResolution) <*> (superclass <|> pure []) <*> many declaration)
   where superclass = pure <$ symbol Superclass <*> children constant
         scopeResolution = symbol ScopeResolution *> children (constant <|> identifier)
 
-constant :: HasCallStack => Assignment
+constant :: Assignment
 constant = makeTerm <$> symbol Constant <*> (Syntax.Identifier <$> source)
 
-identifier :: HasCallStack => Assignment
+identifier :: Assignment
 identifier = makeTerm <$> symbol Identifier <*> (Syntax.Identifier <$> source)
 
-method :: HasCallStack => Assignment
+method :: Assignment
 method = makeTerm <$> symbol Method <*> children (Declaration.Method <$> identifier <*> pure [] <*> statements)
 
-statements :: HasCallStack => Assignment
+statements :: Assignment
 statements = makeTerm <$> location <*> many statement
 
-statement :: HasCallStack => Assignment
+statement :: Assignment
 statement  = handleError
            $  exit Statement.Return Return
           <|> exit Statement.Yield Yield
@@ -97,36 +97,36 @@ statement  = handleError
           <|> assignment'
   where exit construct sym = makeTerm <$> symbol sym <*> children ((construct .) . fromMaybe <$> emptyTerm <*> optional (symbol ArgumentList *> children statement))
 
-lvalue :: HasCallStack => Assignment
+lvalue :: Assignment
 lvalue = identifier
 
-expression :: HasCallStack => Assignment
+expression :: Assignment
 expression = identifier <|> statement
 
-comment :: HasCallStack => Assignment
+comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
-if' :: HasCallStack => Assignment
+if' :: Assignment
 if' =  ifElsif If
    <|> makeTerm <$> symbol IfModifier     <*> children (flip Statement.If <$> statement <*> statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
   where ifElsif s = makeTerm <$> symbol s <*> children      (Statement.If <$> statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (ifElsif Elsif <|> makeTerm <$> symbol Else <*> children (many statement))))
 
-unless :: HasCallStack => Assignment
+unless :: Assignment
 unless =  makeTerm <$> symbol Unless         <*> children      (Statement.If <$> invert statement <*> statements <*> (fromMaybe <$> emptyTerm <*> optional (makeTerm <$> symbol Else <*> children (many statement))))
       <|> makeTerm <$> symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> invert statement <*> (makeTerm <$> location <*> pure Syntax.Empty))
 
-while :: HasCallStack => Assignment
+while :: Assignment
 while =  makeTerm <$> symbol While         <*> children      (Statement.While <$> statement <*> statements)
      <|> makeTerm <$> symbol WhileModifier <*> children (flip Statement.While <$> statement <*> statement)
 
-until :: HasCallStack => Assignment
+until :: Assignment
 until =  makeTerm <$> symbol Until         <*> children      (Statement.While <$> invert statement <*> statements)
      <|> makeTerm <$> symbol UntilModifier <*> children (flip Statement.While <$> statement <*> invert statement)
 
-for :: HasCallStack => Assignment
+for :: Assignment
 for = makeTerm <$> symbol For <*> children (Statement.ForEach <$> identifier <*> statement <*> statements)
 
-assignment' :: HasCallStack => Assignment
+assignment' :: Assignment
 assignment'
    =  makeTerm <$> symbol Assignment <*> children (Statement.Assignment <$> lvalue <*> expression)
   <|> makeTerm <$> symbol OperatorAssignment <*> children (lvalue >>= \ var -> Statement.Assignment var <$>
@@ -144,7 +144,7 @@ assignment'
       <|> makeTerm <$> symbol AnonLAngleLAngleEqual       <*> (Expression.LShift var    <$> expression)
       <|> makeTerm <$> symbol AnonCaretEqual              <*> (Expression.BXOr var      <$> expression)))
 
-literal :: HasCallStack => Assignment
+literal :: Assignment
 literal  =  makeTerm <$> symbol Grammar.True <*> (Literal.true <$ source)
         <|> makeTerm <$> symbol Grammar.False <*> (Literal.false <$ source)
         <|> makeTerm <$> symbol Grammar.Integer <*> (Literal.Integer <$> source)
@@ -157,10 +157,10 @@ invert term = makeTerm <$> location <*> fmap Expression.Not term
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f
 
-emptyTerm :: HasCallStack => Assignment
+emptyTerm :: Assignment
 emptyTerm = makeTerm <$> location <*> pure Syntax.Empty
 
-handleError :: HasCallStack => Assignment -> Assignment
+handleError :: Assignment -> Assignment
 handleError = flip catchError $ \ error -> case errorCause error of
   UnexpectedEndOfInput _ -> throwError error
   _ -> makeTerm <$> location <*> (Syntax.Error error <$ source)

From 9b0f6f777d6f37bb0c3b0832287d6c27ef90fbee Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 17:29:35 -0400
Subject: [PATCH 40/89] Move the Grammar datatype into Language.Markdown.

---
 src/Language/Markdown.hs        | 11 +++++++++++
 src/Language/Markdown/Syntax.hs | 11 +----------
 2 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index 7bbfc4c02..ef64ab863 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -8,6 +8,13 @@ import Info
 import Prologue
 import Source
 import Syntax
+import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
+
+data Grammar
+  = Document
+  | Paragraph
+  | Heading
+  deriving (Bounded, Enum, Eq, Ord, Show)
 
 cmarkParser :: Source -> IO (Cofree (Syntax Text) (Record DefaultFields))
 cmarkParser source = pure . toTerm (totalRange source) (rangeToSourceSpan source $ totalRange source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
@@ -38,3 +45,7 @@ cmarkParser source = pure . toTerm (totalRange source) (rangeToSourceSpan source
         toCategory IMAGE{} = Other "image"
         toCategory t = Other (show t)
         toSpan PosInfo{..} = SourceSpan (SourcePos (pred startLine) (pred startColumn)) (SourcePos (pred endLine) endColumn)
+
+
+instance Symbol Grammar where
+  symbolType _ = Regular
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index f21c51f14..5f1d315a0 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -16,19 +16,10 @@ import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
 import GHC.Generics
 import GHC.Stack
+import Language.Markdown as Grammar (Grammar(..))
 import qualified Data.Syntax.Assignment as Assignment
 import Prologue hiding (Location)
 import qualified Term
-import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
-
-data Grammar
-  = Document'
-  | Paragraph'
-  | Heading
-  deriving (Bounded, Enum, Eq, Ord, Show)
-
-instance Symbol Grammar where
-  symbolType _ = Regular
 
 type Syntax =
   '[ Document

From e4ad59bb25a78f567c760fa196c3ccfbf9968446 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:05:14 -0400
Subject: [PATCH 41/89] Expand the Grammar datatype.

---
 src/Language/Markdown.hs | 17 +++++++++++++++++
 1 file changed, 17 insertions(+)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index ef64ab863..ef84ebc04 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -12,8 +12,25 @@ import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
 
 data Grammar
   = Document
+  | ThematicBreak
   | Paragraph
+  | BlockQuote
+  | HTMLBlock
+  | CustomBlock
+  | CodeBlock
   | Heading
+  | List
+  | Item
+  | Text
+  | SoftBreak
+  | LineBreak
+  | HTMLInline
+  | CustomInline
+  | Code
+  | Emphasis
+  | Strong
+  | Link
+  | Image
   deriving (Bounded, Enum, Eq, Ord, Show)
 
 cmarkParser :: Source -> IO (Cofree (Syntax Text) (Record DefaultFields))

From 9c49f3366f4afe04fb2b4f6900429807f15ad278 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:13:44 -0400
Subject: [PATCH 42/89] Map NodeType onto Grammar.

---
 src/Language/Markdown.hs | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index ef84ebc04..d3d2f7071 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -63,6 +63,28 @@ cmarkParser source = pure . toTerm (totalRange source) (rangeToSourceSpan source
         toCategory t = Other (show t)
         toSpan PosInfo{..} = SourceSpan (SourcePos (pred startLine) (pred startColumn)) (SourcePos (pred endLine) endColumn)
 
+toGrammar :: NodeType -> Grammar
+toGrammar DOCUMENT{} = Document
+toGrammar THEMATIC_BREAK{} = ThematicBreak
+toGrammar PARAGRAPH{} = Paragraph
+toGrammar BLOCK_QUOTE{} = BlockQuote
+toGrammar HTML_BLOCK{} = HTMLBlock
+toGrammar CUSTOM_BLOCK{} = CustomBlock
+toGrammar CODE_BLOCK{} = CodeBlock
+toGrammar HEADING{} = Heading
+toGrammar LIST{} = List
+toGrammar ITEM{} = Item
+toGrammar TEXT{} = Text
+toGrammar SOFTBREAK{} = SoftBreak
+toGrammar LINEBREAK{} = LineBreak
+toGrammar HTML_INLINE{} = HTMLInline
+toGrammar CUSTOM_INLINE{} = CustomInline
+toGrammar CODE{} = Code
+toGrammar EMPH{} = Emphasis
+toGrammar STRONG{} = Strong
+toGrammar LINK{} = Link
+toGrammar IMAGE{} = Image
+
 
 instance Symbol Grammar where
   symbolType _ = Regular

From 14e538fa25e341fb51de3fef69dc6fb217084b94 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:20:16 -0400
Subject: [PATCH 43/89] Produce assignment-style AST for Markdown.

---
 src/Language/Markdown.hs | 46 +++++++++++++---------------------------
 src/Parser.hs            |  3 +--
 2 files changed, 16 insertions(+), 33 deletions(-)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index d3d2f7071..2314f6b48 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -1,13 +1,17 @@
-{-# LANGUAGE DataKinds #-}
-module Language.Markdown where
+{-# LANGUAGE DataKinds, TypeOperators #-}
+module Language.Markdown
+( Grammar(..)
+, cmarkParser
+, toGrammar
+, NodeType
+) where
 
 import CMark
 import Data.Record
-import Data.Text
+import Data.Syntax.Assignment (Location)
 import Info
-import Prologue
+import Prologue hiding (Location)
 import Source
-import Syntax
 import Text.Parser.TreeSitter.Language (Symbol(..), SymbolType(..))
 
 data Grammar
@@ -33,34 +37,14 @@ data Grammar
   | Image
   deriving (Bounded, Enum, Eq, Ord, Show)
 
-cmarkParser :: Source -> IO (Cofree (Syntax Text) (Record DefaultFields))
-cmarkParser source = pure . toTerm (totalRange source) (rangeToSourceSpan source $ totalRange source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
-  where toTerm :: Range -> SourceSpan -> Node -> Cofree (Syntax Text) (Record DefaultFields)
+cmarkParser :: Source -> IO (Cofree [] (Record (NodeType ': Location)))
+cmarkParser source = pure . toTerm (totalRange source) (totalSpan source) $ commonmarkToNode [ optSourcePos, optSafe ] (toText source)
+  where toTerm :: Range -> SourceSpan -> Node -> Cofree [] (Record (NodeType ': Location))
         toTerm within withinSpan (Node position t children) =
-          let
-            range = maybe within (sourceSpanToRange source . toSpan) position
-            span = maybe withinSpan toSpan position
-          in
-            cofree $ (range :. toCategory t :. span :. Nil) :< case t of
-          -- Leaves
-          CODE text -> Leaf text
-          TEXT text -> Leaf text
-          CODE_BLOCK _ text -> Leaf text
-          -- Branches
-          _ -> Indexed (toTerm range span <$> children)
+          let range = maybe within (sourceSpanToRange source . toSpan) position
+              span = maybe withinSpan toSpan position
+          in cofree $ (t :. range :. span :. Nil) :< (toTerm range span <$> children)
 
-        toCategory :: NodeType -> Category
-        toCategory (TEXT _) = Other "text"
-        toCategory (CODE _) = Other "code"
-        toCategory (HTML_BLOCK _) = Other "html"
-        toCategory (HTML_INLINE _) = Other "html"
-        toCategory (HEADING _) = Other "heading"
-        toCategory (LIST ListAttributes{..}) = Other $ case listType of
-          BULLET_LIST -> "unordered list"
-          ORDERED_LIST -> "ordered list"
-        toCategory LINK{} = Other "link"
-        toCategory IMAGE{} = Other "image"
-        toCategory t = Other (show t)
         toSpan PosInfo{..} = SourceSpan (SourcePos (pred startLine) (pred startColumn)) (SourcePos (pred endLine) endColumn)
 
 toGrammar :: NodeType -> Grammar
diff --git a/src/Parser.hs b/src/Parser.hs
index fcea1afaf..e56ae6793 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -39,7 +39,7 @@ data Parser term where
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.
-  MarkdownParser :: Parser (SyntaxTerm Text DefaultFields)
+  MarkdownParser :: Parser (Cofree [] (Record (NodeType ': Location)))
   -- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
   LineByLineParser :: Parser (SyntaxTerm Text DefaultFields)
 
@@ -49,7 +49,6 @@ parserForLanguage Nothing = LineByLineParser
 parserForLanguage (Just language) = case language of
   C -> TreeSitterParser C tree_sitter_c
   Go -> TreeSitterParser Go tree_sitter_go
-  Markdown -> MarkdownParser
   Ruby -> TreeSitterParser Ruby tree_sitter_ruby
   TypeScript -> TreeSitterParser TypeScript tree_sitter_typescript
   _ -> LineByLineParser

From 8b4b0a10daa9c05f249813dedd955028f0fb4f02 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:21:31 -0400
Subject: [PATCH 44/89] Export assignBy.

---
 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 9166d9db0..059c6368d 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -74,6 +74,7 @@ module Data.Syntax.Assignment
 , showError
 , showExpectation
 , assign
+, assignBy
 , runAssignment
 , AssignmentState(..)
 , makeState

From a0cf560d259f1f6438f48e2b31dbb6f76dd41c71 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:29:45 -0400
Subject: [PATCH 45/89] Correct the Markdown ast type.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 5f1d315a0..a9cd2d04e 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DeriveAnyClass, RankNTypes #-}
+{-# LANGUAGE DataKinds, DeriveAnyClass, RankNTypes, TypeOperators #-}
 module Language.Markdown.Syntax
 ( assignment
 , Syntax
@@ -41,7 +41,7 @@ instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment CMark.NodeType Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar Term
 
 assignment :: Assignment
 assignment = empty

From 6e5660c49da482c8229aa04b4ec5f5c49f792111 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:29:53 -0400
Subject: [PATCH 46/89] Add Syntax.Error to Markdown.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index a9cd2d04e..057985dc4 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -18,12 +18,14 @@ import GHC.Generics
 import GHC.Stack
 import Language.Markdown as Grammar (Grammar(..))
 import qualified Data.Syntax.Assignment as Assignment
+import qualified Data.Syntax as Syntax
 import Prologue hiding (Location)
 import qualified Term
 
 type Syntax =
   '[ Document
    , Paragraph
+   , Syntax.Error Error
    ]
 
 newtype Document a = Document [a]

From 6af92900ff4541f5a3e090fb7d8dd84046c792ab Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:30:24 -0400
Subject: [PATCH 47/89] Decouple the AST type in assignment parsers from the
 grammar type.

---
 src/Parser.hs | 21 ++++++++++++---------
 1 file changed, 12 insertions(+), 9 deletions(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index e56ae6793..873fad46b 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -1,15 +1,17 @@
-{-# LANGUAGE DataKinds, GADTs, ScopedTypeVariables, TypeOperators #-}
+{-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
 module Parser where
 
 import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
 import Data.Syntax.Assignment
+import Data.Functor.Foldable hiding (fold, Nil)
 import Data.Functor.Union (inj)
 import qualified Data.Text as T
 import Info hiding (Empty, Go)
 import Language
 import Language.Markdown
+import qualified Language.Markdown.Syntax as Markdown
 import qualified Language.Python.Syntax as Python
 import qualified Language.Ruby.Syntax as Ruby
 import Prologue hiding (Location)
@@ -32,10 +34,11 @@ data Parser term where
   -- | A parser producing 'AST' using a 'TS.Language'.
   ASTParser :: (Bounded grammar, Enum grammar) => Ptr TS.Language -> Parser (Cofree [] (Record (Maybe grammar ': Location)))
   -- | A parser producing an à la carte term given an 'AST'-producing parser and an 'Assignment' onto 'Term's in some syntax type. Assignment errors will result in a top-level 'Syntax.Error' node.
-  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs))
-                   => Parser (AST grammar)                                                 -- ^ A parser producing 'AST'.
-                   -> Assignment (AST grammar) grammar (Term (Union fs) (Record Location)) -- ^ An assignment from 'AST' onto 'Term's.
-                   -> Parser (Term (Union fs) (Record Location))                           -- ^ A parser producing 'Term's.
+  AssignmentParser :: (Bounded grammar, Enum grammar, Eq grammar, Show grammar, Symbol grammar, InUnion fs (Syntax.Error (Error grammar)), Traversable (Union fs), Recursive ast, Foldable (Base ast))
+                   => Parser ast                                                   -- ^ A parser producing AST.
+                   -> (forall x. Base ast x -> Record (Maybe grammar ': Location)) -- ^ A function extracting the symbol and location.
+                   -> Assignment ast grammar (Term (Union fs) (Record Location))   -- ^ An assignment from AST onto 'Term's.
+                   -> Parser (Term (Union fs) (Record Location))                   -- ^ A parser producing 'Term's.
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.
@@ -54,17 +57,17 @@ parserForLanguage (Just language) = case language of
   _ -> LineByLineParser
 
 rubyParser :: Parser Ruby.Term
-rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) Ruby.assignment
+rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) headF Ruby.assignment
 
 pythonParser :: Parser Python.Term
-pythonParser = AssignmentParser (ASTParser tree_sitter_python) Python.assignment
+pythonParser = AssignmentParser (ASTParser tree_sitter_python) headF Python.assignment
 
 runParser :: Parser term -> Source -> IO term
 runParser parser = case parser of
   ASTParser language -> parseToAST language
-  AssignmentParser parser assignment -> \ source -> do
+  AssignmentParser parser by assignment -> \ source -> do
     ast <- runParser parser source
-    let Result err term = assign assignment source ast
+    let Result err term = assignBy by assignment source ast
     case term of
       Just term -> do
         let errors = toList err <> termErrors term

From 79389707fbe568ec8d84286ec21e0d16ac6716ec Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:30:33 -0400
Subject: [PATCH 48/89] Define a convenience to construct a Markdown parser.

---
 src/Parser.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Parser.hs b/src/Parser.hs
index 873fad46b..8893aadd8 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -62,6 +62,9 @@ rubyParser = AssignmentParser (ASTParser tree_sitter_ruby) headF Ruby.assignment
 pythonParser :: Parser Python.Term
 pythonParser = AssignmentParser (ASTParser tree_sitter_python) headF Python.assignment
 
+markdownParser :: Parser Markdown.Term
+markdownParser = AssignmentParser MarkdownParser (\ ((nodeType :. location) :< _) -> Just (toGrammar nodeType) :. location) Markdown.assignment
+
 runParser :: Parser term -> Source -> IO term
 runParser parser = case parser of
   ASTParser language -> parseToAST language

From 20228b8a4d9699ca67bd2a8b5f4dee7973364346 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:35:19 -0400
Subject: [PATCH 49/89] Qualify the grammar type.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 057985dc4..4e36ef2f3 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -2,7 +2,7 @@
 module Language.Markdown.Syntax
 ( assignment
 , Syntax
-, Grammar
+, Grammar.Grammar
 , Error
 , Term
 ) where
@@ -16,7 +16,7 @@ import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
 import GHC.Generics
 import GHC.Stack
-import Language.Markdown as Grammar (Grammar(..))
+import qualified Language.Markdown as Grammar (Grammar(..))
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax as Syntax
 import Prologue hiding (Location)
@@ -41,9 +41,9 @@ instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
 
-type Error = Assignment.Error Grammar
+type Error = Assignment.Error Grammar.Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
 
 assignment :: Assignment
 assignment = empty

From 5b78a3de21a9b8bad9fc8fe2377e6bf98738eb78 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:36:13 -0400
Subject: [PATCH 50/89] Stub in assignments for paragraphs and documents.

---
 src/Language/Markdown/Syntax.hs | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 4e36ef2f3..d9d91444b 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -46,4 +46,14 @@ type Term = Term.Term (Union Syntax) (Record Location)
 type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
 
 assignment :: Assignment
-assignment = empty
+assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many paragraph)
+
+inlineElement :: Assignment
+inlineElement = empty
+
+paragraph :: Assignment
+paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
+
+
+makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
+makeTerm a f = cofree $ a :< inj f

From 9445c73bf0ab09077772b362a05b4e207f08cc38 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:38:49 -0400
Subject: [PATCH 51/89] Stub in strong and emphasis assignment.

---
 src/Language/Markdown/Syntax.hs | 21 ++++++++++++++++++++-
 1 file changed, 20 insertions(+), 1 deletion(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index d9d91444b..adb8c4953 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -25,6 +25,8 @@ import qualified Term
 type Syntax =
   '[ Document
    , Paragraph
+   , Strong
+   , Emphasis
    , Syntax.Error Error
    ]
 
@@ -40,6 +42,17 @@ newtype Paragraph a = Paragraph [a]
 instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
+newtype Strong a = Strong [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Strong where liftEq = genericLiftEq
+instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
+
+newtype Emphasis a = Emphasis [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Emphasis where liftEq = genericLiftEq
+instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
 type Error = Assignment.Error Grammar.Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
@@ -49,7 +62,13 @@ assignment :: Assignment
 assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many paragraph)
 
 inlineElement :: Assignment
-inlineElement = empty
+inlineElement = strong <|> emphasis
+
+strong :: Assignment
+strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
+
+emphasis :: Assignment
+emphasis = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)

From e39c73711531d7bef45afd3b77d6e722b544a2ca Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:40:33 -0400
Subject: [PATCH 52/89] Define text assignment.

---
 src/Language/Markdown/Syntax.hs | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index adb8c4953..92ea16c71 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -19,7 +19,7 @@ import GHC.Stack
 import qualified Language.Markdown as Grammar (Grammar(..))
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax as Syntax
-import Prologue hiding (Location)
+import Prologue hiding (Location, Text)
 import qualified Term
 
 type Syntax =
@@ -27,6 +27,7 @@ type Syntax =
    , Paragraph
    , Strong
    , Emphasis
+   , Text
    , Syntax.Error Error
    ]
 
@@ -54,6 +55,12 @@ newtype Emphasis a = Emphasis [a]
 instance Eq1 Emphasis where liftEq = genericLiftEq
 instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
 
+newtype Text a = Text ByteString
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Text where liftEq = genericLiftEq
+instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
+
 type Error = Assignment.Error Grammar.Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
 type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
@@ -62,7 +69,7 @@ assignment :: Assignment
 assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many paragraph)
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis
+inlineElement = strong <|> emphasis <|> text
 
 strong :: Assignment
 strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
@@ -73,6 +80,8 @@ emphasis = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inli
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
 
+text :: Assignment
+text = makeTerm <$> symbol Grammar.Text <*> (Text <$> source)
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f

From 7ad8f25919a599152a7e04fcfedf15e3c7b8f4b8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:43:36 -0400
Subject: [PATCH 53/89] Always show the root error.

---
 src/Parser.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index 8893aadd8..debb779cb 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -71,9 +71,10 @@ runParser parser = case parser of
   AssignmentParser parser by assignment -> \ source -> do
     ast <- runParser parser source
     let Result err term = assignBy by assignment source ast
+    traverse_ (putStrLn . showError source) (toList err)
     case term of
       Just term -> do
-        let errors = toList err <> termErrors term
+        let errors = termErrors term `asTypeOf` toList err
         traverse_ (putStrLn . showError source) errors
         unless (Prologue.null errors) $
           putStrLn (withSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Vivid Red] (shows (Prologue.length errors) . showChar ' ' . showString (if Prologue.length errors == 1 then "error" else "errors")) $ "")

From cc2547d5eeb7a1ae75c9ffd742373037d22eb124 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:44:51 -0400
Subject: [PATCH 54/89] Correct the emphasis rule.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 92ea16c71..aa52d897e 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -75,7 +75,7 @@ strong :: Assignment
 strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
 
 emphasis :: Assignment
-emphasis = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
+emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Emphasis <$> many inlineElement)
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)

From 6949afe608961275626a605b017fa8f8137889f5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:45:45 -0400
Subject: [PATCH 55/89] Group inline/block elements.

---
 src/Language/Markdown/Syntax.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index aa52d897e..153cc47bf 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -68,6 +68,14 @@ type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMar
 assignment :: Assignment
 assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many paragraph)
 
+-- Block elements
+
+paragraph :: Assignment
+paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
+
+
+-- Inline elements
+
 inlineElement :: Assignment
 inlineElement = strong <|> emphasis <|> text
 
@@ -77,11 +85,9 @@ strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inline
 emphasis :: Assignment
 emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Emphasis <$> many inlineElement)
 
-paragraph :: Assignment
-paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
-
 text :: Assignment
 text = makeTerm <$> symbol Grammar.Text <*> (Text <$> source)
 
+
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f

From b9c8e9964ffd9a8d89e899aefd3972ca02fb0edc Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:46:21 -0400
Subject: [PATCH 56/89] Use a helper to parse block elements.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 153cc47bf..6c130972a 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -66,10 +66,13 @@ type Term = Term.Term (Union Syntax) (Record Location)
 type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
 
 assignment :: Assignment
-assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many paragraph)
+assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many blockElement)
 
 -- Block elements
 
+blockElement :: Assignment
+blockElement = paragraph
+
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
 

From a657ff311fc2a85827e059e6843c591ede803ac7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:47:42 -0400
Subject: [PATCH 57/89] Stub in parsing of lists.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

NB: this doesn’t currently respect ordered/unordered.
---
 src/Language/Markdown/Syntax.hs | 8 ++++++--
 1 file changed, 6 insertions(+), 2 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 6c130972a..cd40a0922 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -19,7 +19,7 @@ import GHC.Stack
 import qualified Language.Markdown as Grammar (Grammar(..))
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax as Syntax
-import Prologue hiding (Location, Text)
+import Prologue hiding (Location, Text, list)
 import qualified Term
 
 type Syntax =
@@ -29,6 +29,7 @@ type Syntax =
    , Emphasis
    , Text
    , Syntax.Error Error
+   , []
    ]
 
 newtype Document a = Document [a]
@@ -71,11 +72,14 @@ assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> man
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph
+blockElement = paragraph <|> list
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
 
+list :: Assignment
+list = makeTerm <$> symbol Grammar.List <*> children (many blockElement)
+
 
 -- Inline elements
 

From bcc642a976ff72550e6ef79d3ca84bfe34495944 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 18:54:25 -0400
Subject: [PATCH 58/89] Assign headings.

---
 src/Language/Markdown.hs        |  2 +-
 src/Language/Markdown/Syntax.hs | 16 +++++++++++++---
 2 files changed, 14 insertions(+), 4 deletions(-)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index 2314f6b48..7be2cb024 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -3,7 +3,7 @@ module Language.Markdown
 ( Grammar(..)
 , cmarkParser
 , toGrammar
-, NodeType
+, NodeType(..)
 ) where
 
 import CMark
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index cd40a0922..e68b83b79 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE DataKinds, DeriveAnyClass, RankNTypes, TypeOperators #-}
+{-# LANGUAGE DataKinds, DeriveAnyClass, GADTs, RankNTypes, TypeOperators #-}
 module Language.Markdown.Syntax
 ( assignment
 , Syntax
@@ -16,7 +16,7 @@ import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
 import GHC.Generics
 import GHC.Stack
-import qualified Language.Markdown as Grammar (Grammar(..))
+import qualified Language.Markdown as Grammar (Grammar(..), NodeType(..))
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax as Syntax
 import Prologue hiding (Location, Text, list)
@@ -25,6 +25,7 @@ import qualified Term
 type Syntax =
   '[ Document
    , Paragraph
+   , Heading
    , Strong
    , Emphasis
    , Text
@@ -44,6 +45,12 @@ newtype Paragraph a = Paragraph [a]
 instance Eq1 Paragraph where liftEq = genericLiftEq
 instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
 
+data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Heading where liftEq = genericLiftEq
+instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
+
 newtype Strong a = Strong [a]
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
@@ -72,7 +79,7 @@ assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> man
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list
+blockElement = paragraph <|> list <|> heading
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
@@ -80,6 +87,9 @@ paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> ma
 list :: Assignment
 list = makeTerm <$> symbol Grammar.List <*> children (many blockElement)
 
+heading :: Assignment
+heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> withNode (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
+
 
 -- Inline elements
 

From 96a0df33fef3692fc83152119f5694f7514587d5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:03:02 -0400
Subject: [PATCH 59/89] Assign list items.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index e68b83b79..f86c76240 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -85,7 +85,10 @@ paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
 
 list :: Assignment
-list = makeTerm <$> symbol Grammar.List <*> children (many blockElement)
+list = makeTerm <$> symbol Grammar.List <*> children (many item)
+
+item :: Assignment
+item = symbol Grammar.Item *> children blockElement
 
 heading :: Assignment
 heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> withNode (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))

From 9620b09003d9d6ad3febbb8f96b9ce3f21b9cfb4 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:07:00 -0400
Subject: [PATCH 60/89] Rename withNode to project.

---
 src/Data/Syntax/Assignment.hs   | 32 ++++++++++++++++----------------
 src/Language/Markdown/Syntax.hs |  2 +-
 2 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index 059c6368d..8bd6d4e3c 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -64,7 +64,7 @@ module Data.Syntax.Assignment
 , Location
 , AST
 , location
-, withNode
+, Data.Syntax.Assignment.project
 , symbol
 , source
 , children
@@ -83,7 +83,7 @@ module Data.Syntax.Assignment
 import Control.Monad.Free.Freer
 import Data.ByteString (isSuffixOf)
 import Data.Functor.Classes
-import Data.Functor.Foldable hiding (Nil)
+import Data.Functor.Foldable as F hiding (Nil)
 import qualified Data.IntMap.Lazy as IntMap
 import Data.Ix (inRange)
 import Data.List.NonEmpty (nonEmpty)
@@ -105,7 +105,7 @@ type Assignment ast grammar = Freer (AssignmentF ast grammar)
 
 data AssignmentF ast grammar a where
   Location :: HasCallStack => AssignmentF ast grammar (Record Location)
-  WithNode :: HasCallStack => (forall x. Base ast x -> a) -> AssignmentF ast grammar a
+  Project :: HasCallStack => (forall x. Base ast x -> a) -> AssignmentF ast grammar a
   Source :: HasCallStack => AssignmentF ast grammar ByteString
   Children :: HasCallStack => Assignment ast grammar a -> AssignmentF ast grammar a
   Choose :: HasCallStack => IntMap.IntMap a -> AssignmentF ast grammar a
@@ -122,9 +122,9 @@ location = Location `Then` return
 
 -- | Zero-width projection 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 (withNode f *> b)' is fine, but 'many (withNode f)' is not.
-withNode :: HasCallStack => (forall x. Base ast x -> a) -> Assignment ast grammar a
-withNode projection = WithNode projection `Then` return
+--   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (project f *> b)' is fine, but 'many (project f)' is not.
+project :: HasCallStack => (forall x. Base ast x -> a) -> Assignment ast grammar a
+project projection = Project projection `Then` return
 
 -- | Zero-width match of a node with the given symbol, producing the current node’s location.
 --
@@ -209,7 +209,7 @@ assignAllFrom :: (Symbol grammar, Enum grammar, Eq grammar, Recursive ast, Folda
 assignAllFrom toRecord assignment state = case runAssignment toRecord assignment state of
   Result err (Just (a, state)) -> case stateNodes (dropAnonymous (rhead . toRecord) state) of
     [] -> pure (a, state)
-    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (rhead (toRecord (project node)))))) Nothing
+    node : _ -> Result (err <|> Just (Error (statePos state) (maybe (ParseError []) (UnexpectedSymbol []) (rhead (toRecord (F.project node)))))) Nothing
   r -> r
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
@@ -217,14 +217,14 @@ runAssignment :: forall grammar a ast. (Symbol grammar, Enum grammar, Eq grammar
 runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
   where run :: AssignmentF ast grammar x -> (x -> AssignmentState ast -> Result grammar (a, AssignmentState ast)) -> AssignmentState ast -> Result grammar (a, AssignmentState ast)
         run assignment yield initialState = case (assignment, stateNodes) of
-          (Location, node : _) -> yield (rtail (toRecord (project node))) state
+          (Location, node : _) -> yield (rtail (toRecord (F.project node))) state
           (Location, []) -> yield (Info.Range stateOffset stateOffset :. Info.SourceSpan statePos statePos :. Nil) state
-          (WithNode projection, node : _) -> yield (projection (project node)) state
-          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (toRecord (project node))) (negate stateOffset)) stateSource)) (advanceState (rtail . toRecord) state)
-          (Children childAssignment, node : _) -> case assignAllFrom toRecord childAssignment state { stateNodes = toList (project node) } of
+          (Project projection, node : _) -> yield (projection (F.project node)) state
+          (Source, node : _) -> yield (Source.sourceText (Source.slice (offsetRange (Info.byteRange (toRecord (F.project node))) (negate stateOffset)) stateSource)) (advanceState (rtail . toRecord) state)
+          (Children childAssignment, node : _) -> case assignAllFrom toRecord childAssignment state { stateNodes = toList (F.project node) } of
             Result _ (Just (a, state')) -> yield a (advanceState (rtail . toRecord) state' { stateNodes = stateNodes })
             Result err Nothing -> Result err Nothing
-          (Choose choices, node : _) | Just symbol :. _ <- toRecord (project node), Just a <- IntMap.lookup (fromEnum symbol) choices -> yield a state
+          (Choose choices, node : _) | Just symbol :. _ <- toRecord (F.project node), 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
           (Throw e, _) -> Result (Just e) Nothing
@@ -232,7 +232,7 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
             Result _ (Just (a, state')) -> pure (a, state')
             Result err Nothing -> maybe empty (flip yield state . handler) err
           (_, []) -> Result (Just (Error statePos (UnexpectedEndOfInput expectedSymbols))) Nothing
-          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (toRecord (project node)) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> rhead (toRecord (project node)) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
+          (_, node:_) -> let Info.SourceSpan startPos _ = Info.sourceSpan (toRecord (F.project node)) in Result (Error startPos . UnexpectedSymbol expectedSymbols <$> rhead (toRecord (F.project node)) <|> Just (Error startPos (ParseError expectedSymbols))) Nothing
           where state@AssignmentState{..} = case assignment of
                   Choose choices | all ((== Regular) . symbolType) (choiceSymbols choices) -> dropAnonymous (rhead . toRecord) initialState
                   _ -> initialState
@@ -242,13 +242,13 @@ runAssignment toRecord = iterFreer run . fmap ((pure .) . (,))
                 choiceSymbols choices = (toEnum :: Int -> grammar) <$> IntMap.keys choices
 
 dropAnonymous :: (Symbol grammar, Recursive ast) => (forall x. Base ast x -> Maybe grammar) -> AssignmentState ast -> AssignmentState ast
-dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . project) (stateNodes state) }
+dropAnonymous toSymbol state = state { stateNodes = dropWhile ((`notElem` [Just Regular, Nothing]) . fmap symbolType . toSymbol . F.project) (stateNodes state) }
 
 -- | Advances the state past the current (head) node (if any), dropping it off stateNodes & its corresponding bytes off of stateSource, and updating stateOffset & statePos to its end. Exhausted 'AssignmentState's (those without any remaining nodes) are returned unchanged.
 advanceState :: Recursive ast => (forall x. Base ast x -> Record Location) -> AssignmentState ast -> AssignmentState ast
 advanceState toLocation state@AssignmentState{..}
   | node : rest <- stateNodes
-  , range :. span :. Nil <- toLocation (project node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
+  , range :. span :. Nil <- toLocation (F.project node) = AssignmentState (Info.end range) (Info.spanEnd span) (Source.drop (Info.end range - stateOffset) stateSource) rest
   | otherwise = state
 
 -- | State kept while running 'Assignment's.
@@ -279,7 +279,7 @@ instance Enum grammar => Alternative (Assignment ast grammar) where
 instance Show grammar => Show1 (AssignmentF ast grammar) where
   liftShowsPrec sp sl d a = case a of
     Location -> showString "Location" . sp d (Info.Range 0 0 :. Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0) :. Nil)
-    WithNode projection -> showsUnaryWith (const (const (showChar '_'))) "WithNode" d projection
+    Project projection -> showsUnaryWith (const (const (showChar '_'))) "Project" d projection
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
     Choose choices -> showsUnaryWith (liftShowsPrec (liftShowsPrec sp sl) (liftShowList sp sl)) "Choose" d (IntMap.toList choices)
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index f86c76240..91ff96a80 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -91,7 +91,7 @@ item :: Assignment
 item = symbol Grammar.Item *> children blockElement
 
 heading :: Assignment
-heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> withNode (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
+heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
 
 
 -- Inline elements

From 4937788a97b3e67f75e71eebe5fdf3c599a7c812 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:09:17 -0400
Subject: [PATCH 61/89] Correct the SourcePos to be 1-indexed.

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

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index 7be2cb024..ee693e6e2 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -45,7 +45,7 @@ cmarkParser source = pure . toTerm (totalRange source) (totalSpan source) $ comm
               span = maybe withinSpan toSpan position
           in cofree $ (t :. range :. span :. Nil) :< (toTerm range span <$> children)
 
-        toSpan PosInfo{..} = SourceSpan (SourcePos (pred startLine) (pred startColumn)) (SourcePos (pred endLine) endColumn)
+        toSpan PosInfo{..} = SourceSpan (SourcePos startLine startColumn) (SourcePos endLine (succ endColumn))
 
 toGrammar :: NodeType -> Grammar
 toGrammar DOCUMENT{} = Document

From 4233a0eec363c354387e14e95013ec277275dc31 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:10:24 -0400
Subject: [PATCH 62/89] Sort imports.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 91ff96a80..a41812ab7 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -14,11 +14,11 @@ import Data.Functor.Classes.Show.Generic
 import Data.Functor.Union
 import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
+import qualified Data.Syntax.Assignment as Assignment
+import qualified Data.Syntax as Syntax
 import GHC.Generics
 import GHC.Stack
 import qualified Language.Markdown as Grammar (Grammar(..), NodeType(..))
-import qualified Data.Syntax.Assignment as Assignment
-import qualified Data.Syntax as Syntax
 import Prologue hiding (Location, Text, list)
 import qualified Term
 

From a60f9954f4d508ab1fe395240f44b3a20eaccc3c Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:11:03 -0400
Subject: [PATCH 63/89] Stub in a Markup module.

---
 semantic-diff.cabal       | 1 +
 src/Data/Syntax/Markup.hs | 1 +
 2 files changed, 2 insertions(+)
 create mode 100644 src/Data/Syntax/Markup.hs

diff --git a/semantic-diff.cabal b/semantic-diff.cabal
index 14a6e1039..c97a5558f 100644
--- a/semantic-diff.cabal
+++ b/semantic-diff.cabal
@@ -36,6 +36,7 @@ library
                      , Data.Syntax.Declaration
                      , Data.Syntax.Expression
                      , Data.Syntax.Literal
+                     , Data.Syntax.Markup
                      , Data.Syntax.Statement
                      , Data.Syntax.Type
                      , Data.Text.Listable
diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
new file mode 100644
index 000000000..0fc7ed38c
--- /dev/null
+++ b/src/Data/Syntax/Markup.hs
@@ -0,0 +1 @@
+module Data.Syntax.Markup where

From 988cbdb4048f5f8a9fad7088a08e05ab98391b31 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:13:49 -0400
Subject: [PATCH 64/89] Move the markup datatypes to their own module.

---
 src/Data/Syntax/Markup.hs       | 43 +++++++++++++++++++++
 src/Language/Markdown/Syntax.hs | 67 +++++++--------------------------
 2 files changed, 57 insertions(+), 53 deletions(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 0fc7ed38c..7fc5265e0 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -1 +1,44 @@
+{-# LANGUAGE DeriveAnyClass #-}
 module Data.Syntax.Markup where
+
+import Data.Align.Generic
+import Data.Functor.Classes.Eq.Generic
+import Data.Functor.Classes.Show.Generic
+import GHC.Generics
+import Prologue hiding (Text)
+
+newtype Document a = Document [a]
+ deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Document where liftEq = genericLiftEq
+instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
+
+newtype Paragraph a = Paragraph [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Paragraph where liftEq = genericLiftEq
+instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
+
+data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Heading where liftEq = genericLiftEq
+instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
+
+newtype Strong a = Strong [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Strong where liftEq = genericLiftEq
+instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
+
+newtype Emphasis a = Emphasis [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Emphasis where liftEq = genericLiftEq
+instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
+
+newtype Text a = Text ByteString
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Text where liftEq = genericLiftEq
+instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index a41812ab7..2c5526339 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -8,73 +8,34 @@ module Language.Markdown.Syntax
 ) where
 
 import qualified CMark
-import Data.Align.Generic
-import Data.Functor.Classes.Eq.Generic
-import Data.Functor.Classes.Show.Generic
 import Data.Functor.Union
 import Data.Record
 import Data.Syntax.Assignment hiding (Assignment, Error)
 import qualified Data.Syntax.Assignment as Assignment
+import qualified Data.Syntax.Markup as Markup
 import qualified Data.Syntax as Syntax
-import GHC.Generics
 import GHC.Stack
 import qualified Language.Markdown as Grammar (Grammar(..), NodeType(..))
-import Prologue hiding (Location, Text, list)
+import Prologue hiding (Location, list)
 import qualified Term
 
 type Syntax =
-  '[ Document
-   , Paragraph
-   , Heading
-   , Strong
-   , Emphasis
-   , Text
+  '[ Markup.Document
+   , Markup.Emphasis
+   , Markup.Heading
+   , Markup.Paragraph
+   , Markup.Strong
+   , Markup.Text
    , Syntax.Error Error
    , []
    ]
 
-newtype Document a = Document [a]
- deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Document where liftEq = genericLiftEq
-instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
-
-newtype Paragraph a = Paragraph [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Paragraph where liftEq = genericLiftEq
-instance Show1 Paragraph where liftShowsPrec = genericLiftShowsPrec
-
-data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Heading where liftEq = genericLiftEq
-instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
-
-newtype Strong a = Strong [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Strong where liftEq = genericLiftEq
-instance Show1 Strong where liftShowsPrec = genericLiftShowsPrec
-
-newtype Emphasis a = Emphasis [a]
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Emphasis where liftEq = genericLiftEq
-instance Show1 Emphasis where liftShowsPrec = genericLiftShowsPrec
-
-newtype Text a = Text ByteString
-  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
-
-instance Eq1 Text where liftEq = genericLiftEq
-instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
-
 type Error = Assignment.Error Grammar.Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
 type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
 
 assignment :: Assignment
-assignment = makeTerm <$> symbol Grammar.Document <*> children (Document <$> many blockElement)
+assignment = makeTerm <$> symbol Grammar.Document <*> children (Markup.Document <$> many blockElement)
 
 -- Block elements
 
@@ -82,7 +43,7 @@ blockElement :: Assignment
 blockElement = paragraph <|> list <|> heading
 
 paragraph :: Assignment
-paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Paragraph <$> many inlineElement)
+paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
 
 list :: Assignment
 list = makeTerm <$> symbol Grammar.List <*> children (many item)
@@ -91,7 +52,7 @@ item :: Assignment
 item = symbol Grammar.Item *> children blockElement
 
 heading :: Assignment
-heading = makeTerm <$> symbol Grammar.Heading <*> (Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
+heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
 
 
 -- Inline elements
@@ -100,13 +61,13 @@ inlineElement :: Assignment
 inlineElement = strong <|> emphasis <|> text
 
 strong :: Assignment
-strong = makeTerm <$> symbol Grammar.Strong <*> children (Strong <$> many inlineElement)
+strong = makeTerm <$> symbol Grammar.Strong <*> children (Markup.Strong <$> many inlineElement)
 
 emphasis :: Assignment
-emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Emphasis <$> many inlineElement)
+emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
 
 text :: Assignment
-text = makeTerm <$> symbol Grammar.Text <*> (Text <$> source)
+text = makeTerm <$> symbol Grammar.Text <*> (Markup.Text <$> source)
 
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a

From cf47ee0e2c2d6d6baef4a86e04e6267e6fb38530 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:14:36 -0400
Subject: [PATCH 65/89] Group the markup datatypes under headings.

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

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 7fc5265e0..acc616fcf 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -7,12 +7,16 @@ import Data.Functor.Classes.Show.Generic
 import GHC.Generics
 import Prologue hiding (Text)
 
+
 newtype Document a = Document [a]
  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Document where liftEq = genericLiftEq
 instance Show1 Document where liftShowsPrec = genericLiftShowsPrec
 
+
+-- Block elements
+
 newtype Paragraph a = Paragraph [a]
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
@@ -25,6 +29,9 @@ data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
 instance Eq1 Heading where liftEq = genericLiftEq
 instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
+
+-- Inline elements
+
 newtype Strong a = Strong [a]
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 

From 9638c5d09271de3e96bed21718ebc8ca0134b3da Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:15:55 -0400
Subject: [PATCH 66/89] Define ordered and unordered lists.

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

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index acc616fcf..1a68c911f 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -29,6 +29,18 @@ data Heading a = Heading { headingLevel :: Int, headingContent :: [a] }
 instance Eq1 Heading where liftEq = genericLiftEq
 instance Show1 Heading where liftShowsPrec = genericLiftShowsPrec
 
+newtype UnorderedList a = UnorderedList [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 UnorderedList where liftEq = genericLiftEq
+instance Show1 UnorderedList where liftShowsPrec = genericLiftShowsPrec
+
+newtype OrderedList a = OrderedList [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 OrderedList where liftEq = genericLiftEq
+instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 

From cefb39cc29fe2b8a82c7b7ec8b4e91b24ceb718e Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:18:03 -0400
Subject: [PATCH 67/89] Reference HEADING via the CMark module.

---
 src/Language/Markdown.hs        | 1 -
 src/Language/Markdown/Syntax.hs | 4 ++--
 2 files changed, 2 insertions(+), 3 deletions(-)

diff --git a/src/Language/Markdown.hs b/src/Language/Markdown.hs
index ee693e6e2..1c9aba4d7 100644
--- a/src/Language/Markdown.hs
+++ b/src/Language/Markdown.hs
@@ -3,7 +3,6 @@ module Language.Markdown
 ( Grammar(..)
 , cmarkParser
 , toGrammar
-, NodeType(..)
 ) where
 
 import CMark
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 2c5526339..8a0869bd9 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -15,7 +15,7 @@ import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Markup as Markup
 import qualified Data.Syntax as Syntax
 import GHC.Stack
-import qualified Language.Markdown as Grammar (Grammar(..), NodeType(..))
+import qualified Language.Markdown as Grammar (Grammar(..))
 import Prologue hiding (Location, list)
 import qualified Term
 
@@ -52,7 +52,7 @@ item :: Assignment
 item = symbol Grammar.Item *> children blockElement
 
 heading :: Assignment
-heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\ ((Grammar.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
+heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
 
 
 -- Inline elements

From 429bb4bf966a87bb09d060bdfe0201679ff41b21 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:22:48 -0400
Subject: [PATCH 68/89] Correct the reference to NodeType in Parser.

---
 src/Parser.hs | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/src/Parser.hs b/src/Parser.hs
index debb779cb..47edb2aab 100644
--- a/src/Parser.hs
+++ b/src/Parser.hs
@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}
 module Parser where
 
+import qualified CMark
 import Data.Functor.Union
 import Data.Record
 import qualified Data.Syntax as Syntax
@@ -42,7 +43,7 @@ data Parser term where
   -- | A tree-sitter parser.
   TreeSitterParser :: Language -> Ptr TS.Language -> Parser (SyntaxTerm Text DefaultFields)
   -- | A parser for 'Markdown' using cmark.
-  MarkdownParser :: Parser (Cofree [] (Record (NodeType ': Location)))
+  MarkdownParser :: Parser (Cofree [] (Record (CMark.NodeType ': Location)))
   -- | A parser which will parse any input 'Source' into a top-level 'Term' whose children are leaves consisting of the 'Source's lines.
   LineByLineParser :: Parser (SyntaxTerm Text DefaultFields)
 

From 1bdead623c8d18d1ac803e95a8d4f1d4a5e93c02 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:23:14 -0400
Subject: [PATCH 69/89] Assign ordered/unordered lists into distinct
 structures.

---
 src/Language/Markdown/Syntax.hs | 12 +++++++++---
 1 file changed, 9 insertions(+), 3 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 8a0869bd9..b44018463 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -21,13 +21,17 @@ import qualified Term
 
 type Syntax =
   '[ Markup.Document
-   , Markup.Emphasis
+   -- Block elements
    , Markup.Heading
+   , Markup.OrderedList
    , Markup.Paragraph
+   , Markup.UnorderedList
+   -- Inline elements
+   , Markup.Emphasis
    , Markup.Strong
    , Markup.Text
+   -- Assignment errors; cmark does not provide parse errors.
    , Syntax.Error Error
-   , []
    ]
 
 type Error = Assignment.Error Grammar.Grammar
@@ -46,7 +50,9 @@ paragraph :: Assignment
 paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
 
 list :: Assignment
-list = makeTerm <$> symbol Grammar.List <*> children (many item)
+list = (cofree .) . (:<) <$> symbol Grammar.List <*> (project (\ (((CMark.LIST CMark.ListAttributes{..}) :. _) :< _) -> case listType of
+  CMark.BULLET_LIST -> inj . Markup.UnorderedList
+  CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
 
 item :: Assignment
 item = symbol Grammar.Item *> children blockElement

From 83aa91006f805c358e14e315a5708a17319055d5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:23:47 -0400
Subject: [PATCH 70/89] Spacing.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index b44018463..f45cc9737 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -38,9 +38,11 @@ type Error = Assignment.Error Grammar.Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
 type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
 
+
 assignment :: Assignment
 assignment = makeTerm <$> symbol Grammar.Document <*> children (Markup.Document <$> many blockElement)
 
+
 -- Block elements
 
 blockElement :: Assignment

From 5598b8b581ee3f6350a2307343d50ec9b745df11 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:27:34 -0400
Subject: [PATCH 71/89] Assign links.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 8 ++++++--
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 1a68c911f..c9def25dc 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -61,3 +61,9 @@ newtype Text a = Text ByteString
 
 instance Eq1 Text where liftEq = genericLiftEq
 instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
+
+data Link a = Link { linkURL :: ByteString, linkTitle :: ByteString }
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Link where liftEq = genericLiftEq
+instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index f45cc9737..3503b2f59 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -16,7 +16,7 @@ import qualified Data.Syntax.Markup as Markup
 import qualified Data.Syntax as Syntax
 import GHC.Stack
 import qualified Language.Markdown as Grammar (Grammar(..))
-import Prologue hiding (Location, list)
+import Prologue hiding (Location, link, list)
 import qualified Term
 
 type Syntax =
@@ -28,6 +28,7 @@ type Syntax =
    , Markup.UnorderedList
    -- Inline elements
    , Markup.Emphasis
+   , Markup.Link
    , Markup.Strong
    , Markup.Text
    -- Assignment errors; cmark does not provide parse errors.
@@ -66,7 +67,7 @@ heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis <|> text
+inlineElement = strong <|> emphasis <|> text <|> link
 
 strong :: Assignment
 strong = makeTerm <$> symbol Grammar.Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -77,6 +78,9 @@ emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Markup.Emphasis <$
 text :: Assignment
 text = makeTerm <$> symbol Grammar.Text <*> (Markup.Text <$> source)
 
+link :: Assignment
+link = makeTerm <$> symbol Grammar.Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
+
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f

From 27b4484aee35253a522c99548965e1cd2be10bb7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:28:19 -0400
Subject: [PATCH 72/89] Add a section header for implementation details.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 3503b2f59..9a11b1b12 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -82,5 +82,7 @@ link :: Assignment
 link = makeTerm <$> symbol Grammar.Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
 
 
+-- Implementation details
+
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f

From 7591e154313807c819c7e0b5263bacadeb95bc75 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:30:39 -0400
Subject: [PATCH 73/89] Unqualify the grammar type.

---
 src/Language/Markdown/Syntax.hs | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 9a11b1b12..5e70f2b1e 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -2,7 +2,7 @@
 module Language.Markdown.Syntax
 ( assignment
 , Syntax
-, Grammar.Grammar
+, Grammar
 , Error
 , Term
 ) where
@@ -15,7 +15,7 @@ import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Markup as Markup
 import qualified Data.Syntax as Syntax
 import GHC.Stack
-import qualified Language.Markdown as Grammar (Grammar(..))
+import Language.Markdown as Grammar (Grammar(..))
 import Prologue hiding (Location, link, list)
 import qualified Term
 
@@ -35,13 +35,13 @@ type Syntax =
    , Syntax.Error Error
    ]
 
-type Error = Assignment.Error Grammar.Grammar
+type Error = Assignment.Error Grammar
 type Term = Term.Term (Union Syntax) (Record Location)
-type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar.Grammar Term
+type Assignment = HasCallStack => Assignment.Assignment (Cofree [] (Record (CMark.NodeType ': Location))) Grammar Term
 
 
 assignment :: Assignment
-assignment = makeTerm <$> symbol Grammar.Document <*> children (Markup.Document <$> many blockElement)
+assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many blockElement)
 
 
 -- Block elements
@@ -50,18 +50,18 @@ blockElement :: Assignment
 blockElement = paragraph <|> list <|> heading
 
 paragraph :: Assignment
-paragraph = makeTerm <$> symbol Grammar.Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
+paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
 
 list :: Assignment
-list = (cofree .) . (:<) <$> symbol Grammar.List <*> (project (\ (((CMark.LIST CMark.ListAttributes{..}) :. _) :< _) -> case listType of
+list = (cofree .) . (:<) <$> symbol List <*> (project (\ (((CMark.LIST CMark.ListAttributes{..}) :. _) :< _) -> case listType of
   CMark.BULLET_LIST -> inj . Markup.UnorderedList
   CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
 
 item :: Assignment
-item = symbol Grammar.Item *> children blockElement
+item = symbol Item *> children blockElement
 
 heading :: Assignment
-heading = makeTerm <$> symbol Grammar.Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
+heading = makeTerm <$> symbol Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
 
 
 -- Inline elements
@@ -70,16 +70,16 @@ inlineElement :: Assignment
 inlineElement = strong <|> emphasis <|> text <|> link
 
 strong :: Assignment
-strong = makeTerm <$> symbol Grammar.Strong <*> children (Markup.Strong <$> many inlineElement)
+strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
 
 emphasis :: Assignment
-emphasis = makeTerm <$> symbol Grammar.Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
+emphasis = makeTerm <$> symbol Emphasis <*> children (Markup.Emphasis <$> many inlineElement)
 
 text :: Assignment
-text = makeTerm <$> symbol Grammar.Text <*> (Markup.Text <$> source)
+text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 
 link :: Assignment
-link = makeTerm <$> symbol Grammar.Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
+link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
 
 
 -- Implementation details

From 046fec7f26fa18c994fa7f8c113bda07c2672b74 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:32:28 -0400
Subject: [PATCH 74/89] Assign block quotes.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index c9def25dc..bb19b408a 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -41,6 +41,12 @@ newtype OrderedList a = OrderedList [a]
 instance Eq1 OrderedList where liftEq = genericLiftEq
 instance Show1 OrderedList where liftShowsPrec = genericLiftShowsPrec
 
+newtype BlockQuote a = BlockQuote [a]
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 BlockQuote where liftEq = genericLiftEq
+instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 5e70f2b1e..381f7b6a7 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -22,6 +22,7 @@ import qualified Term
 type Syntax =
   '[ Markup.Document
    -- Block elements
+   , Markup.BlockQuote
    , Markup.Heading
    , Markup.OrderedList
    , Markup.Paragraph
@@ -47,7 +48,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list <|> heading
+blockElement = paragraph <|> list <|> heading <|> blockQuote
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -63,6 +64,9 @@ item = symbol Item *> children blockElement
 heading :: Assignment
 heading = makeTerm <$> symbol Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))
 
+blockQuote :: Assignment
+blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
+
 
 -- Inline elements
 

From b5a7b90d69ba60d031cfe804ea47faf8828473fe Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:33:58 -0400
Subject: [PATCH 75/89] Assign images.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index bb19b408a..be49ebeb7 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -73,3 +73,9 @@ data Link a = Link { linkURL :: ByteString, linkTitle :: ByteString }
 
 instance Eq1 Link where liftEq = genericLiftEq
 instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
+
+data Image a = Image { imageURL :: ByteString, imageTitle :: ByteString }
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Image where liftEq = genericLiftEq
+instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 381f7b6a7..c026f7f28 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -29,6 +29,7 @@ type Syntax =
    , Markup.UnorderedList
    -- Inline elements
    , Markup.Emphasis
+   , Markup.Image
    , Markup.Link
    , Markup.Strong
    , Markup.Text
@@ -71,7 +72,7 @@ blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$>
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis <|> text <|> link
+inlineElement = strong <|> emphasis <|> text <|> link <|> image
 
 strong :: Assignment
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -85,6 +86,9 @@ text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 link :: Assignment
 link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
 
+image :: Assignment
+image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, toS title))) <* source
+
 
 -- Implementation details
 

From 95811013bdbffdab3b7365409350af7fea5d64bd Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:36:26 -0400
Subject: [PATCH 76/89] Assign inline code.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index be49ebeb7..8e8de14f9 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -79,3 +79,9 @@ data Image a = Image { imageURL :: ByteString, imageTitle :: ByteString }
 
 instance Eq1 Image where liftEq = genericLiftEq
 instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
+
+data Code a = Code ByteString
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 Code where liftEq = genericLiftEq
+instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index c026f7f28..27e131825 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -28,6 +28,7 @@ type Syntax =
    , Markup.Paragraph
    , Markup.UnorderedList
    -- Inline elements
+   , Markup.Code
    , Markup.Emphasis
    , Markup.Image
    , Markup.Link
@@ -72,7 +73,7 @@ blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$>
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis <|> text <|> link <|> image
+inlineElement = strong <|> emphasis <|> text <|> link <|> image <|> code
 
 strong :: Assignment
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -89,6 +90,9 @@ link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark
 image :: Assignment
 image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, toS title))) <* source
 
+code :: Assignment
+code = makeTerm <$> symbol Code <*> (Markup.Code <$> source)
+
 
 -- Implementation details
 

From aea81fe41eb6f1fc6dbf3ddf5fe80e8b8511bcd9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:37:33 -0400
Subject: [PATCH 77/89] Code has an optional language.

---
 src/Data/Syntax/Markup.hs       | 2 +-
 src/Language/Markdown/Syntax.hs | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 8e8de14f9..d90c7cef0 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -80,7 +80,7 @@ data Image a = Image { imageURL :: ByteString, imageTitle :: ByteString }
 instance Eq1 Image where liftEq = genericLiftEq
 instance Show1 Image where liftShowsPrec = genericLiftShowsPrec
 
-data Code a = Code ByteString
+data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Code where liftEq = genericLiftEq
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 27e131825..44936405a 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -91,7 +91,7 @@ image :: Assignment
 image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, toS title))) <* source
 
 code :: Assignment
-code = makeTerm <$> symbol Code <*> (Markup.Code <$> source)
+code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
 
 
 -- Implementation details

From 33f3871a4357097c07cf8204af688e8f1adb2e62 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:39:35 -0400
Subject: [PATCH 78/89] Assign code blocks.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 44936405a..bb406855f 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -50,7 +50,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list <|> heading <|> blockQuote
+blockElement = paragraph <|> list <|> heading <|> blockQuote <|> codeBlock
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -69,6 +69,9 @@ heading = makeTerm <$> symbol Heading <*> (Markup.Heading <$> project (\ ((CMark
 blockQuote :: Assignment
 blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
 
+codeBlock :: Assignment
+codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code . Just . toS <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> language) <*> source)
+
 
 -- Inline elements
 

From a2b931c6ac7920bcfb52eb24c456cfa4d77672e9 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:41:59 -0400
Subject: [PATCH 79/89] =?UTF-8?q?Code=20blocks=20have=20Nothing=20for=20th?=
 =?UTF-8?q?e=20language=20when=20it=E2=80=99s=20not=20provided.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index bb406855f..8599d8a8f 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -14,6 +14,7 @@ import Data.Syntax.Assignment hiding (Assignment, Error)
 import qualified Data.Syntax.Assignment as Assignment
 import qualified Data.Syntax.Markup as Markup
 import qualified Data.Syntax as Syntax
+import qualified Data.Text as Text
 import GHC.Stack
 import Language.Markdown as Grammar (Grammar(..))
 import Prologue hiding (Location, link, list)
@@ -70,7 +71,7 @@ blockQuote :: Assignment
 blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
 
 codeBlock :: Assignment
-codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code . Just . toS <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> language) <*> source)
+codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> if Text.null language then Nothing else Just (toS language)) <*> source)
 
 
 -- Inline elements

From 6d7602dc6459524a5ddcbf7b465ac8335a8caf24 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:44:22 -0400
Subject: [PATCH 80/89] =?UTF-8?q?Links=E2=80=99=20&=20images=E2=80=99=20ti?=
 =?UTF-8?q?tles=20are=20optional.?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

---
 src/Data/Syntax/Markup.hs       | 4 ++--
 src/Language/Markdown/Syntax.hs | 9 ++++++---
 2 files changed, 8 insertions(+), 5 deletions(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index d90c7cef0..def75fef2 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -68,13 +68,13 @@ newtype Text a = Text ByteString
 instance Eq1 Text where liftEq = genericLiftEq
 instance Show1 Text where liftShowsPrec = genericLiftShowsPrec
 
-data Link a = Link { linkURL :: ByteString, linkTitle :: ByteString }
+data Link a = Link { linkURL :: ByteString, linkTitle :: Maybe ByteString }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Link where liftEq = genericLiftEq
 instance Show1 Link where liftShowsPrec = genericLiftShowsPrec
 
-data Image a = Image { imageURL :: ByteString, imageTitle :: ByteString }
+data Image a = Image { imageURL :: ByteString, imageTitle :: Maybe ByteString }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
 
 instance Eq1 Image where liftEq = genericLiftEq
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 8599d8a8f..b0db2859a 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -71,7 +71,7 @@ blockQuote :: Assignment
 blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$> many blockElement)
 
 codeBlock :: Assignment
-codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> if Text.null language then Nothing else Just (toS language)) <*> source)
+codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> nullText language) <*> source)
 
 
 -- Inline elements
@@ -89,10 +89,10 @@ text :: Assignment
 text = makeTerm <$> symbol Text <*> (Markup.Text <$> source)
 
 link :: Assignment
-link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, toS title))) <* source
+link = makeTerm <$> symbol Link <*> (uncurry Markup.Link <$> project (\ (((CMark.LINK url title) :. _) :< _) -> (toS url, nullText title))) <* source
 
 image :: Assignment
-image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, toS title))) <* source
+image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CMark.IMAGE url title) :. _) :< _) -> (toS url, nullText title))) <* source
 
 code :: Assignment
 code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
@@ -102,3 +102,6 @@ code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
 
 makeTerm :: (InUnion fs f, HasCallStack) => a -> f (Term.Term (Union fs) a) -> Term.Term (Union fs) a
 makeTerm a f = cofree $ a :< inj f
+
+nullText :: Text.Text -> Maybe ByteString
+nullText text = if Text.null text then Nothing else Just (toS text)

From 3e527cd7b8581b502e0fbedb8edc43eb5a808eb5 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:47:46 -0400
Subject: [PATCH 81/89] Add thematic breaks (separators, horizontal rules,
 lines).

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index def75fef2..726880b0c 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -47,6 +47,12 @@ newtype BlockQuote a = BlockQuote [a]
 instance Eq1 BlockQuote where liftEq = genericLiftEq
 instance Show1 BlockQuote where liftShowsPrec = genericLiftShowsPrec
 
+data ThematicBreak a = ThematicBreak
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 ThematicBreak where liftEq = genericLiftEq
+instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index b0db2859a..d610a0f55 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -27,6 +27,7 @@ type Syntax =
    , Markup.Heading
    , Markup.OrderedList
    , Markup.Paragraph
+   , Markup.ThematicBreak
    , Markup.UnorderedList
    -- Inline elements
    , Markup.Code
@@ -51,7 +52,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list <|> heading <|> blockQuote <|> codeBlock
+blockElement = paragraph <|> list <|> heading <|> blockQuote <|> codeBlock <|> thematicBreak
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -73,6 +74,9 @@ blockQuote = makeTerm <$> symbol BlockQuote <*> children (Markup.BlockQuote <$>
 codeBlock :: Assignment
 codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMark.CODE_BLOCK language _) :. _) :< _) -> nullText language) <*> source)
 
+thematicBreak :: Assignment
+thematicBreak = makeTerm <$> symbol ThematicBreak <*> (Markup.ThematicBreak <$ source)
+
 
 -- Inline elements
 

From ca2394e78ac7549b16398a61bdf68ae8030b77bb Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 19:56:54 -0400
Subject: [PATCH 82/89] Assign line breaks and soft breaks.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 9 ++++++++-
 2 files changed, 14 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index 726880b0c..a66db7ee6 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -91,3 +91,9 @@ data Code a = Code { codeLanguage :: Maybe ByteString, codeContent :: ByteString
 
 instance Eq1 Code where liftEq = genericLiftEq
 instance Show1 Code where liftShowsPrec = genericLiftShowsPrec
+
+data LineBreak a = LineBreak
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 LineBreak where liftEq = genericLiftEq
+instance Show1 LineBreak where liftShowsPrec = genericLiftShowsPrec
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index d610a0f55..83dc7edf3 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -33,6 +33,7 @@ type Syntax =
    , Markup.Code
    , Markup.Emphasis
    , Markup.Image
+   , Markup.LineBreak
    , Markup.Link
    , Markup.Strong
    , Markup.Text
@@ -81,7 +82,7 @@ thematicBreak = makeTerm <$> symbol ThematicBreak <*> (Markup.ThematicBreak <$ s
 -- Inline elements
 
 inlineElement :: Assignment
-inlineElement = strong <|> emphasis <|> text <|> link <|> image <|> code
+inlineElement = strong <|> emphasis <|> text <|> link <|> image <|> code <|> lineBreak <|> softBreak
 
 strong :: Assignment
 strong = makeTerm <$> symbol Strong <*> children (Markup.Strong <$> many inlineElement)
@@ -101,6 +102,12 @@ image = makeTerm <$> symbol Image <*> (uncurry Markup.Image <$> project (\ (((CM
 code :: Assignment
 code = makeTerm <$> symbol Code <*> (Markup.Code Nothing <$> source)
 
+lineBreak :: Assignment
+lineBreak = makeTerm <$> symbol LineBreak <*> (Markup.LineBreak <$ source)
+
+softBreak :: Assignment
+softBreak = makeTerm <$> symbol SoftBreak <*> (Markup.LineBreak <$ source)
+
 
 -- Implementation details
 

From 95924c1ba0763a818f1a101eb2c6eff48e34ed70 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:00:06 -0400
Subject: [PATCH 83/89] Assign HTML blocks.

---
 src/Data/Syntax/Markup.hs       | 6 ++++++
 src/Language/Markdown/Syntax.hs | 6 +++++-
 2 files changed, 11 insertions(+), 1 deletion(-)

diff --git a/src/Data/Syntax/Markup.hs b/src/Data/Syntax/Markup.hs
index a66db7ee6..b0b2636d6 100644
--- a/src/Data/Syntax/Markup.hs
+++ b/src/Data/Syntax/Markup.hs
@@ -53,6 +53,12 @@ data ThematicBreak a = ThematicBreak
 instance Eq1 ThematicBreak where liftEq = genericLiftEq
 instance Show1 ThematicBreak where liftShowsPrec = genericLiftShowsPrec
 
+data HTMLBlock a = HTMLBlock ByteString
+  deriving (Eq, Foldable, Functor, GAlign, Generic1, Show, Traversable)
+
+instance Eq1 HTMLBlock where liftEq = genericLiftEq
+instance Show1 HTMLBlock where liftShowsPrec = genericLiftShowsPrec
+
 
 -- Inline elements
 
diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index 83dc7edf3..dfcfb43c3 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -25,6 +25,7 @@ type Syntax =
    -- Block elements
    , Markup.BlockQuote
    , Markup.Heading
+   , Markup.HTMLBlock
    , Markup.OrderedList
    , Markup.Paragraph
    , Markup.ThematicBreak
@@ -53,7 +54,7 @@ assignment = makeTerm <$> symbol Document <*> children (Markup.Document <$> many
 -- Block elements
 
 blockElement :: Assignment
-blockElement = paragraph <|> list <|> heading <|> blockQuote <|> codeBlock <|> thematicBreak
+blockElement = paragraph <|> list <|> heading <|> blockQuote <|> codeBlock <|> thematicBreak <|> htmlBlock
 
 paragraph :: Assignment
 paragraph = makeTerm <$> symbol Paragraph <*> children (Markup.Paragraph <$> many inlineElement)
@@ -78,6 +79,9 @@ codeBlock = makeTerm <$> symbol CodeBlock <*> (Markup.Code <$> project (\ (((CMa
 thematicBreak :: Assignment
 thematicBreak = makeTerm <$> symbol ThematicBreak <*> (Markup.ThematicBreak <$ source)
 
+htmlBlock :: Assignment
+htmlBlock = makeTerm <$> symbol HTMLBlock <*> (Markup.HTMLBlock <$> source)
+
 
 -- Inline elements
 

From ec25974df284eb6e35506f719fcd42df34938e14 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:02:42 -0400
Subject: [PATCH 84/89] Short-circuit ToC for Markdown.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Later on we’ll want to define tables of contents for markup elements, but we don’t have a way to express their semantic role yet.
---
 src/Semantic.hs | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Semantic.hs b/src/Semantic.hs
index 984563354..8cd5a2032 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -60,6 +60,7 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) .
 diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task output
 diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
   (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source  >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs)
+  (ToCDiffRenderer, Just Language.Markdown) -> pure mempty
   (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs)
   (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)

From 511719b8b64a1bd6689dd159eba30238fe653c52 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:04:05 -0400
Subject: [PATCH 85/89] Diff Markdown.

---
 src/Semantic.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Semantic.hs b/src/Semantic.hs
index 8cd5a2032..9e36de644 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -63,10 +63,13 @@ diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
   (ToCDiffRenderer, Just Language.Markdown) -> pure mempty
   (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs)
   (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
+  (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)
   (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderPatch blobs)
+  (PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderPatch blobs)
   (PatchDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderPatch blobs)
   (SExpressionDiffRenderer, Just Language.Python) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse markdownParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
   (SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . mapAnnotations keepCategory)
   (IdentityDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms Just
   where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)

From c1a01b3dd2ab8f4356b3e7db733beecbeca3f5a8 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:04:39 -0400
Subject: [PATCH 86/89] Parse Markdown.

---
 src/Semantic.hs | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/src/Semantic.hs b/src/Semantic.hs
index 9e36de644..bbf190449 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -45,10 +45,13 @@ parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter
 parseBlob :: TermRenderer output -> SourceBlob -> Task output
 parseBlob renderer blob@SourceBlob{..} = case (renderer, blobLanguage) of
   (JSONTermRenderer, Just Language.Python) -> parse pythonParser source >>= render (renderJSONTerm blob)
+  (JSONTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= render (renderJSONTerm blob)
   (JSONTermRenderer, _) -> parse syntaxParser source >>= decorate identifierAlgebra >>= render (renderJSONTerm blob)
   (SExpressionTermRenderer, Just Language.Python) -> parse pythonParser source >>= decorate (ConstructorLabel . constructorLabel) >>= render renderSExpressionTerm . fmap keepConstructorLabel
+  (SExpressionTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= decorate (ConstructorLabel . constructorLabel) >>= render renderSExpressionTerm . fmap keepConstructorLabel
   (SExpressionTermRenderer, _) -> parse syntaxParser source >>= render renderSExpressionTerm . fmap keepCategory
   (IdentityTermRenderer, Just Language.Python) -> pure Nothing
+  (IdentityTermRenderer, Just Language.Markdown) -> pure Nothing
   (IdentityTermRenderer, _) -> Just <$> parse syntaxParser source
   where syntaxParser = parserForLanguage blobLanguage
 

From 571e9fe1aae14c0ce1ca9e86d62e4a1922e316e7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:05:16 -0400
Subject: [PATCH 87/89] Alphabetize the languages.

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

diff --git a/src/Semantic.hs b/src/Semantic.hs
index bbf190449..2e5e4a333 100644
--- a/src/Semantic.hs
+++ b/src/Semantic.hs
@@ -44,14 +44,14 @@ parseBlobs renderer = fmap toS . distributeFoldMap (parseBlob renderer) . filter
 -- | A task to parse a 'SourceBlob' and render the resulting 'Term'.
 parseBlob :: TermRenderer output -> SourceBlob -> Task output
 parseBlob renderer blob@SourceBlob{..} = case (renderer, blobLanguage) of
-  (JSONTermRenderer, Just Language.Python) -> parse pythonParser source >>= render (renderJSONTerm blob)
   (JSONTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= render (renderJSONTerm blob)
+  (JSONTermRenderer, Just Language.Python) -> parse pythonParser source >>= render (renderJSONTerm blob)
   (JSONTermRenderer, _) -> parse syntaxParser source >>= decorate identifierAlgebra >>= render (renderJSONTerm blob)
-  (SExpressionTermRenderer, Just Language.Python) -> parse pythonParser source >>= decorate (ConstructorLabel . constructorLabel) >>= render renderSExpressionTerm . fmap keepConstructorLabel
   (SExpressionTermRenderer, Just Language.Markdown) -> parse markdownParser source >>= decorate (ConstructorLabel . constructorLabel) >>= render renderSExpressionTerm . fmap keepConstructorLabel
+  (SExpressionTermRenderer, Just Language.Python) -> parse pythonParser source >>= decorate (ConstructorLabel . constructorLabel) >>= render renderSExpressionTerm . fmap keepConstructorLabel
   (SExpressionTermRenderer, _) -> parse syntaxParser source >>= render renderSExpressionTerm . fmap keepCategory
-  (IdentityTermRenderer, Just Language.Python) -> pure Nothing
   (IdentityTermRenderer, Just Language.Markdown) -> pure Nothing
+  (IdentityTermRenderer, Just Language.Python) -> pure Nothing
   (IdentityTermRenderer, _) -> Just <$> parse syntaxParser source
   where syntaxParser = parserForLanguage blobLanguage
 
@@ -62,17 +62,17 @@ diffBlobPairs renderer = fmap toS . distributeFoldMap (diffBlobPair renderer) .
 -- | A task to parse a pair of 'SourceBlob's, diff them, and render the 'Diff'.
 diffBlobPair :: DiffRenderer output -> Both SourceBlob -> Task output
 diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
-  (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source  >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs)
   (ToCDiffRenderer, Just Language.Markdown) -> pure mempty
+  (ToCDiffRenderer, Just Language.Python) -> run (\ source -> parse pythonParser source  >>= decorate (declarationAlgebra (Proxy :: Proxy Python.Error) source) . hoistCofree (weaken :: Union fs a -> Union (Declaration.Method ': fs) a)) diffLinearly (renderToC blobs)
   (ToCDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms (renderToC blobs)
-  (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderJSONDiff blobs)
+  (JSONDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderJSONDiff blobs)
   (JSONDiffRenderer, _) -> run (decorate identifierAlgebra <=< parse syntaxParser) diffTerms (renderJSONDiff blobs)
-  (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderPatch blobs)
   (PatchDiffRenderer, Just Language.Markdown) -> run (parse markdownParser) diffLinearly (renderPatch blobs)
+  (PatchDiffRenderer, Just Language.Python) -> run (parse pythonParser) diffLinearly (renderPatch blobs)
   (PatchDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderPatch blobs)
-  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
   (SExpressionDiffRenderer, Just Language.Markdown) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse markdownParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
+  (SExpressionDiffRenderer, Just Language.Python) -> run (decorate (ConstructorLabel . constructorLabel) <=< parse pythonParser) diffLinearly (renderSExpressionDiff . mapAnnotations keepConstructorLabel)
   (SExpressionDiffRenderer, _) -> run (parse syntaxParser) diffTerms (renderSExpressionDiff . mapAnnotations keepCategory)
   (IdentityDiffRenderer, _) -> run (\ source -> parse syntaxParser source >>= decorate (syntaxDeclarationAlgebra source)) diffTerms Just
   where effectiveLanguage = runBothWith (<|>) (blobLanguage <$> blobs)

From b019a2b23720406cad19ef16a2d32485341699b0 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Wed, 7 Jun 2017 20:17:14 -0400
Subject: [PATCH 88/89] Correct the spec.

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

diff --git a/test/Data/Syntax/Assignment/Spec.hs b/test/Data/Syntax/Assignment/Spec.hs
index c31d08895..0fe683429 100644
--- a/test/Data/Syntax/Assignment/Spec.hs
+++ b/test/Data/Syntax/Assignment/Spec.hs
@@ -14,79 +14,79 @@ spec :: Spec
 spec = do
   describe "Applicative" $
     it "matches in sequence" $
-      runAssignment ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) `shouldBe` Result Nothing (Just (AssignmentState 10 (Info.SourcePos 1 11) "" [], (Out "hello", Out "world")))
+      runAssignment headF ((,) <$> red <*> red) (makeState "helloworld" [node Red 0 5 [], node Red 5 10 []]) `shouldBe` Result Nothing (Just ((Out "hello", Out "world"), AssignmentState 10 (Info.SourcePos 1 11) "" []))
 
   describe "Alternative" $ do
     it "attempts multiple alternatives" $
-      runAssignment (green <|> red) (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], Out "hello"))
+      runAssignment headF (green <|> red) (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello", AssignmentState 5 (Info.SourcePos 1 6) "" []))
 
     it "matches repetitions" $
       let s = "colourless green ideas sleep furiously"
           w = words s
           (_, nodes) = foldl (\ (i, prev) word -> (i + B.length word + 1, prev <> [node Red i (i + B.length word) []])) (0, []) w in
-      resultValue (runAssignment (many red) (makeState (Source s) nodes)) `shouldBe` Just (AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) "" [], Out <$> w)
+      resultValue (runAssignment headF (many red) (makeState (Source s) nodes)) `shouldBe` Just (Out <$> w, AssignmentState (B.length s) (Info.SourcePos 1 (succ (B.length s))) "" [])
 
     it "matches one-or-more repetitions against one or more input nodes" $
-      resultValue (runAssignment (some red) (makeState "hello" [node Red 0 5 []])) `shouldBe` Just (AssignmentState 5 (Info.SourcePos 1 6) "" [], [Out "hello"])
+      resultValue (runAssignment headF (some red) (makeState "hello" [node Red 0 5 []])) `shouldBe` Just ([Out "hello"], AssignmentState 5 (Info.SourcePos 1 6) "" [])
 
   describe "symbol" $ do
     it "matches nodes with the same symbol" $
-      snd <$> runAssignment red (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello"))
+      fst <$> runAssignment headF red (makeState "hello" [node Red 0 5 []]) `shouldBe` Result Nothing (Just (Out "hello"))
 
     it "does not advance past the current node" $
       let initialState = makeState "hi" [ node Red 0 2 [] ] in
-      fst <$> runAssignment (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
+      snd <$> runAssignment headF (symbol Red) initialState `shouldBe` Result Nothing (Just initialState)
 
   describe "source" $ do
     it "produces the node’s source" $
-      assign source "hi" (node Red 0 2 []) `shouldBe` Result Nothing (Just "hi")
+      assignBy headF source "hi" (node Red 0 2 []) `shouldBe` Result Nothing (Just "hi")
 
     it "advances past the current node" $
-      fst <$> runAssignment source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
+      snd <$> runAssignment headF source (makeState "hi" [ node Red 0 2 [] ]) `shouldBe` Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" []))
 
   describe "children" $ do
     it "advances past the current node" $
-      fst <$> runAssignment (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
+      snd <$> runAssignment headF (children (pure (Out ""))) (makeState "a" [node Red 0 1 []]) `shouldBe` Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" []))
 
     it "matches if its subrule matches" $
-      () <$ runAssignment (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Result Nothing (Just ())
+      () <$ runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Red 0 1 []]]) `shouldBe` Result Nothing (Just ())
 
     it "does not match if its subrule does not match" $
-      (runAssignment (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
+      (runAssignment headF (children red) (makeState "a" [node Blue 0 1 [node Green 0 1 []]])) `shouldBe` Result (Just (Error (Info.SourcePos 1 1) (UnexpectedSymbol [Red] Green))) Nothing
 
     it "matches nested children" $
-      runAssignment
+      runAssignment headF
         (symbol Red *> children (symbol Green *> children (symbol Blue *> source)))
         (makeState "1" [ node Red 0 1 [ node Green 0 1 [ node Blue 0 1 [] ] ] ])
       `shouldBe`
-        Result Nothing (Just (AssignmentState 1 (Info.SourcePos 1 2) "" [], "1"))
+        Result Nothing (Just ("1", AssignmentState 1 (Info.SourcePos 1 2) "" []))
 
     it "continues after children" $
-      resultValue (runAssignment
+      resultValue (runAssignment headF
         (many (symbol Red *> children (symbol Green *> source)
            <|> symbol Blue *> source))
         (makeState "BC" [ node Red 0 1 [ node Green 0 1 [] ]
                         , node Blue 1 2 [] ]))
       `shouldBe`
-        Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["B", "C"])
+        Just (["B", "C"], AssignmentState 2 (Info.SourcePos 1 3) "" [])
 
     it "matches multiple nested children" $
-      runAssignment
+      runAssignment headF
         (symbol Red *> children (many (symbol Green *> children (symbol Blue *> source))))
         (makeState "12" [ node Red 0 2 [ node Green 0 1 [ node Blue 0 1 [] ]
                                        , node Green 1 2 [ node Blue 1 2 [] ] ] ])
       `shouldBe`
-        Result Nothing (Just (AssignmentState 2 (Info.SourcePos 1 3) "" [], ["1", "2"]))
+        Result Nothing (Just (["1", "2"], AssignmentState 2 (Info.SourcePos 1 3) "" []))
 
   describe "runAssignment" $ do
     it "drops anonymous nodes before matching symbols" $
-      runAssignment red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], Out "red"))
+      runAssignment headF red (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (Out "red", AssignmentState 11 (Info.SourcePos 1 12) "" []))
 
     it "does not drop anonymous nodes after matching" $
-      runAssignment red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 3 (Info.SourcePos 1 4) " magenta" [node Magenta 4 11 []], Out "red"))
+      runAssignment headF red (makeState "red magenta" [node Red 0 3 [], node Magenta 4 11 []]) `shouldBe` Result Nothing (Just (Out "red", AssignmentState 3 (Info.SourcePos 1 4) " magenta" [node Magenta 4 11 []]))
 
     it "does not drop anonymous nodes when requested" $
-      runAssignment ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just (AssignmentState 11 (Info.SourcePos 1 12) "" [], (Out "magenta", Out "red")))
+      runAssignment headF ((,) <$> magenta <*> red) (makeState "magenta red" [node Magenta 0 7 [], node Red 8 11 []]) `shouldBe` Result Nothing (Just ((Out "magenta", Out "red"), AssignmentState 11 (Info.SourcePos 1 12) "" []))
 
 node :: symbol -> Int -> Int -> [AST symbol] -> AST symbol
 node symbol start end children = cofree $ (Just symbol :. Range start end :. Info.SourceSpan (Info.SourcePos 1 (succ start)) (Info.SourcePos 1 (succ end)) :. Nil) :< children
@@ -101,14 +101,14 @@ instance Symbol Grammar where
 data Out = Out ByteString
   deriving (Eq, Show)
 
-red :: Assignment Grammar Out
+red :: Assignment (AST Grammar) Grammar Out
 red = Out <$ symbol Red <*> source
 
-green :: Assignment Grammar Out
+green :: Assignment (AST Grammar) Grammar Out
 green = Out <$ symbol Green <*> source
 
-blue :: Assignment Grammar Out
+blue :: Assignment (AST Grammar) Grammar Out
 blue = Out <$ symbol Blue <*> source
 
-magenta :: Assignment Grammar Out
+magenta :: Assignment (AST Grammar) Grammar Out
 magenta = Out <$ symbol Magenta <*> source

From 8695fd31440ab664b56bd142a5b215aa24314fa7 Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Thu, 8 Jun 2017 08:49:51 -0400
Subject: [PATCH 89/89] List items can contain multiple block elements.

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

diff --git a/src/Language/Markdown/Syntax.hs b/src/Language/Markdown/Syntax.hs
index dfcfb43c3..871352b92 100644
--- a/src/Language/Markdown/Syntax.hs
+++ b/src/Language/Markdown/Syntax.hs
@@ -40,6 +40,7 @@ type Syntax =
    , Markup.Text
    -- Assignment errors; cmark does not provide parse errors.
    , Syntax.Error Error
+   , []
    ]
 
 type Error = Assignment.Error Grammar
@@ -65,7 +66,7 @@ list = (cofree .) . (:<) <$> symbol List <*> (project (\ (((CMark.LIST CMark.Lis
   CMark.ORDERED_LIST -> inj . Markup.OrderedList) <*> children (many item))
 
 item :: Assignment
-item = symbol Item *> children blockElement
+item = makeTerm <$> symbol Item <*> children (many blockElement)
 
 heading :: Assignment
 heading = makeTerm <$> symbol Heading <*> (Markup.Heading <$> project (\ ((CMark.HEADING level :. _) :< _) -> level) <*> children (many inlineElement))