mirror of
https://github.com/github/semantic.git
synced 2024-12-01 09:15:01 +03:00
DiffInfo are now either LeafInfos or BranchInfos
This commit is contained in:
joshvera
parent
13671e5d14
commit
e57f30f20b
@ -9,10 +9,6 @@ import Term
|
||||
import Info (category, Cost)
|
||||
import Syntax
|
||||
import Category
|
||||
import Interpreter (diffTerms)
|
||||
import Diffing
|
||||
import Data.Align
|
||||
import Data.These
|
||||
import Data.Functor.Foldable as Foldable
|
||||
import Data.Functor.Both
|
||||
import Data.Text as Text (intercalate)
|
||||
@ -23,7 +19,9 @@ import Text.PrettyPrint.Leijen.Text ((<+>), squotes, space, string)
|
||||
import qualified Text.PrettyPrint.Leijen.Text as P
|
||||
import Data.Hashable
|
||||
|
||||
data DiffInfo = DiffInfo { categoryName :: Text, termName :: Text } deriving (Eq, Show)
|
||||
data DiffInfo = LeafInfo { categoryName :: Text, termName :: Text }
|
||||
| BranchInfo { branches :: [ DiffInfo ], categoryName :: Text, branchType :: Branch }
|
||||
deriving (Eq, Show)
|
||||
|
||||
toTermName :: (HasCategory leaf, HasField fields Category) => Term leaf (Record fields) -> Text
|
||||
toTermName term = case unwrap term of
|
||||
@ -110,19 +108,18 @@ instance HasCategory Category where
|
||||
instance (HasCategory leaf, HasField fields Category) => HasCategory (Term leaf (Record fields)) where
|
||||
toCategoryName = toCategoryName . category . extract
|
||||
|
||||
data Branch = Indexed | Fixed deriving (Show, Eq, Generic)
|
||||
data Branch = BIndexed | BFixed | BCommented deriving (Show, Eq, Generic)
|
||||
instance Arbitrary Branch where
|
||||
arbitrary = oneof [ pure DiffSummary.Indexed, pure DiffSummary.Fixed ]
|
||||
arbitrary = oneof [ pure BIndexed, pure BFixed ]
|
||||
shrink = genericShrink
|
||||
|
||||
data DiffSummary a = DiffSummary {
|
||||
patch :: Patch a,
|
||||
parentAnnotations :: [Category],
|
||||
patchAnnotations :: [Patch Branch]
|
||||
parentAnnotations :: [Category]
|
||||
} deriving (Eq, Functor, Show, Generic)
|
||||
|
||||
instance (Eq a, Arbitrary a) => Arbitrary (DiffSummary a) where
|
||||
arbitrary = DiffSummary <$> arbitrary <*> arbitrary <*> arbitrary
|
||||
arbitrary = DiffSummary <$> arbitrary <*> arbitrary
|
||||
shrink = genericShrink
|
||||
|
||||
instance P.Pretty (DiffSummary DiffInfo) where
|
||||
@ -160,53 +157,26 @@ diffSummary = cata $ \case
|
||||
Free (infos :< (Syntax.Object kvs)) -> prependSummary (category $ snd infos) <$> join kvs
|
||||
Free (infos :< (Syntax.Pair a b)) -> prependSummary (category $ snd infos) <$> a <> b
|
||||
Free (infos :< (Syntax.Commented cs leaf)) -> prependSummary (category $ snd infos) <$> join cs <> fromMaybe [] leaf
|
||||
(Pure (Insert term)) -> (\info -> DiffSummary (Insert info) [] []) <$> termToDiffInfo term
|
||||
(Pure (Insert term)) -> case unwrap term of
|
||||
(Syntax.Indexed terms) ->
|
||||
(\info -> DiffSummary (Insert info) [] [Delete DiffSummary.Indexed]) <$> (join $ termToDiffInfo <$> terms)
|
||||
(Syntax.Fixed terms) ->
|
||||
(\info -> DiffSummary (Insert info) [] [Delete DiffSummary.Fixed]) <$> (join $ termToDiffInfo <$> terms)
|
||||
(Pure (Delete term)) -> case unwrap term of
|
||||
(Syntax.Indexed terms) ->
|
||||
(\info -> DiffSummary (Delete info) [] [Delete DiffSummary.Indexed]) <$> termToDiffInfo term
|
||||
(Syntax.Fixed terms) ->
|
||||
(\info -> DiffSummary (Delete info) [] [Delete DiffSummary.Fixed]) <$> termToDiffInfo term
|
||||
(Pure (Replace t1 t2)) -> case (unwrap t1, unwrap t2) of
|
||||
(Syntax.Indexed t1', Syntax.Indexed t2') ->
|
||||
(\patch -> DiffSummary patch [] [Replace DiffSummary.Indexed DiffSummary.Indexed]) <$> join (alignWith summarizeThese t1' t2')
|
||||
(Syntax.Indexed t1', Syntax.Fixed t2') ->
|
||||
(\patch -> DiffSummary patch [] [Replace DiffSummary.Indexed DiffSummary.Fixed]) <$> join (alignWith summarizeThese t1' t2')
|
||||
(Syntax.Fixed t1', Syntax.Indexed t2') ->
|
||||
(\patch -> DiffSummary patch [] [Replace DiffSummary.Fixed DiffSummary.Indexed]) <$> join (alignWith summarizeThese t1' t2')
|
||||
(Syntax.Fixed t1', Syntax.Fixed t2') ->
|
||||
(\patch -> DiffSummary patch [] [Replace DiffSummary.Fixed DiffSummary.Fixed]) <$> join (alignWith summarizeThese t1' t2')
|
||||
(_, _) ->
|
||||
(\(info1, info2) -> DiffSummary (Replace info1 info2) [] []) <$> zip (termToDiffInfo t1) (termToDiffInfo t2)
|
||||
(Pure (Insert term)) -> [ DiffSummary (Insert $ termToDiffInfo term) [] ]
|
||||
(Pure (Delete term)) -> [ DiffSummary (Delete $ termToDiffInfo term) [] ]
|
||||
(Pure (Replace t1 t2)) -> [ DiffSummary (Replace (termToDiffInfo t1) (termToDiffInfo t2)) [] ]
|
||||
|
||||
summarizeThese :: (HasCategory leaf, HasField fields Category, Hashable leaf, Show (Record fields), Show leaf, Ord (Record fields), Eq leaf, HasField fields Cost) => These (Term leaf (Record fields)) (Term leaf (Record fields)) -> [Patch DiffInfo]
|
||||
summarizeThese = these (sequence . Delete <$> termToDiffInfo) (sequence . Insert <$> termToDiffInfo) (\t1 t2 -> patch <$> summaries t1 t2)
|
||||
where
|
||||
summaries :: (HasCategory leaf, HasField fields Category, Hashable leaf, Show (Record fields), Show leaf, Ord (Record fields), Eq leaf, HasField fields Cost) => Term leaf (Record fields) -> Term leaf (Record fields) -> [DiffSummary DiffInfo]
|
||||
summaries t1 t2 = diffSummary $ diffTerms construct compareCategoryEq diffCostWithCachedTermSizes t1 t2
|
||||
|
||||
termToDiffInfo :: (HasCategory leaf, HasField fields Category) => Term leaf (Record fields) -> [DiffInfo]
|
||||
termToDiffInfo :: (HasCategory leaf, HasField fields Category) => Term leaf (Record fields) -> DiffInfo
|
||||
termToDiffInfo term = case runCofree term of
|
||||
(_ :< Leaf _) -> [ DiffInfo (toCategoryName term) (toTermName term) ]
|
||||
(info :< Syntax.Indexed children) -> if null children
|
||||
then [ DiffInfo (toCategoryName (Categorizable info)) (toTermName term) ]
|
||||
else join $ termToDiffInfo <$> children
|
||||
(info :< Syntax.Fixed children) -> if null children then [ DiffInfo (toCategoryName (Categorizable info)) (toTermName term) ] else join $ termToDiffInfo <$> children
|
||||
(info :< Syntax.FunctionCall identifier _) -> [ DiffInfo (toCategoryName (Categorizable info)) (toTermName identifier) ]
|
||||
(info :< Syntax.Ternary ternaryCondition _) -> [ DiffInfo (toCategoryName (Categorizable info)) (toTermName ternaryCondition) ]
|
||||
(info :< Syntax.Function identifier _ _) -> [ DiffInfo (toCategoryName $ Categorizable info) (maybe "anonymous" toTermName identifier) ]
|
||||
(info :< Syntax.Assignment identifier _) -> [ DiffInfo (toCategoryName $ Categorizable info) (toTermName identifier) ]
|
||||
(info :< Syntax.MathAssignment identifier _) -> [ DiffInfo (toCategoryName $ Categorizable info) (toTermName identifier) ]
|
||||
(_ :< Leaf _) -> LeafInfo (toCategoryName term) (toTermName term)
|
||||
(info :< Syntax.Indexed children) -> BranchInfo (termToDiffInfo <$> children) (toCategoryName (Categorizable info)) BIndexed
|
||||
(info :< Syntax.Fixed children) -> BranchInfo (termToDiffInfo <$> children) (toCategoryName (Categorizable info)) BFixed
|
||||
(info :< Syntax.FunctionCall identifier _) -> LeafInfo (toCategoryName (Categorizable info)) (toTermName identifier)
|
||||
(info :< Syntax.Ternary ternaryCondition _) -> LeafInfo (toCategoryName (Categorizable info)) (toTermName ternaryCondition)
|
||||
(info :< Syntax.Function identifier _ _) -> LeafInfo (toCategoryName $ Categorizable info) (maybe "anonymous" toTermName identifier)
|
||||
(info :< Syntax.Assignment identifier _) -> LeafInfo (toCategoryName $ Categorizable info) (toTermName identifier)
|
||||
(info :< Syntax.MathAssignment identifier _) -> LeafInfo (toCategoryName $ Categorizable info) (toTermName identifier)
|
||||
-- Currently we cannot express the operator for an operator production from TreeSitter. Eventually we should be able to
|
||||
-- use the term name of the operator identifier when we have that production value. Until then, I'm using a placeholder value
|
||||
-- to indicate where that value should be when constructing DiffInfos.
|
||||
(info :< Syntax.Operator _) -> [DiffInfo (toCategoryName $ Categorizable info) "x"]
|
||||
(info :< Commented cs leaf) -> join (termToDiffInfo <$> cs) <> maybe [] (\leaf -> [ DiffInfo (toCategoryName $ Categorizable info) (toTermName leaf) ]) leaf
|
||||
(info :< _) -> [ DiffInfo (toCategoryName $ Categorizable info) (toTermName term) ]
|
||||
(info :< Syntax.Operator _) -> LeafInfo (toCategoryName $ Categorizable info) "x"
|
||||
(info :< Commented cs leaf) -> BranchInfo (termToDiffInfo <$> cs <> maybeToList leaf) (toCategoryName $ Categorizable info) BCommented
|
||||
(info :< _) -> LeafInfo (toCategoryName $ Categorizable info) (toTermName term)
|
||||
|
||||
prependSummary :: Category -> DiffSummary DiffInfo -> DiffSummary DiffInfo
|
||||
prependSummary annotation summary = summary { parentAnnotations = annotation : parentAnnotations summary }
|
||||
|
||||
@ -14,10 +14,7 @@ import Category
|
||||
import DiffSummary
|
||||
import Text.PrettyPrint.Leijen.Text (pretty)
|
||||
import Test.Hspec.QuickCheck
|
||||
import Interpreter
|
||||
import Diff.Arbitrary
|
||||
import Text.Megaparsec.Text
|
||||
import Text.Megaparsec
|
||||
import Data.List (partition)
|
||||
|
||||
arrayInfo :: Info
|
||||
@ -30,16 +27,16 @@ testDiff :: Diff Text Info
|
||||
testDiff = free $ Free (pure arrayInfo :< Indexed [ free $ Pure (Insert (cofree $ literalInfo :< Leaf "a")) ])
|
||||
|
||||
testSummary :: DiffSummary DiffInfo
|
||||
testSummary = DiffSummary { patch = Insert (DiffInfo "string" "a"), parentAnnotations = [], patchAnnotations = [] }
|
||||
testSummary = DiffSummary { patch = Insert (LeafInfo "string" "a"), parentAnnotations = [] }
|
||||
|
||||
replacementSummary :: DiffSummary DiffInfo
|
||||
replacementSummary = DiffSummary { patch = Replace (DiffInfo "string" "a") (DiffInfo "symbol" "b"), parentAnnotations = [ ArrayLiteral ], patchAnnotations = [] }
|
||||
replacementSummary = DiffSummary { patch = Replace (LeafInfo "string" "a") (LeafInfo "symbol" "b"), parentAnnotations = [ ArrayLiteral ] }
|
||||
|
||||
spec :: Spec
|
||||
spec = parallel $ do
|
||||
describe "diffSummary" $ do
|
||||
it "outputs a diff summary" $ do
|
||||
diffSummary testDiff `shouldBe` [ DiffSummary { patch = Insert (DiffInfo "string" "a"), parentAnnotations = [ ArrayLiteral ], patchAnnotations = [] } ]
|
||||
diffSummary testDiff `shouldBe` [ DiffSummary { patch = Insert (LeafInfo "string" "a"), parentAnnotations = [ ArrayLiteral ] } ]
|
||||
describe "show" $ do
|
||||
it "should print adds" $
|
||||
show (pretty testSummary) `shouldBe` ("Added the 'a' string" :: Text)
|
||||
@ -59,23 +56,15 @@ spec = parallel $ do
|
||||
(Indexed _) -> True
|
||||
(Fixed _) -> True
|
||||
_ -> False
|
||||
isBranchInfo info = case info of
|
||||
(BranchInfo _ _ _) -> True
|
||||
(LeafInfo _ _) -> False
|
||||
isBranchNode :: DiffSummary DiffInfo -> Bool
|
||||
isBranchNode summary = (not . null $ patchAnnotations summary) || (case patch summary of
|
||||
(Insert diffInfo) -> termName diffInfo == "branch"
|
||||
(Delete diffInfo) -> termName diffInfo == "branch"
|
||||
(Replace i1 i2) -> termName i1 == "branch" || termName i2 == "branch")
|
||||
isBranchNode summary = (case patch summary of
|
||||
(Insert diffInfo) -> isBranchInfo diffInfo
|
||||
(Delete diffInfo) -> isBranchInfo diffInfo
|
||||
(Replace i1 i2) -> isBranchInfo i1 || isBranchInfo i2)
|
||||
in
|
||||
case (partition isBranchNode summaries, partition isIndexedOrFixed patches) of
|
||||
((branchSummaries, otherSummaries), (branchPatches, otherPatches)) ->
|
||||
((() <$) . patch <$> branchSummaries, (() <$) . patch <$> otherSummaries) `shouldBe` ((() <$) <$> branchPatches, (() <$) <$> otherPatches)
|
||||
|
||||
-- ((() <$) <$> (patch <$> summaries)) `shouldBe` ((() <$) <$> patches)
|
||||
-- [Insert (), Insert ()] == [ Insert () ]
|
||||
-- explodePatch :: Patch (Syntax a) -> [Patch (Syntax a)]
|
||||
-- explodePatch Indexed = explodePatch <$> children
|
||||
|
||||
-- Patches of branch nodes with children should have a summary for each child that is not a branch node
|
||||
-- Patches of branch nodes with children that are branch nodes shoudl have a summary for each of those children or one summary per branch if the branches are empty
|
||||
-- let xs = ArbitraryPure (Insert (ArbitraryTerm {annotation = Category.Operator .: RNil, syntax = Indexed [ArbitraryTerm {annotation = Program .: RNil, syntax = Leaf ""}]}))
|
||||
-- let xs = ArbitraryPure (Delete (ArbitraryTerm {annotation = Category.Case .: RNil, syntax = Fixed [ArbitraryTerm {annotation = Category.FunctionCall .: RNil, syntax = Leaf ""}]})) :: ArbitraryDiff Text (Record '[Category])
|
||||
-- ((() <$) . patch <$> summaries) `shouldBe` ((() <$) <$> otherPatches)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user