From ba731785329e38d92888b1da201082de8424f94f Mon Sep 17 00:00:00 2001
From: Rob Rix <rob.rix@me.com>
Date: Fri, 21 Apr 2017 10:21:25 -0400
Subject: [PATCH] Define combinators producing the range and source span of the
 current node.

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

diff --git a/src/Data/Syntax/Assignment.hs b/src/Data/Syntax/Assignment.hs
index bb35e0e53..54d397451 100644
--- a/src/Data/Syntax/Assignment.hs
+++ b/src/Data/Syntax/Assignment.hs
@@ -2,6 +2,8 @@
 module Data.Syntax.Assignment
 ( Assignment
 , symbol
+, range
+, sourceSpan
 , source
 , children
 , Rose(..)
@@ -15,13 +17,12 @@ module Data.Syntax.Assignment
 
 import Control.Monad.Free.Freer
 import Data.Functor.Classes
-import Data.Functor.Foldable
+import Data.Functor.Foldable hiding (Nil)
 import Data.Record
 import Data.Text (unpack)
-import Range
+import qualified Info
 import Prologue hiding (Alt)
 import Source (Source())
-import SourceSpan
 import Text.Parser.TreeSitter.Language
 import Text.Show hiding (show)
 
@@ -32,6 +33,8 @@ type Assignment symbol = Freer (AssignmentF symbol)
 
 data AssignmentF symbol a where
   Symbol :: symbol -> AssignmentF symbol ()
+  Range :: AssignmentF symbol Info.Range
+  SourceSpan :: AssignmentF symbol Info.SourceSpan
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
   Alt :: a -> a -> AssignmentF symbol a
@@ -43,6 +46,18 @@ data AssignmentF symbol a where
 symbol :: symbol -> Assignment symbol ()
 symbol s = Symbol s `Then` return
 
+-- | Zero-width production of the current node’s range.
+--
+--   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (range *> b)' is fine, but 'many range' is not.
+range :: Assignment symbol Info.Range
+range = Range `Then` return
+
+-- | Zero-width production of the current node’s sourceSpan.
+--
+--   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (sourceSpan *> b)' is fine, but 'many sourceSpan' is not.
+sourceSpan :: Assignment symbol Info.SourceSpan
+sourceSpan = SourceSpan `Then` return
+
 -- | A rule to produce a node’s source as a ByteString.
 source :: Assignment symbol ByteString
 source = Source `Then` return
@@ -56,7 +71,7 @@ children forEach = Children forEach `Then` return
 data Rose a = Rose { roseValue :: !a, roseChildren :: ![Rose a] }
   deriving (Eq, Functor, Show)
 
-type Node grammar = Record '[grammar, Range, SourceSpan]
+type Node grammar = Record '[grammar, Info.Range, Info.SourceSpan]
 
 type AST grammar = Rose (Node grammar)
 
@@ -79,14 +94,18 @@ runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment gramma
 runAssignment = iterFreer (\ assignment yield source nodes -> case (assignment, dropAnonymous nodes) of
   -- Nullability: some rules, e.g. 'pure a' and 'many a', should match at the end of input. Either side of an alternation may be nullable, ergo Alt can match at the end of input.
   (Alt a b, nodes) -> yield a source nodes <|> yield b source nodes -- FIXME: Symbol `Alt` Symbol `Alt` Symbol is inefficient, should build and match against an IntMap instead.
-  (assignment, node@(Rose (nodeSymbol :. _) children) : rest) -> case assignment of
+  (assignment, node@(Rose (nodeSymbol :. range :. sourceSpan :. Nil) children) : rest) -> case assignment of
     Symbol symbol -> guard (symbol == nodeSymbol) >> yield () source nodes
+    Range -> yield range source nodes
+    SourceSpan -> yield sourceSpan source nodes
     Source -> yield "" source rest
     Children childAssignment -> do
       c <- assignAll childAssignment source children
       yield c source rest
     _ -> Error ["No rule to match " <> show node]
   (Symbol symbol, []) -> Error [ "Expected " <> show symbol <> " but got end of input." ]
+  (Range, []) -> Error [ "Expected node with range but got end of input." ]
+  (SourceSpan, []) -> Error [ "Expected node with source span but got end of input." ]
   (Source, []) -> Error [ "Expected leaf node but got end of input." ]
   (Children _, []) -> Error [ "Expected branch node but got end of input." ]
   _ -> Error ["No rule to match at end of input."])
@@ -103,6 +122,8 @@ instance Alternative (Assignment symbol) where
 instance Show symbol => Show1 (AssignmentF symbol) where
   liftShowsPrec sp sl d a = case a of
     Symbol s -> showsUnaryWith showsPrec "Symbol" d s . showChar ' ' . sp d ()
+    Range -> showString "Range" . showChar ' ' . sp d (Info.Range 0 0)
+    SourceSpan -> showString "SourceSpan" . showChar ' ' . sp d (Info.SourceSpan (Info.SourcePos 0 0) (Info.SourcePos 0 0))
     Source -> showString "Source" . showChar ' ' . sp d ""
     Children a -> showsUnaryWith (liftShowsPrec sp sl) "Children" d a
     Alt a b -> showsBinaryWith sp sp "Alt" d a b