Merge remote-tracking branch 'origin/master' into generate-tags-with-context

semantic-diff.cabal

@@ -57,7 +57,6 @@ library
                      , Language.JSON.Assignment
                      , Language.Ruby.Grammar
                      , Language.Ruby.Assignment
-                     , Language.TypeScript
                      , Language.TypeScript.Assignment
                      , Language.TypeScript.Grammar
                      , Language.TypeScript.Syntax

src/Files.hs

@@ -71,9 +71,9 @@ readBlobsFromDir path = do
 readFromHandle :: (FromJSON a, MonadIO m) => Handle -> m a
 readFromHandle h = do
   input <- liftIO $ BL.hGetContents h
-  case decode input of
-    Just d -> pure d
-    Nothing -> liftIO $ die ("invalid input on " <> show h <> ", expecting JSON")
+  case eitherDecode input of
+    Left e -> liftIO (die (e <> ". Invalid input on " <> show h <> ", expecting JSON"))
+    Right d -> pure d
 
 toBlob :: Blob -> Blob.Blob
 toBlob Blob{..} = Blob.sourceBlob path language' (fromText content)

src/Language/JSON/Assignment.hs

@@ -35,17 +35,20 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
 
 
 assignment :: Assignment
-assignment = Syntax.handleError $ object <|> array <|> parseError
+assignment = Syntax.handleError (value <|> parseError)
 
 value :: Assignment
-value = object <|> array <|> number <|> string <|> boolean <|> none <|> parseError
+value = symbol Value *> children (object <|> array)
+
+jsonValue :: Assignment
+jsonValue = object <|> array <|> number <|> string <|> boolean <|> none
 
 object :: Assignment
 object = makeTerm <$> symbol Object <*> children (Literal.Hash <$> many pairs)
-  where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> (number <|> string) <*> value)
+  where pairs = makeTerm <$> symbol Pair <*> children (Literal.KeyValue <$> (number <|> string) <*> jsonValue)
 
 array :: Assignment
-array = makeTerm <$> symbol Array <*> children (Literal.Array <$> many value)
+array = makeTerm <$> symbol Array <*> children (Literal.Array <$> many jsonValue)
 
 number :: Assignment
 number = makeTerm <$> symbol Number <*> (Literal.Float <$> source)

src/Language/Python/Assignment.hs

@@ -85,10 +85,20 @@ type Assignment = HasCallStack => Assignment.Assignment [] Grammar Term
 
 -- | Assignment from AST in Python's grammar onto a program in Python's syntax.
 assignment :: Assignment
-assignment = handleError $ makeTerm <$> symbol Module <*> children (Syntax.Program <$> many expression) <|> parseError
+assignment = handleError $ makeTerm <$> symbol Module <*> children (Syntax.Program <$> manyTerm expression) <|> parseError
+
+-- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
+manyTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+manyTerm term = many (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
+
+someTerm :: Assignment -> Assignment.Assignment [] Grammar [Term]
+someTerm term = some (contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm))
+
+term :: Assignment -> Assignment
+term term = contextualize comment (postContextualize comment term)
 
 expression :: Assignment
-expression = term (handleError (choice expressionChoices))
+expression = handleError (choice expressionChoices)
 
 expressionChoices :: [Assignment.Assignment [] Grammar Term]
 expressionChoices =
@@ -159,15 +169,15 @@ expressionChoices =
   ]
 
 expressions :: Assignment
-expressions = makeTerm <$> location <*> many expression
+expressions = makeTerm <$> location <*> manyTerm expression
 
 expressionStatement :: Assignment
-expressionStatement = mk <$> symbol ExpressionStatement <*> children (some expression)
+expressionStatement = mk <$> symbol ExpressionStatement <*> children (someTerm expression)
   where mk _ [child] = child
         mk location children = makeTerm location children
 
 expressionList :: Assignment
-expressionList = mk <$> symbol ExpressionList <*> children (some expression)
+expressionList = mk <$> symbol ExpressionList <*> children (someTerm expression)
   where mk _ [child] = child
         mk location children = makeTerm location children
 
@@ -178,15 +188,15 @@ dictionarySplat :: Assignment
 dictionarySplat = makeTerm <$> symbol DictionarySplat <*> (Syntax.Identifier <$> source)
 
 keywordArgument :: Assignment
-keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Statement.Assignment [] <$> expression <*> expression)
+keywordArgument = makeTerm <$> symbol KeywordArgument <*> children (Statement.Assignment [] <$> term expression <*> term expression)
 
 parenthesizedExpression :: Assignment
 parenthesizedExpression = symbol ParenthesizedExpression *> children expressions
 
 parameter :: Assignment
-parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assignment [] <$> expression <*> expression)
-         <|> makeTerm <$> symbol TypedParameter <*> children (Type.Annotation <$> expression <*> type')
-         <|> makeAnnotation <$> symbol TypedDefaultParameter <*> children ((,,) <$> expression <*> expression <*> expression)
+parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assignment [] <$> term expression <*> term expression)
+         <|> makeTerm <$> symbol TypedParameter <*> children (Type.Annotation <$> term expression <*> term type')
+         <|> makeAnnotation <$> symbol TypedDefaultParameter <*> children ((,,) <$> term expression <*> term expression <*> term expression)
   where
     makeAnnotation loc (identifier', type', value') = makeTerm loc (Type.Annotation (makeAssignment loc identifier' value') type')
     makeAssignment loc identifier' value' = makeTerm loc (Statement.Assignment [] identifier' value')
@@ -194,49 +204,49 @@ parameter =  makeTerm <$> symbol DefaultParameter <*> children (Statement.Assign
 decoratedDefinition :: Assignment
 decoratedDefinition = symbol DecoratedDefinition *> children (term decorator)
   where
-    decorator = makeTerm <$> symbol Decorator <*> (children (Declaration.Decorator <$> expression <*> many expression) <*> term (decorator <|> functionDefinition <|> classDefinition))
+    decorator = makeTerm <$> symbol Decorator <*> (children (Declaration.Decorator <$> term expression <*> manyTerm expression) <*> term (decorator <|> functionDefinition <|> classDefinition))
 
 argumentList :: Assignment
 argumentList = symbol ArgumentList *> children expressions
 
 withStatement :: Assignment
-withStatement = mk <$> symbol WithStatement <*> children (some with)
+withStatement = mk <$> symbol WithStatement <*> children (someTerm with)
   where
     mk _ [child] = child
     mk l children = makeTerm l children
-    with = makeTerm <$> location <*> (withItem <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol WithItem) <|> eof)))
-    withItem = symbol WithItem *> children (flip Statement.Let <$> expression <*> (expression <|> emptyTerm))
-            <|> flip Statement.Let <$> expression <*> emptyTerm
+    with = makeTerm <$> location <*> (withItem <*> term (makeTerm <$> location <*> manyTermsTill expression (void (symbol WithItem) <|> eof)))
+    withItem = symbol WithItem *> children (flip Statement.Let <$> term expression <*> term (expression <|> emptyTerm))
+            <|> flip Statement.Let <$> term expression <*> emptyTerm
 
 forStatement :: Assignment
-forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (symbol Variables *> children expressions) <*> expressionList <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> eof)) <*> optional (symbol ElseClause *> children expressions))
+forStatement = symbol ForStatement >>= \ loc -> children (make loc <$> (symbol Variables *> children expressions) <*> term expressionList <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> eof)) <*> optional (symbol ElseClause *> children expressions))
   where
     make loc binding subject body forElseClause = case forElseClause of
       Nothing -> makeTerm loc (Statement.ForEach binding subject body)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.ForEach binding subject body) a)
 
 whileStatement :: Assignment
-whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> expression <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> eof)) <*> optional (symbol ElseClause *> children expressions))
+whileStatement = symbol WhileStatement >>= \ loc -> children (make loc <$> term expression <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> eof)) <*> optional (symbol ElseClause *> children expressions))
   where
     make loc whileCondition whileBody whileElseClause = case whileElseClause of
       Nothing -> makeTerm loc (Statement.While whileCondition whileBody)
       Just a -> makeTerm loc (Statement.Else (makeTerm loc $ Statement.While whileCondition whileBody) a)
 
 tryStatement :: Assignment
-tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> expression <*> many (expression <|> elseClause))
+tryStatement = makeTerm <$> symbol TryStatement <*> children (Statement.Try <$> term expression <*> manyTerm (expression <|> elseClause))
   where elseClause = makeTerm <$> symbol ElseClause <*> children (Statement.Else <$> emptyTerm <*> expressions)
 
 exceptClause :: Assignment
 exceptClause = makeTerm <$> symbol ExceptClause <*> children
-  (Statement.Catch <$> ((makeTerm <$> location <*> (uncurry (flip Statement.Let) <$> ((,) <$> expression <* symbol AnonAs <*> expression) <*> emptyTerm))
+  (Statement.Catch <$> term ((makeTerm <$> location <*> (uncurry (flip Statement.Let) <$> ((,) <$> term expression <* symbol AnonAs <*> term expression) <*> emptyTerm))
                       <|> expressions)
                    <*> expressions)
 
 functionDefinition :: Assignment
 functionDefinition
-  =   makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> expression <* symbol Parameters <*> children (many expression) <*> optional (symbol Type *> children expression) <*> expressions)
-  <|> makeAsyncFunctionDeclaration <$> symbol AsyncFunctionDefinition <*> children ((,,,,) <$> async' <*> expression <* symbol Parameters <*> children (many expression) <*> optional (symbol Type *> children expression) <*> expressions)
-  <|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (many expression) <|> pure []) <*> optional (symbol Type *> children expression) <*> expressions)
+  =   makeFunctionDeclaration <$> symbol FunctionDefinition <*> children ((,,,) <$> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
+  <|> makeAsyncFunctionDeclaration <$> symbol AsyncFunctionDefinition <*> children ((,,,,) <$> term async' <*> term expression <* symbol Parameters <*> children (manyTerm expression) <*> optional (symbol Type *> children (term expression)) <*> expressions)
+  <|> makeFunctionDeclaration <$> (symbol Lambda' <|> symbol Lambda) <*> children ((,,,) <$ token AnonLambda <*> emptyTerm <*> (symbol LambdaParameters *> children (manyTerm expression) <|> pure []) <*> optional (symbol Type *> children (term expression)) <*> expressions)
   where
     makeFunctionDeclaration loc (functionName', functionParameters, ty, functionBody) = makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function [] functionName' functionParameters functionBody) (fromMaybe (makeTerm loc Syntax.Empty) ty)
     makeAsyncFunctionDeclaration loc (async', functionName', functionParameters, ty, functionBody) = makeTerm loc $ Type.Annotation (makeTerm loc $ Type.Annotation (makeTerm loc $ Declaration.Function [] functionName' functionParameters functionBody) (maybe (makeTerm loc Syntax.Empty) id ty)) async'
@@ -245,18 +255,18 @@ async' :: Assignment
 async' = makeTerm <$> symbol AnonAsync <*> (Syntax.Identifier <$> source)
 
 classDefinition :: Assignment
-classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> pure [] <*> expression <*> argumentList <*> expressions)
-  where argumentList = symbol ArgumentList *> children (many expression)
+classDefinition = makeTerm <$> symbol ClassDefinition <*> children (Declaration.Class <$> pure [] <*> term expression <*> argumentList <*> expressions)
+  where argumentList = symbol ArgumentList *> children (manyTerm expression)
                     <|> pure []
 
 type' :: Assignment
-type' = symbol Type *> children expression
+type' = symbol Type *> children (term expression)
 
 finallyClause :: Assignment
 finallyClause = makeTerm <$> symbol FinallyClause <*> children (Statement.Finally <$> expressions)
 
 dottedName :: Assignment
-dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> many expression)
+dottedName = makeTerm <$> symbol DottedName <*> children (Expression.ScopeResolution <$> manyTerm expression)
 
 ellipsis :: Assignment
 ellipsis = makeTerm <$> token Grammar.Ellipsis <*> pure Python.Syntax.Ellipsis
@@ -277,19 +287,19 @@ comparisonOperator = symbol ComparisonOperator *> children (expression `chainl1T
   where invert cons a b = Expression.Not (makeTerm1 (cons a b))
 
 notOperator :: Assignment
-notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> expression)
+notOperator = makeTerm <$> symbol NotOperator <*> children (Expression.Not <$> term expression)
 
 tuple :: Assignment
-tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> many expression)
+tuple = makeTerm <$> symbol Tuple <*> children (Literal.Tuple <$> manyTerm expression)
 
 unaryOperator :: Assignment
-unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> expression )
+unaryOperator = symbol UnaryOperator >>= \ location -> arithmetic location <|> bitwise location <|> children ( symbol AnonPlus *> term expression )
   where
-    arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> expression )
-    bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> expression )
+    arithmetic location = makeTerm location . Expression.Negate <$> children ( symbol AnonMinus *> term expression )
+    bitwise location    = makeTerm location . Expression.Complement <$> children ( symbol AnonTilde *> term expression )
 
 binaryOperator :: Assignment
-binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm expression expression
+binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm expression (term expression)
   [ (inj .) . Expression.Plus      <$ symbol AnonPlus
   , (inj .) . Expression.Minus     <$ symbol AnonMinus
   , (inj .) . Expression.Times     <$ symbol AnonStar
@@ -305,14 +315,14 @@ binaryOperator = makeTerm' <$> symbol BinaryOperator <*> children (infixTerm exp
   ])
 
 booleanOperator :: Assignment
-booleanOperator = makeTerm' <$> symbol BooleanOperator <*> children (infixTerm expression expression
+booleanOperator = makeTerm' <$> symbol BooleanOperator <*> children (infixTerm expression (term expression)
   [ (inj .) . Expression.And <$ symbol AnonAnd
   , (inj .) . Expression.Or  <$ symbol AnonOr
   ])
 
 assignment' :: Assignment
-assignment' =  makeTerm  <$> symbol Assignment <*> children (Statement.Assignment [] <$> expressionList <*> rvalue)
-           <|> makeTerm' <$> symbol AugmentedAssignment <*> children (infixTerm expressionList rvalue
+assignment' =  makeTerm  <$> symbol Assignment <*> children (Statement.Assignment [] <$> term expressionList <*> term rvalue)
+           <|> makeTerm' <$> symbol AugmentedAssignment <*> children (infixTerm expressionList (term rvalue)
                   [ assign Expression.Plus      <$ symbol AnonPlusEqual
                   , assign Expression.Minus     <$ symbol AnonMinusEqual
                   , assign Expression.Times     <$ symbol AnonStarEqual
@@ -331,28 +341,28 @@ assignment' =  makeTerm  <$> symbol Assignment <*> children (Statement.Assignmen
         assign c l r = inj (Statement.Assignment [] l (makeTerm1 (c l r)))
 
 yield :: Assignment
-yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children ( expression <|> emptyTerm ))
+yield = makeTerm <$> symbol Yield <*> (Statement.Yield <$> children (term ( expression <|> emptyTerm )))
 
 identifier :: Assignment
 identifier = makeTerm <$> (symbol Identifier <|> symbol Identifier') <*> (Syntax.Identifier <$> source)
 
 set :: Assignment
-set = makeTerm <$> symbol Set <*> children (Literal.Set <$> many expression)
+set = makeTerm <$> symbol Set <*> children (Literal.Set <$> manyTerm expression)
 
 dictionary :: Assignment
-dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> many expression)
+dictionary = makeTerm <$> symbol Dictionary <*> children (Literal.Hash <$> manyTerm expression)
 
 pair :: Assignment
-pair = makeTerm' <$> symbol Pair <*> children (infixTerm expression expression [ (inj .) . Literal.KeyValue <$ symbol AnonColon ])
+pair = makeTerm' <$> symbol Pair <*> children (infixTerm expression (term expression) [ (inj .) . Literal.KeyValue <$ symbol AnonColon ])
 
 list' :: Assignment
-list' = makeTerm <$> symbol List <*> children (Literal.Array <$> many expression)
+list' = makeTerm <$> symbol List <*> children (Literal.Array <$> manyTerm expression)
 
 string :: Assignment
 string = makeTerm <$> symbol String <*> (Literal.TextElement <$> source)
 
 concatenatedString :: Assignment
-concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (many (term (makeTerm <$> symbol String <*> (Literal.TextElement <$> source))))
+concatenatedString = makeTerm <$> symbol ConcatenatedString <*> children (manyTerm string)
 
 float :: Assignment
 float = makeTerm <$> symbol Float <*> (Literal.Float <$> source)
@@ -364,51 +374,51 @@ comment :: Assignment
 comment = makeTerm <$> symbol Comment <*> (Comment.Comment <$> source)
 
 import' :: Assignment
-import' =  makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> many expression)
-       <|> makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> many expression)
-       <|> makeTerm <$> symbol AliasedImport <*> children (flip Statement.Let <$> expression <*> expression <*> emptyTerm)
+import' =  makeTerm <$> symbol ImportStatement <*> children (Declaration.Import <$> manyTerm expression)
+       <|> makeTerm <$> symbol ImportFromStatement <*> children (Declaration.Import <$> manyTerm expression)
+       <|> makeTerm <$> symbol AliasedImport <*> children (flip Statement.Let <$> term expression <*> term expression <*> emptyTerm)
        <|> makeTerm <$> symbol WildcardImport <*> (Syntax.Identifier <$> source)
 
 assertStatement :: Assignment
-assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> many expression <*> emptyTerm)
+assertStatement = makeTerm <$> symbol AssertStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonAssert <*> (Syntax.Identifier <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 printStatement :: Assignment
 printStatement = do
   location <- symbol PrintStatement
   children $ do
-    print <- printKeyword
-    redirectCallTerm location print <|> printCallTerm location print
+    print <- term printKeyword
+    term (redirectCallTerm location print <|> printCallTerm location print)
   where
     printKeyword = makeTerm <$> symbol AnonPrint <*> (Syntax.Identifier <$> source)
-    redirectCallTerm location identifier = makeTerm location <$ symbol Chevron <*> (flip Python.Syntax.Redirect <$> children expression <*> printCallTerm location identifier)
-    printCallTerm location identifier = makeTerm location <$> (Expression.Call [] identifier <$> many expression <*> emptyTerm)
+    redirectCallTerm location identifier = makeTerm location <$ symbol Chevron <*> (flip Python.Syntax.Redirect <$> children (term expression) <*> term (printCallTerm location identifier))
+    printCallTerm location identifier = makeTerm location <$> (Expression.Call [] identifier <$> manyTerm expression <*> emptyTerm)
 
 nonlocalStatement :: Assignment
-nonlocalStatement = makeTerm <$> symbol NonlocalStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonNonlocal <*> (Syntax.Identifier <$> source)) <*> many expression <*> emptyTerm)
+nonlocalStatement = makeTerm <$> symbol NonlocalStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonNonlocal <*> (Syntax.Identifier <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 globalStatement :: Assignment
-globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> many expression <*> emptyTerm)
+globalStatement = makeTerm <$> symbol GlobalStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonGlobal <*> (Syntax.Identifier <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 await :: Assignment
-await = makeTerm <$> symbol Await <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> many expression <*> emptyTerm)
+await = makeTerm <$> symbol Await <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> symbol AnonAwait <*> (Syntax.Identifier <$> source)) <*> manyTerm expression <*> emptyTerm)
 
 returnStatement :: Assignment
-returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> (expressionList <|> emptyTerm))
+returnStatement = makeTerm <$> symbol ReturnStatement <*> children (Statement.Return <$> term (expressionList <|> emptyTerm))
 
 deleteStatement :: Assignment
-deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.Call <$> pure [] <*> deleteIdentifier <* symbol ExpressionList <*> children (many expression) <*> emptyTerm)
+deleteStatement = makeTerm <$> symbol DeleteStatement <*> children (Expression.Call <$> pure [] <*> term deleteIdentifier <* symbol ExpressionList <*> children (manyTerm expression) <*> emptyTerm)
   where deleteIdentifier = makeTerm <$> symbol AnonDel <*> (Syntax.Identifier <$> source)
 
 raiseStatement :: Assignment
 raiseStatement = makeTerm <$> symbol RaiseStatement <*> children (Statement.Throw <$> expressions)
 
 ifStatement :: Assignment
-ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> expression <*> (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> void (symbol ElifClause) <|> eof)) <*> (flip (foldr makeElif) <$> many elifClause <*> (symbol ElseClause *> children expressions <|> emptyTerm)))
-  where elifClause = (,) <$> symbol ElifClause <*> children (Statement.If <$> expression <*> expressions)
+ifStatement = makeTerm <$> symbol IfStatement <*> children (Statement.If <$> term expression <*> term (makeTerm <$> location <*> manyTermsTill expression (void (symbol ElseClause) <|> void (symbol ElifClause) <|> eof)) <*> (flip (foldr makeElif) <$> many elifClause <*> (symbol ElseClause *> children expressions <|> emptyTerm)))
+  where elifClause = (,) <$> symbol ElifClause <*> children (Statement.If <$> term expression <*> expressions)
         makeElif (loc, makeIf) rest = makeTerm loc (makeIf rest)
 
 execStatement :: Assignment
-execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call <$> pure [] <*> (makeTerm <$> location <*> (Syntax.Identifier <$> source)) <*> many (string <|> expression) <*> emptyTerm)
+execStatement = makeTerm <$> symbol ExecStatement <*> children (Expression.Call <$> pure [] <*> term (makeTerm <$> location <*> (Syntax.Identifier <$> source)) <*> manyTerm (string <|> expression) <*> emptyTerm)
 
 passStatement :: Assignment
 passStatement = makeTerm <$> symbol PassStatement <*> (Statement.NoOp <$> emptyTerm <* advance)
@@ -420,20 +430,20 @@ continueStatement :: Assignment
 continueStatement = makeTerm <$> symbol ContinueStatement <*> (Statement.Continue <$> emptyTerm <* advance)
 
 memberAccess :: Assignment
-memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> expression <*> expression)
+memberAccess = makeTerm <$> symbol Attribute <*> children (Expression.MemberAccess <$> term expression <*> term expression)
 
 subscript :: Assignment
-subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> expression <*> many expression)
+subscript = makeTerm <$> symbol Subscript <*> children (Expression.Subscript <$> term expression <*> manyTerm expression)
 
 slice :: Assignment
 slice = makeTerm <$> symbol Slice <*> children
-  (Expression.Enumeration <$> ((emptyTerm <* token AnonColon) <|> (expression <* token AnonColon))
-                          <*> ((emptyTerm <* token AnonColon) <|> (expression <* token AnonColon) <|> (expression <|> emptyTerm))
-                          <*> (expression <|> emptyTerm))
+  (Expression.Enumeration <$> ((emptyTerm <* token AnonColon) <|> (term expression <* token AnonColon))
+                          <*> ((emptyTerm <* token AnonColon) <|> (term expression <* token AnonColon) <|> (term expression <|> emptyTerm))
+                          <*> (term expression <|> emptyTerm))
 
 call :: Assignment
-call = makeTerm <$> symbol Call <*> children (Expression.Call <$> pure [] <*> expression <*> (symbol ArgumentList *> children (many expression)
-                                                                                <|> some comprehension) <*> emptyTerm)
+call = makeTerm <$> symbol Call <*> children (Expression.Call <$> pure [] <*> term expression <*> (symbol ArgumentList *> children (manyTerm expression)
+                                                                                <|> someTerm comprehension) <*> emptyTerm)
 
 boolean :: Assignment
 boolean =  makeTerm <$> token Grammar.True <*> pure Literal.true
@@ -443,10 +453,10 @@ none :: Assignment
 none = makeTerm <$> symbol None <*> (Literal.Null <$ source)
 
 comprehension :: Assignment
-comprehension =  makeTerm <$> symbol ListComprehension       <*> children (Declaration.Comprehension <$> expression <*> expressions)
-             <|> makeTerm <$> symbol GeneratorExpression     <*> children (Declaration.Comprehension <$> expression <*> expressions)
-             <|> makeTerm <$> symbol SetComprehension        <*> children (Declaration.Comprehension <$> expression <*> expressions)
-             <|> makeTerm <$> symbol DictionaryComprehension <*> children (Declaration.Comprehension <$> expression <*> expressions)
+comprehension =  makeTerm <$> symbol ListComprehension       <*> children (Declaration.Comprehension <$> term expression <*> expressions)
+             <|> makeTerm <$> symbol GeneratorExpression     <*> children (Declaration.Comprehension <$> term expression <*> expressions)
+             <|> makeTerm <$> symbol SetComprehension        <*> children (Declaration.Comprehension <$> term expression <*> expressions)
+             <|> makeTerm <$> symbol DictionaryComprehension <*> children (Declaration.Comprehension <$> term expression <*> expressions)
 
 forInClause :: Assignment
 forInClause = symbol ForInClause *> children expressions
@@ -458,11 +468,7 @@ ifClause :: Assignment
 ifClause = symbol IfClause *> children expressions
 
 conditionalExpression :: Assignment
-conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (flip Statement.If <$> expression <*> expression <*> expressions)
-
--- | Match a term optionally preceded by comment(s), or a sequence of comments if the term is not present.
-term :: Assignment -> Assignment
-term term = contextualize comment term <|> makeTerm1 <$> (Syntax.Context <$> some1 comment <*> emptyTerm)
+conditionalExpression = makeTerm <$> symbol ConditionalExpression <*> children (flip Statement.If <$> term expression <*> term expression <*> expressions)
 
 -- | Match a left-associated infix chain of terms, optionally followed by comments. Like 'chainl1' but assigning comment nodes automatically.
 chainl1Term :: Assignment -> Assignment.Assignment [] Grammar (Term -> Term -> Term) -> Assignment

src/Language/TypeScript.hs

@@ -1,183 +0,0 @@
-{-# LANGUAGE DataKinds #-}
-module Language.TypeScript where
-
-import Control.Comonad (extract)
-import Control.Comonad.Cofree (unwrap)
-import Data.Foldable (toList)
-import Data.Record
-import Data.Source
-import Data.Term
-import Data.Text (Text)
-import Info
-import Language
-import qualified Syntax as S
-
-termAssignment
-  :: Source -- ^ The source of the term.
-  -> Category -- ^ The category for the term.
-  -> [ Term S.Syntax (Record DefaultFields) ] -- ^ The child nodes of the term.
-  -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields))) -- ^ The resulting term, in Maybe.
-termAssignment _ category children =
-  case (category, children) of
-    (Assignment, [ identifier, value ]) -> Just $ S.Assignment identifier value
-    (MathAssignment, [ identifier, value ]) -> Just $ S.OperatorAssignment identifier value
-    (MemberAccess, [ base, property ]) -> Just $ S.MemberAccess base property
-    (SubscriptAccess, [ base, element ]) -> Just $ S.SubscriptAccess base element
-    (CommaOperator, [ a, b ])
-      | S.Indexed rest <- unwrap b
-      -> Just $ S.Indexed $ a : rest
-    (FunctionCall, id : rest) -> case break ((== Args) . Info.category . extract) rest of
-      (typeArgs, [ args ]) -> let flatArgs = toList (unwrap args) in
-           Just $ case unwrap id of
-             S.MemberAccess target method -> S.MethodCall target method typeArgs flatArgs
-             _                            -> S.FunctionCall id typeArgs flatArgs
-      _ -> Nothing
-    (Ternary, condition : cases) -> Just $ S.Ternary condition cases
-    (Other "variable_declaration", _) -> Just . S.Indexed $ toVarDeclOrAssignment <$> children
-    (Other "trailing_variable_declaration", _) -> Just . S.Indexed $ toVarDeclOrAssignment <$> children
-    (Other "lexical_declaration", _) -> Just . S.Indexed $ toVarDeclOrAssignment <$> children
-    (VarAssignment, [id, assignment]) -> Just $ S.VarAssignment [id] assignment
-    (FieldDecl, _) -> Just $ S.FieldDecl children
-    (Object, _) -> Just . S.Object Nothing $ foldMap toTuple children
-    (DoWhile, [ expr, body ]) -> Just $ S.DoWhile expr body
-    (Constructor, [ expr ]) -> Just $ S.Constructor expr
-    (Try, [ body ]) -> Just $ S.Try [body] [] Nothing Nothing
-    (Try, [ body, catch ])
-      | Catch <- Info.category (extract catch)
-      -> Just $ S.Try [body] [catch] Nothing Nothing
-    (Try, [ body, finally ])
-      | Finally <- Info.category (extract finally)
-      -> Just $ S.Try [body] [] Nothing (Just finally)
-    (Try, [ body, catch, finally ])
-      | Catch <- Info.category (extract catch)
-      , Finally <- Info.category (extract finally)
-      -> Just $ S.Try [body] [catch] Nothing (Just finally)
-    (ArrayLiteral, _) -> Just $ S.Array Nothing children
-    (Method, children) -> case break ((== ExpressionStatements) . Info.category . extract) children of
-      (prev, [body]) -> case break ((== Identifier) . Info.category . extract) prev of
-        (prev, [id, callSignature]) -> Just $ S.Method prev id Nothing (toList (unwrap callSignature)) (toList (unwrap body))
-        _ -> Nothing -- No identifier found or callSignature found.
-      _ -> Nothing -- No body found.``
-    (Class, identifier : rest) -> case break ((== Other "class_body") . Info.category . extract) rest of
-      (clauses, [ definitions ]) -> Just $ S.Class identifier clauses (toList (unwrap definitions))
-      _ -> Nothing
-    (Module, [ identifier, definitions ]) -> Just $ S.Module identifier (toList (unwrap definitions))
-    (Namespace, [ identifier, definitions ]) -> Just $ S.Namespace identifier (toList (unwrap definitions))
-    (Import, [ statements, identifier ] ) -> Just $ S.Import identifier (toList (unwrap statements))
-    (Import, [ identifier ] ) -> Just $ S.Import identifier []
-    (Export, [ statements, identifier] ) -> Just $ S.Export (Just identifier) (toList (unwrap statements))
-    (Export, [ statements ] )
-      | S.Indexed _ <- unwrap statements
-      -> Just $ S.Export Nothing (toList (unwrap statements))
-      | otherwise -> Just $ S.Export (Just statements) []
-    (For, _:_) -> Just $ S.For (init children >>= flattenExpressionStatements) [last children]
-    (Function, children) -> case break ((== ExpressionStatements) . Info.category . extract) children of
-      (inits, [body]) -> case inits of
-        [id, callSignature] -> Just $ S.Function id (toList (unwrap callSignature)) (toList (unwrap body))
-        [callSignature] -> Just $ S.AnonymousFunction (toList (unwrap callSignature)) (toList (unwrap body))
-        _ -> Nothing -- More than 1 identifier found or no call signature found
-      _ -> Nothing -- No body found.
-    (Ty, children) -> Just $ S.Ty children
-    (Interface, children) -> toInterface children
-    _ -> Nothing
-    where flattenExpressionStatements term
-            | Info.category (extract term) `elem` [ExpressionStatements, CommaOperator] = toList (unwrap term) >>= flattenExpressionStatements
-            | otherwise = [term]
-
-categoryForTypeScriptName :: Text -> Category
-categoryForTypeScriptName category = case category of
-  "object" -> Object
-  "expression_statement" -> ExpressionStatements
-  "trailing_expression_statement" -> ExpressionStatements
-  "this_expression" -> Identifier
-  "null" -> Identifier
-  "undefined" -> Identifier
-  "type_identifier" -> Identifier
-  "property_identifier" -> Identifier
-  "shorthand_property_identifier" -> Identifier
-  "nested_identifier" -> Identifier
-  "arrow_function" -> Function
-  "generator_function" -> Function
-  "math_op" -> MathOperator -- math operator, e.g. +, -, *, /.
-  "update_expression" -> MathOperator -- math operator, e.g. ++, --
-  "bool_op" -> BooleanOperator -- boolean operator, e.g. ||, &&.
-  "comma_op" -> CommaOperator -- comma operator, e.g. expr1, expr2.
-  "sequence_expression" -> CommaOperator -- comma operator, e.g. expr1, expr2.
-  "delete_op" -> Operator -- delete operator, e.g. delete x[2].
-  "type_op" -> Operator -- type operator, e.g. typeof Object.
-  "void_op" -> Operator -- void operator, e.g. void 2.
-  "for_statement" -> For
-  "trailing_for_statement" -> For
-  "for_in_statement" -> For
-  "trailing_for_in_statement" -> For
-  "for_of_statement" -> For
-  "trailing_for_of_statement" -> For
-  "new_expression" -> Constructor
-  "class"  -> Class
-  "catch" -> Catch
-  "catch_clause" -> Catch
-  "finally" -> Finally
-  "finally_clause" -> Finally
-  "if_statement" -> If
-  "trailing_if_statement" -> If
-  "empty_statement" -> Empty
-  "program" -> Program
-  "function_call" -> FunctionCall
-  "call_expression" -> FunctionCall
-  "pair" -> Pair
-  "string" -> StringLiteral
-  "integer" -> IntegerLiteral
-  "number" -> NumberLiteral
-  "float" -> FloatLiteral
-  "symbol" -> SymbolLiteral
-  "array" -> ArrayLiteral
-  "function" -> Function
-  "identifier" -> Identifier
-  "formal_parameters" -> Params
-  "arguments" -> Args
-  "statement_block" -> ExpressionStatements
-  "assignment" -> Assignment
-  "assignment_expression" -> Assignment
-  "member_access" -> MemberAccess
-  "member_expression" -> MemberAccess
-  "op" -> Operator
-  "subscript_access" -> SubscriptAccess
-  "subscript_expression" -> SubscriptAccess
-  "regex" -> Regex
-  "template_string" -> TemplateString
-  "switch_statement" -> Switch
-  "math_assignment" -> MathAssignment
-  "augmented_assignment_expression" -> MathAssignment
-  "case" -> Case
-  "switch_case" -> Case
-  "true" -> Boolean
-  "false" -> Boolean
-  "ternary" -> Ternary
-  "ternary_expression" -> Ternary
-  "while_statement" -> While
-  "trailing_while_statement" -> While
-  "do_statement" -> DoWhile
-  "trailing_do_statement" -> DoWhile
-  "return_statement" -> Return
-  "trailing_return_statement" -> Return
-  "throw_statement" -> Throw
-  "trailing_throw_statement" -> Throw
-  "try_statement" -> Try
-  "method_definition" -> Method
-  "comment" -> Comment
-  "bitwise_op" -> BitwiseOperator
-  "rel_op" -> RelationalOperator
-  "import_statement" -> Import
-  "export_statement" -> Export
-  "break_statement" -> Break
-  "continue_statement" -> Continue
-  "yield_expression" -> Yield
-  "public_field_definition" -> FieldDecl
-  "variable_declarator" -> VarAssignment
-  "type_annotation" -> Ty
-  "template_chars" -> TemplateString
-  "module" -> Module
-  "internal_module" -> Namespace
-  "interface_declaration" -> Interface
-  "parenthesized_expression" -> ParenthesizedExpression
-  name -> Other name

src/Semantic.hs

@@ -83,7 +83,14 @@ diffBlobPairs renderer = fmap toOutput . distributeFoldMap (diffBlobPair rendere
 diffBlobPair :: DiffRenderer output -> Both Blob -> Task output
 diffBlobPair renderer blobs = case (renderer, effectiveLanguage) of
   (OldToCDiffRenderer, lang)
-    | lang `elem` [ Just Language.Markdown, Just Language.Python, Just Language.Ruby ]
+    | elem lang $ fmap Just [
+        Language.JSX,
+        Language.JavaScript,
+        Language.Markdown,
+        Language.Python,
+        Language.Ruby,
+        Language.TypeScript
+      ]
     , Just (SomeParser parser) <- lang >>= someParser (Proxy :: Proxy '[Diffable, Eq1, Foldable, Functor, GAlign, HasDeclaration, Show1, Traversable]) ->
       run (\ blob -> parse parser blob >>= decorate (declarationAlgebra blob)) diffTerms (renderToCDiff blobs)
     | Just syntaxParser <- lang >>= syntaxParserForLanguage ->

src/TreeSitter.hs

@@ -20,7 +20,6 @@ import Data.Term
 import Data.Text (Text, pack)
 import Language
 import qualified Language.Go as Go
-import qualified Language.TypeScript as TypeScript
 import Foreign
 import Foreign.C.String (peekCString)
 import Foreign.Marshal.Array (allocaArray)
@@ -29,7 +28,6 @@ import qualified TreeSitter.Document as TS
 import qualified TreeSitter.Node as TS
 import qualified TreeSitter.Language as TS
 import qualified TreeSitter.Go as TS
-import qualified TreeSitter.TypeScript as TS
 import Info
 
 -- | Returns a TreeSitter parser for the given language and TreeSitter grammar.
@@ -112,7 +110,6 @@ assignTerm language source annotation children allChildren =
   where assignTermByLanguage :: Source -> Category -> [ Term S.Syntax (Record DefaultFields) ] -> Maybe (S.Syntax (Term S.Syntax (Record DefaultFields)))
         assignTermByLanguage = case languageForTSLanguage language of
           Just Language.Go -> Go.termAssignment
-          Just TypeScript -> TypeScript.termAssignment
           _ -> \ _ _ _ -> Nothing
 
 defaultTermAssignment :: Source -> Record DefaultFields -> [ Term S.Syntax (Record DefaultFields) ] -> IO [ Term S.Syntax (Record DefaultFields) ] -> IO (Term S.Syntax (Record DefaultFields))
@@ -190,12 +187,10 @@ categoryForLanguageProductionName = withDefaults . byLanguage
 
     byLanguage language = case languageForTSLanguage language of
       Just Language.Go -> Go.categoryForGoName
-      Just Language.TypeScript -> TypeScript.categoryForTypeScriptName
       _ -> Other
 
 
 languageForTSLanguage :: Ptr TS.Language -> Maybe Language
 languageForTSLanguage = flip lookup
   [ (TS.tree_sitter_go, Language.Go)
-  , (TS.tree_sitter_typescript, TypeScript)
   ]

test/fixtures/go/select-statements.diffA-B.txt

@@ -35,5 +35,5 @@
       (FunctionCall
         (Identifier)
         (NumberLiteral))
-      (Other "default_communication_case")
+      (Other "default_case")
       (Return))))

test/fixtures/go/select-statements.diffB-A.txt

@@ -35,5 +35,5 @@
       (FunctionCall
         (Identifier)
         (NumberLiteral))
-      (Other "default_communication_case")
+      (Other "default_case")
       (Return))))

test/fixtures/go/select-statements.parseA.txt

@@ -32,5 +32,5 @@
       (FunctionCall
         (Identifier)
         (NumberLiteral))
-      (Other "default_communication_case")
+      (Other "default_case")
       (Return))))

test/fixtures/go/select-statements.parseB.txt

@@ -32,5 +32,5 @@
       (FunctionCall
         (Identifier)
         (NumberLiteral))
-      (Other "default_communication_case")
+      (Other "default_case")
       (Return))))

test/fixtures/go/type-switch-statements.diffA-B.txt

@@ -5,8 +5,9 @@
     (Identifier)
     (Args)
     (Switch
-    { (Identifier)
-    ->(Identifier) }
+      (Other "type_switch_guard"
+      { (Identifier)
+      ->(Identifier) })
       (Case
         (Other "type_case"
           (SliceTy

test/fixtures/go/type-switch-statements.diffB-A.txt

@@ -5,8 +5,9 @@
     (Identifier)
     (Args)
     (Switch
-    { (Identifier)
-    ->(Identifier) }
+      (Other "type_switch_guard"
+      { (Identifier)
+      ->(Identifier) })
       (Case
         (Other "type_case"
           (SliceTy

test/fixtures/go/type-switch-statements.parseA.txt

@@ -5,7 +5,8 @@
     (Identifier)
     (Args)
     (Switch
-      (Identifier)
+      (Other "type_switch_guard"
+        (Identifier))
       (Case
         (Other "type_case"
           (SliceTy

test/fixtures/go/type-switch-statements.parseB.txt

@@ -5,7 +5,8 @@
     (Identifier)
     (Args)
     (Switch
-      (Identifier)
+      (Other "type_switch_guard"
+        (Identifier))
       (Case
         (Other "type_case"
           (SliceTy

vendor/haskell-tree-sitter

@@ -1 +1 @@
-Subproject commit 6afbe26030215b424dff2aed107c5321c8eb8e93
+Subproject commit 1baeb2f3eaa29457de0ce343ce579f7405731c24