diff --git a/semantic-diff.cabal b/semantic-diff.cabal index 7e97af58c..bf9263a81 100644 --- a/semantic-diff.cabal +++ b/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 diff --git a/src/Files.hs b/src/Files.hs index 2c011bd90..4f2636f72 100644 --- a/src/Files.hs +++ b/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) diff --git a/src/Language/JSON/Assignment.hs b/src/Language/JSON/Assignment.hs index 98c62af4b..2914d6f6e 100644 --- a/src/Language/JSON/Assignment.hs +++ b/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) diff --git a/src/Language/Python/Assignment.hs b/src/Language/Python/Assignment.hs index 722f101da..f7439d83b 100644 --- a/src/Language/Python/Assignment.hs +++ b/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 diff --git a/src/Language/TypeScript.hs b/src/Language/TypeScript.hs deleted file mode 100644 index a04b88b86..000000000 --- a/src/Language/TypeScript.hs +++ /dev/null @@ -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 diff --git a/src/Semantic.hs b/src/Semantic.hs index 68cfaf7fe..3e741c7a7 100644 --- a/src/Semantic.hs +++ b/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 -> diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs index fd49a099e..9f1991cc2 100644 --- a/src/TreeSitter.hs +++ b/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) ] diff --git a/test/fixtures/go/select-statements.diffA-B.txt b/test/fixtures/go/select-statements.diffA-B.txt index 19458413b..e964d899b 100644 --- a/test/fixtures/go/select-statements.diffA-B.txt +++ b/test/fixtures/go/select-statements.diffA-B.txt @@ -35,5 +35,5 @@ (FunctionCall (Identifier) (NumberLiteral)) - (Other "default_communication_case") + (Other "default_case") (Return)))) diff --git a/test/fixtures/go/select-statements.diffB-A.txt b/test/fixtures/go/select-statements.diffB-A.txt index 19458413b..e964d899b 100644 --- a/test/fixtures/go/select-statements.diffB-A.txt +++ b/test/fixtures/go/select-statements.diffB-A.txt @@ -35,5 +35,5 @@ (FunctionCall (Identifier) (NumberLiteral)) - (Other "default_communication_case") + (Other "default_case") (Return)))) diff --git a/test/fixtures/go/select-statements.parseA.txt b/test/fixtures/go/select-statements.parseA.txt index 8589f54be..eaf90636d 100644 --- a/test/fixtures/go/select-statements.parseA.txt +++ b/test/fixtures/go/select-statements.parseA.txt @@ -32,5 +32,5 @@ (FunctionCall (Identifier) (NumberLiteral)) - (Other "default_communication_case") + (Other "default_case") (Return)))) diff --git a/test/fixtures/go/select-statements.parseB.txt b/test/fixtures/go/select-statements.parseB.txt index 8589f54be..eaf90636d 100644 --- a/test/fixtures/go/select-statements.parseB.txt +++ b/test/fixtures/go/select-statements.parseB.txt @@ -32,5 +32,5 @@ (FunctionCall (Identifier) (NumberLiteral)) - (Other "default_communication_case") + (Other "default_case") (Return)))) diff --git a/test/fixtures/go/type-switch-statements.diffA-B.txt b/test/fixtures/go/type-switch-statements.diffA-B.txt index 8f2a7df7a..47d4a17e1 100644 --- a/test/fixtures/go/type-switch-statements.diffA-B.txt +++ b/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 diff --git a/test/fixtures/go/type-switch-statements.diffB-A.txt b/test/fixtures/go/type-switch-statements.diffB-A.txt index 8f2a7df7a..47d4a17e1 100644 --- a/test/fixtures/go/type-switch-statements.diffB-A.txt +++ b/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 diff --git a/test/fixtures/go/type-switch-statements.parseA.txt b/test/fixtures/go/type-switch-statements.parseA.txt index 7376ebe91..300ab4933 100644 --- a/test/fixtures/go/type-switch-statements.parseA.txt +++ b/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 diff --git a/test/fixtures/go/type-switch-statements.parseB.txt b/test/fixtures/go/type-switch-statements.parseB.txt index 7376ebe91..300ab4933 100644 --- a/test/fixtures/go/type-switch-statements.parseB.txt +++ b/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 diff --git a/vendor/haskell-tree-sitter b/vendor/haskell-tree-sitter index 6afbe2603..1baeb2f3e 160000 --- a/vendor/haskell-tree-sitter +++ b/vendor/haskell-tree-sitter @@ -1 +1 @@ -Subproject commit 6afbe26030215b424dff2aed107c5321c8eb8e93 +Subproject commit 1baeb2f3eaa29457de0ce343ce579f7405731c24