diff --git a/src/Category.hs b/src/Category.hs index 04711450c..60981312e 100644 --- a/src/Category.hs +++ b/src/Category.hs @@ -51,6 +51,8 @@ data Category | VarAssignment -- | A variable declaration. | VarDecl + | Switch + | Case -- | A non-standard category, which can be used for comparability. | Other Text deriving (Eq, Show, Ord) diff --git a/src/Diff/Arbitrary.hs b/src/Diff/Arbitrary.hs index 79473e95c..4358b81ee 100644 --- a/src/Diff/Arbitrary.hs +++ b/src/Diff/Arbitrary.hs @@ -74,4 +74,6 @@ instance (Eq leaf, Eq annotation, Arbitrary leaf, Arbitrary annotation) => Arbit Syntax.MemberAccess memberId property -> Syntax.MemberAccess <$> shrink memberId <*> shrink property Syntax.VarDecl decl -> Syntax.VarDecl <$> shrink decl Syntax.VarAssignment varId value -> Syntax.VarAssignment <$> shrink varId <*> shrink value + Syntax.Switch switchExpr cases -> Syntax.Switch <$> shrink switchExpr <*> (List.subsequences cases >>= recursivelyShrink) + Syntax.Case expr statements -> Syntax.Case <$> shrink expr <*> shrink statements Pure patch -> ArbitraryDiff . Pure <$> shrink patch diff --git a/src/DiffSummary.hs b/src/DiffSummary.hs index c7bf2cc75..4fa07e295 100644 --- a/src/DiffSummary.hs +++ b/src/DiffSummary.hs @@ -36,9 +36,13 @@ toTermName term = case unwrap term of _ -> "." Syntax.VarAssignment varId _ -> toTermName varId Syntax.VarDecl decl -> toTermName decl - -- TODO: We should remove Args from Syntax since I don't think we shouldn ever + -- TODO: We should remove Args from Syntax since I don't think we should ever -- evaluate Args as a single toTermName Text - joshvera Syntax.Args args -> mconcat $ toTermName <$> args + -- TODO: We should remove Case from Syntax since I don't think we should ever + -- evaluate Case as a single toTermName Text - joshvera + Syntax.Case expr _ -> toTermName expr + Syntax.Switch expr _ -> toTermName expr class HasCategory a where toCategoryName :: a -> Text @@ -64,7 +68,9 @@ instance HasCategory Category where Category.MethodCall -> "method call" Category.Args -> "arguments" Category.VarAssignment -> "var assignment" - Category.VarDecl -> "var declaration" + Category.VarDecl -> "variable" + Category.Switch -> "switch statement" + Category.Case -> "case statement" Identifier -> "identifier" IntegerLiteral -> "integer" Other s -> s @@ -110,6 +116,8 @@ diffSummary = cata $ \case (Free (infos :< Syntax.VarAssignment varId value)) -> prependSummary (category $ snd infos) <$> varId <> value (Free (infos :< Syntax.VarDecl decl)) -> prependSummary (category $ snd infos) <$> decl (Free (infos :< Syntax.Args args)) -> prependSummary (category $ snd infos) <$> join args + (Free (infos :< Syntax.Switch expr cases)) -> prependSummary (category $ snd infos) <$> expr <> join cases + (Free (infos :< Syntax.Case expr body)) -> prependSummary (category $ snd infos) <$> expr <> body (Pure (Insert term)) -> (\info -> DiffSummary (Insert info) []) <$> termToDiffInfo term (Pure (Delete term)) -> (\info -> DiffSummary (Delete info) []) <$> termToDiffInfo term (Pure (Replace t1 t2)) -> (\(info1, info2) -> DiffSummary (Replace info1 info2) []) <$> zip (termToDiffInfo t1) (termToDiffInfo t2) @@ -130,6 +138,7 @@ termToDiffInfo term = case runCofree term of args@(info :< Syntax.Args{}) -> [ DiffInfo (toCategoryName info) (toTermName $ cofree args) ] varDecl@(info :< Syntax.VarDecl{}) -> [ DiffInfo (toCategoryName info) (toTermName $ cofree varDecl) ] varAssignment@(info :< Syntax.VarAssignment{}) -> [ DiffInfo (toCategoryName info) (toTermName $ cofree varAssignment) ] + switch@(info :< Syntax.Switch{}) -> [ DiffInfo (toCategoryName info) (toTermName $ cofree switch) ] prependSummary :: Category -> DiffSummary DiffInfo -> DiffSummary DiffInfo prependSummary annotation summary = summary { parentAnnotations = annotation : parentAnnotations summary } diff --git a/src/Parser.hs b/src/Parser.hs index 1a6cce911..f06d9c24f 100644 --- a/src/Parser.hs +++ b/src/Parser.hs @@ -66,7 +66,13 @@ termConstructor source info = cofree . construct construct children | VarDecl == category info = withDefaultInfo . S.Indexed $ toVarDecl <$> children where toVarDecl :: Term Text Info -> Term Text Info - toVarDecl child = cofree $ (extract child :< S.VarDecl child) + toVarDecl child = cofree $ ((extract child) { category = VarDecl } :< S.VarDecl child) + + construct children | Switch == category info , (expr:cases) <- children = + withDefaultInfo $ S.Switch expr children + + construct children | Case == category info , [expr, body] <- children = + withDefaultInfo $ S.Case expr body construct children | isFixed (category info) = withDefaultInfo $ S.Fixed children construct children | isKeyed (category info) = withDefaultInfo . S.Keyed . Map.fromList $ assignKey <$> children diff --git a/src/Renderer/JSON.hs b/src/Renderer/JSON.hs index 177eedb5b..f88e87fbc 100644 --- a/src/Renderer/JSON.hs +++ b/src/Renderer/JSON.hs @@ -77,6 +77,10 @@ termFields Info{..} syntax = "range" .= characterRange : "category" .= category Syntax.Args c -> childrenFields c Syntax.Assignment assignmentId property -> [ "assignmentIdentifier" .= assignmentId ] <> [ "property" .= property ] Syntax.MemberAccess memberId value -> [ "memberIdentifier" .= memberId ] <> [ "value" .= value ] + Syntax.Switch expr cases -> [ "switchExpression" .= expr ] <> [ "cases" .= cases ] + Syntax.Case expr body -> [ "caseExpression" .= expr ] <> [ "caseStatement" .= body ] + Syntax.VarDecl decl -> [ "variableDeclaration" .= decl ] + Syntax.VarAssignment id value -> [ "varIdentifier" .= id ] <> [ "value" .= value ] where childrenFields c = [ "children" .= c ] patchFields :: KeyValue kv => SplitPatch (Term leaf Info) -> [kv] diff --git a/src/Renderer/Split.hs b/src/Renderer/Split.hs index cc25536fc..e3774cdd0 100644 --- a/src/Renderer/Split.hs +++ b/src/Renderer/Split.hs @@ -53,6 +53,8 @@ styleName category = "category-" <> case category of Category.MemberAccess -> "member_access" Category.VarDecl -> "var_declaration" Category.VarAssignment -> "var_assignment" + Category.Switch -> "switch" + Category.Case -> "case" TemplateString -> "template_string" Regex -> "regex" Identifier -> "identifier" @@ -124,6 +126,8 @@ instance ToMarkup f => ToMarkup (Renderable (Source Char, Info, Syntax a (f, Ran Syntax.VarDecl decl -> ul . mconcat $ wrapIn li <$> contentElements source characterRange [decl] Syntax.VarAssignment varId value -> dl . mconcat $ (wrapIn dt <$> (contentElements source characterRange [varId])) <> (wrapIn dd <$> contentElements source characterRange [value]) + Syntax.Switch expr cases -> ul . mconcat $ wrapIn li <$> contentElements source characterRange (expr : cases) + Syntax.Case expr body -> ul . mconcat $ wrapIn li <$> contentElements source characterRange [expr, body] contentElements :: (Foldable t, ToMarkup f) => Source Char -> Range -> t (f, Range) -> [Markup] contentElements source range children = let (elements, next) = foldr' (markupForContextAndChild source) ([], end range) children in text (toText (slice (Range (start range) (max next (start range))) source)) : elements diff --git a/src/Syntax.hs b/src/Syntax.hs index 88bf3f4d0..ddd3d5c85 100644 --- a/src/Syntax.hs +++ b/src/Syntax.hs @@ -32,6 +32,10 @@ data Syntax -- | The list of arguments to a method call. -- | TODO: It might be worth removing this and using Fixed instead. | Args [f] + -- | A variable declaration. e.g. var foo; | VarDecl f + -- | A variable assignment in a variable declaration. var foo = bar; | VarAssignment { varId :: f, varValue :: f } + | Switch { switchExpr :: f, cases :: [f] } + | Case { caseExpr :: f, caseStatements :: f } deriving (Functor, Show, Eq, Foldable, Traversable) diff --git a/src/Term/Arbitrary.hs b/src/Term/Arbitrary.hs index 477ce2915..9ab502552 100644 --- a/src/Term/Arbitrary.hs +++ b/src/Term/Arbitrary.hs @@ -59,3 +59,5 @@ instance (Eq leaf, Eq annotation, Arbitrary leaf, Arbitrary annotation) => Arbit VarAssignment varId value -> VarAssignment <$> shrink varId <*> shrink value Assignment id value -> Assignment <$> shrink id <*> shrink value MemberAccess memberId property -> MemberAccess <$> shrink memberId <*> shrink property + Switch expr cases -> Switch <$> shrink expr <*> (List.subsequences cases >>= recursivelyShrink) + Case expr statements -> Case <$> shrink expr <*> shrink statements diff --git a/src/TreeSitter.hs b/src/TreeSitter.hs index 0bdc89b6a..de765e94d 100644 --- a/src/TreeSitter.hs +++ b/src/TreeSitter.hs @@ -59,6 +59,8 @@ defaultCategoryForNodeName name = case name of "template_string" -> TemplateString "var_assignment" -> VarAssignment "var_declaration" -> VarDecl + "switch_statement" -> Switch + "case" -> Case "true" -> Boolean "false" -> Boolean _ -> Other name