Define Symbol, Range, and SourceSpan in terms of Get.

src/Data/Syntax/Assignment.hs

@@ -29,13 +29,10 @@ 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 symbol = Freer (AssignmentF symbol)
+type Assignment node = Freer (AssignmentF node)
 
-data AssignmentF symbol a where
-  Get :: AssignmentF symbol symbol
-  Symbol :: symbol -> AssignmentF symbol ()
-  Range :: AssignmentF symbol Info.Range
-  SourceSpan :: AssignmentF symbol Info.SourceSpan
+data AssignmentF node a where
+  Get :: AssignmentF node node
   Source :: AssignmentF symbol ByteString
   Children :: Assignment symbol a -> AssignmentF symbol a
   Alt :: a -> a -> AssignmentF symbol a
@@ -44,20 +41,20 @@ data AssignmentF symbol a where
 -- | Zero-width match of a node with the given symbol.
 --
 --   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (symbol A *> b)' is fine, but 'many (symbol A)' is not.
-symbol :: symbol -> Assignment symbol ()
-symbol s = Symbol s `Then` return
+symbol :: (HasField fields symbol, Eq symbol) => symbol -> Assignment (Record fields) ()
+symbol s = Get `Then` guard . (s ==) . getField
 
 -- | 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
+range :: HasField fields Info.Range => Assignment (Record fields) Info.Range
+range = Get `Then` return . getField
 
 -- | Zero-width production of the current node’s sourceSpan.
 --
 --   Since this is zero-width, care must be taken not to repeat it without chaining on other rules. I.e. 'many (sourceSpan *> b)' is fine, but 'many sourceSpan' is not.
-sourceSpan :: Assignment symbol Info.SourceSpan
-sourceSpan = SourceSpan `Then` return
+sourceSpan :: HasField fields Info.SourceSpan => Assignment (Record fields) Info.SourceSpan
+sourceSpan = Get `Then` return . getField
 
 -- | A rule to produce a node’s source as a ByteString.
 source :: Assignment symbol ByteString
@@ -83,7 +80,7 @@ data Result a = Result a | Error [Text]
 
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax, discarding any unparsed nodes.
-assignAll :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [AST grammar] -> Result a
+assignAll :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source -> [AST grammar] -> Result a
 assignAll assignment source nodes = case runAssignment assignment source nodes of
   Result (rest, a) -> case dropAnonymous rest of
     [] -> Result a
@@ -91,24 +88,18 @@ assignAll assignment source nodes = case runAssignment assignment source nodes o
   Error e -> Error e
 
 -- | Run an assignment of nodes in a grammar onto terms in a syntax.
-runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment grammar a -> Source -> [AST grammar] -> Result ([AST grammar], a)
+runAssignment :: (Symbol grammar, Eq grammar, Show grammar) => Assignment (Node grammar) a -> Source -> [AST grammar] -> Result ([AST grammar], a)
 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 :. range :. sourceSpan :. Nil) children) : rest) -> case assignment of
-    Get -> yield nodeSymbol source nodes
-    Symbol symbol -> guard (symbol == nodeSymbol) >> yield () source nodes
-    Range -> yield range source nodes
-    SourceSpan -> yield sourceSpan source nodes
+    Get -> yield (nodeSymbol :. range :. sourceSpan :. Nil) 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]
   (Get, []) -> Error [ "Expected node but got end of input." ]
-  (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."])
@@ -125,9 +116,6 @@ instance Alternative (Assignment symbol) where
 instance Show symbol => Show1 (AssignmentF symbol) where
   liftShowsPrec sp sl d a = case a of
     Get -> showString "Get"
-    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

src/Language/Ruby/Syntax.hs

@@ -50,29 +50,29 @@ mkSymbolDatatype (mkName "Grammar") tree_sitter_ruby
 
 
 -- | Assignment from AST in Ruby’s grammar onto a program in Ruby’s syntax.
-assignment :: Assignment Grammar [Term Syntax ()]
+assignment :: Assignment (Node Grammar) [Term Syntax ()]
 assignment = symbol Program *> children (many declaration)
 
-declaration :: Assignment Grammar (Term Syntax ())
+declaration :: Assignment (Node Grammar) (Term Syntax ())
 declaration = comment <|> class' <|> method
 
-class' :: Assignment Grammar (Term Syntax ())
+class' :: Assignment (Node Grammar) (Term Syntax ())
 class' = term () <$  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 :: Assignment Grammar (Term Syntax ())
+constant :: Assignment (Node Grammar) (Term Syntax ())
 constant = term () . Syntax.Identifier <$ symbol Constant <*> source
 
-identifier :: Assignment Grammar (Term Syntax ())
+identifier :: Assignment (Node Grammar) (Term Syntax ())
 identifier = term () . Syntax.Identifier <$ symbol Identifier <*> source
 
-method :: Assignment Grammar (Term Syntax ())
+method :: Assignment (Node Grammar) (Term Syntax ())
 method = term () <$  symbol Method
                  <*> children (Declaration.Method <$> identifier <*> pure [] <*> (term () <$> many statement))
 
-statement :: Assignment Grammar (Term Syntax ())
+statement :: Assignment (Node Grammar) (Term Syntax ())
 statement  =  exit Statement.Return Return
           <|> exit Statement.Yield Yield
           <|> exit Statement.Break Break
@@ -84,30 +84,30 @@ statement  =  exit Statement.Return Return
           <|> literal
   where exit construct sym = term () . construct <$ symbol sym <*> children (optional (symbol ArgumentList *> children statement))
 
-comment :: Assignment Grammar (Term Syntax ())
+comment :: Assignment (Node Grammar) (Term Syntax ())
 comment = term () . Comment.Comment <$ symbol Comment <*> source
 
-if' :: Assignment Grammar (Term Syntax ())
+if' :: Assignment (Node Grammar) (Term Syntax ())
 if' = go If
   where go s = term () <$ symbol s <*> children (Statement.If <$> statement <*> (term () <$> many statement) <*> optional (go Elsif <|> term () <$ symbol Else <*> children (many statement)))
 
-ifModifier :: Assignment Grammar (Term Syntax ())
+ifModifier :: Assignment (Node Grammar) (Term Syntax ())
 ifModifier = term () <$ symbol IfModifier <*> children (flip Statement.If <$> statement <*> statement <*> pure (term () Syntax.Empty))
 
-unless :: Assignment Grammar (Term Syntax ())
+unless :: Assignment (Node Grammar) (Term Syntax ())
 unless = term () <$ symbol Unless <*> children (Statement.If <$> (term () . Expression.Not <$> statement) <*> (term () <$> many statement) <*> optional (term () <$ symbol Else <*> children (many statement)))
 
-unlessModifier :: Assignment Grammar (Term Syntax ())
+unlessModifier :: Assignment (Node Grammar) (Term Syntax ())
 unlessModifier = term () <$ symbol UnlessModifier <*> children (flip Statement.If <$> statement <*> (term () . Expression.Not <$> statement) <*> pure (term () Syntax.Empty))
 
-literal :: Assignment Grammar (Term Syntax ())
+literal :: Assignment (Node Grammar) (Term Syntax ())
 literal  =  term () Literal.true <$ symbol Language.Ruby.Syntax.True <* source
         <|> term () Literal.false <$ symbol Language.Ruby.Syntax.False <* source
         <|> term () . Literal.Integer <$ symbol Language.Ruby.Syntax.Integer <*> source
 
 -- | Assignment of the current node’s annotation.
-annotation :: Assignment grammar (Record '[ Info.Range, Info.SourceSpan ])
+annotation :: Assignment (Node Grammar) (Record '[ Info.Range, Info.SourceSpan ])
 annotation = (:.) <$> range <*> ((:. Data.Record.Nil) <$> sourceSpan)
 
-optional :: Assignment Grammar (Term Syntax ()) -> Assignment Grammar (Term Syntax ())
+optional :: Assignment (Node Grammar) (Term Syntax ()) -> Assignment (Node Grammar) (Term Syntax ())
 optional a = a <|> pure (term () Syntax.Empty)