use BranchDiff.allNameChanges to compute adds, removes, and renames

parser-typechecker/src/Unison/Codebase/BranchDiff.hs

@@ -33,8 +33,7 @@ data DiffSlice r = DiffSlice {
   tallnamespaceUpdates :: Relation3 r r Name,
   talladds :: Relation r Name,
   tallremoves :: Relation r Name,
-  tcopies :: Map r (Set Name, Set Name), -- ref (old, new)
-  tmoves :: Map r (Set Name, Set Name), -- ref (old, new)
+  trenames :: Map r (Set Name, Set Name), -- ref (old, new)
   taddedMetadata :: Relation3 r Name Metadata.Value,
   tremovedMetadata :: Relation3 r Name Metadata.Value
 } deriving Show
@@ -92,51 +91,36 @@ computeSlices :: NamespaceSlice Referent
               -> (DiffSlice Referent, DiffSlice Reference)
 computeSlices oldTerms newTerms oldTypes newTypes = (termsOut, typesOut) where
   termsOut =
-    let copies' = copies oldTerms newTerms in
+    let nc = allNameChanges oldTerms newTerms in
     DiffSlice
-    (allNamespaceUpdates oldTerms newTerms)
-    (allAdds oldTerms newTerms copies')
-    (allRemoves oldTerms newTerms)
-    copies'
-    (moves oldTerms newTerms)
-    (addedMetadata oldTerms newTerms)
-    (removedMetadata oldTerms newTerms)
-  typesOut = let
-    copies' = copies oldTypes newTypes in
+      (allNamespaceUpdates oldTerms newTerms)
+      (allAdds nc)
+      (allRemoves nc)
+      (remainingNameChanges nc)
+      (addedMetadata oldTerms newTerms)
+      (removedMetadata oldTerms newTerms)
+  typesOut =
+    let nc = allNameChanges oldTypes newTypes in
     DiffSlice
-    (allNamespaceUpdates oldTypes newTypes)
-    (allAdds oldTypes newTypes copies')
-    (allRemoves oldTypes newTypes)
-    copies'
-    (moves oldTypes newTypes)
-    (addedMetadata oldTypes newTypes)
-    (removedMetadata oldTypes newTypes)
+      (allNamespaceUpdates oldTypes newTypes)
+      (allAdds nc)
+      (allRemoves nc)
+      (remainingNameChanges nc)
+      (addedMetadata oldTypes newTypes)
+      (removedMetadata oldTypes newTypes)
 
-  copies :: Ord r => NamespaceSlice r -> NamespaceSlice r -> Map r (Set Name, Set Name)
-  copies old new =
-    -- pair the set of old names with the set of names that are only new
-    R.toUnzippedMultimap $
-      names old `R.joinDom` (names new `R.difference` names old)
+  allNameChanges :: Ord r => NamespaceSlice r -> NamespaceSlice r -> Map r (Set Name, Set Name)
+  allNameChanges old new = R.outerJoinDomMultimaps (names old) (names new)
 
-  moves :: Ord r => NamespaceSlice r -> NamespaceSlice r -> Map r (Set Name, Set Name)
-  moves old new =
-    R.toUnzippedMultimap $
-      (names old `R.difference` names new)
-        `R.joinDom` (names new `R.difference` names old)
+  allAdds, allRemoves :: forall r. Ord r
+                      => Map r (Set Name, Set Name) -> Relation r Name
+  allAdds    = R.fromMultimap . fmap snd . Map.filter (null . fst)
+  allRemoves = R.fromMultimap . fmap fst . Map.filter (null . snd)
 
-  allAdds :: forall r. Ord r
-          => NamespaceSlice r
-          -> NamespaceSlice r
-          -> Map r (Set Name, Set Name)
-          -> R.Relation r Name
-  allAdds old new copies =
-    names new `R.difference` names old `R.difference` copies'
-    where
-    copies' :: Relation r Name
-    copies' = R.fromMultimap $ snd <$> copies
-
-  allRemoves :: Ord r => NamespaceSlice r -> NamespaceSlice r -> R.Relation r Name
-  allRemoves old new = names old `R.difference` names new
+  remainingNameChanges :: forall r. Ord r
+                       => Map r (Set Name, Set Name) -> Map r (Set Name, Set Name)
+  remainingNameChanges =
+    Map.filter (\(old, new) -> not (null old) && not (null new))
 
   allNamespaceUpdates :: Ord r => NamespaceSlice r -> NamespaceSlice r -> Relation3 r r Name
   allNamespaceUpdates old new =

parser-typechecker/src/Unison/Codebase/Editor/Output/BranchDiff.hs

@@ -55,10 +55,8 @@ data BranchDiffOutput v a = BranchDiffOutput {
   removedTypes      :: [RemovedTypeDisplay v a],
   removedTerms      :: [RemovedTermDisplay v a],
   removedPatches    :: [PatchDisplay],
-  movedTypes        :: [RenameTypeDisplay v a],
-  movedTerms        :: [RenameTermDisplay v a],
-  copiedTypes       :: [RenameTypeDisplay v a],
-  copiedTerms       :: [RenameTermDisplay v a]
+  renamedTypes      :: [RenameTypeDisplay v a],
+  renamedTerms      :: [RenameTermDisplay v a]
  } deriving Show
 
 isEmpty :: BranchDiffOutput v a -> Bool
@@ -66,8 +64,7 @@ isEmpty BranchDiffOutput{..} =
   null updatedTypes && null updatedTerms &&
   null addedTypes && null addedTerms && null addedPatches &&
   null removedTypes && null removedTerms && null removedPatches &&
-  null movedTypes && null movedTerms &&
-  null copiedTypes && null copiedTerms &&
+  null renamedTypes && null renamedTerms &&
   propagatedUpdates == 0
 
 -- Need to be able to turn a (Name,Reference) into a HashQualified relative to... what.
@@ -246,26 +243,24 @@ toOutput typeOf declOrBuiltin hqLen names1 names2 ppe
         [ (name, diff)
         | (name, BranchDiff.Delete diff) <- Map.toList patchesDiff ]
 
-  let movedOrCopiedTerm :: Map Referent (Set Name, Set Name) -> m [RenameTermDisplay v a]
-      movedOrCopiedTerm copiesOrMoves =
-        for (Map.toList copiesOrMoves) $ \(r, (ol'names, new'names)) ->
+  let renamedTerm :: Map Referent (Set Name, Set Name) -> m [RenameTermDisplay v a]
+      renamedTerm renames =
+        for (Map.toList renames) $ \(r, (ol'names, new'names)) ->
           (,,,) <$> pure r
                 <*> typeOf r
                 <*> pure (Set.map (\n -> Names2.hqTermName hqLen names1 n r) ol'names)
                 <*> pure (Set.map (\n -> Names2.hqTermName hqLen names2 n r) new'names)
 
-  let movedOrCopiedType :: Map Reference (Set Name, Set Name) -> m [RenameTypeDisplay v a]
-      movedOrCopiedType copiesOrMoves =
-        for (Map.toList copiesOrMoves) $ \(r, (ol'names, new'names)) ->
+  let renamedType :: Map Reference (Set Name, Set Name) -> m [RenameTypeDisplay v a]
+      renamedType renames =
+        for (Map.toList renames) $ \(r, (ol'names, new'names)) ->
           (,,,) <$> pure r
                 <*> declOrBuiltin r
                 <*> pure (Set.map (\n -> Names2.hqTypeName hqLen names1 n r) ol'names)
                 <*> pure (Set.map (\n -> Names2.hqTypeName hqLen names2 n r) new'names)
 
-  movedTypes :: [RenameTypeDisplay v a] <- movedOrCopiedType (BranchDiff.tmoves typesDiff)
-  movedTerms :: [RenameTermDisplay v a] <- movedOrCopiedTerm (BranchDiff.tmoves termsDiff)
-  copiedTypes :: [RenameTypeDisplay v a] <- movedOrCopiedType (BranchDiff.tcopies typesDiff)
-  copiedTerms :: [RenameTermDisplay v a] <- movedOrCopiedTerm (BranchDiff.tcopies termsDiff)
+  renamedTypes :: [RenameTypeDisplay v a] <- renamedType (BranchDiff.trenames typesDiff)
+  renamedTerms :: [RenameTermDisplay v a] <- renamedTerm (BranchDiff.trenames termsDiff)
 
   pure $ BranchDiffOutput
     updatedTypes
@@ -278,19 +273,17 @@ toOutput typeOf declOrBuiltin hqLen names1 names2 ppe
     removedTypes
     removedTerms
     removedPatches
-    movedTypes
-    movedTerms
-    copiedTypes
-    copiedTerms
+    renamedTypes
+    renamedTerms
   where
   fillMetadata :: Traversable t => PPE.PrettyPrintEnv -> t Metadata.Value -> m (t (MetadataDisplay v a))
   fillMetadata ppe = traverse $ -- metadata values are all terms
     \(Referent.Ref -> mdRef) -> (HQ'.unsafeFromHQ $ PPE.termName ppe mdRef, mdRef, ) <$> typeOf mdRef
-  _getMetadata :: Ord r => r -> Name -> R3.Relation3 r Name Metadata.Value -> Set Metadata.Value
-  _getMetadata r n r3 = R.lookupDom n . R3.lookupD1 r $ r3
+  getMetadata :: Ord r => r -> Name -> R3.Relation3 r Name Metadata.Value -> Set Metadata.Value
+  getMetadata r n r3 = R.lookupDom n . R3.lookupD1 r $ r3
 
   getAddedMetadata :: Ord r => r -> Name -> BranchDiff.DiffSlice r -> Set Metadata.Value
-  getAddedMetadata r n slice = _getMetadata r n $ BranchDiff.taddedMetadata slice
+  getAddedMetadata r n slice = getMetadata r n $ BranchDiff.taddedMetadata slice
 
 -- references for definitions that were updated
 

parser-typechecker/src/Unison/CommandLine/OutputMessages.hs

@@ -1270,26 +1270,16 @@ showDiffNamespace ppe oldPath newPath OBD.BranchDiffOutput{..} =
                                        , P.linesNonEmpty prettyRemovedPatches ]
        ]
     else pure mempty
-   ,if (not . null) movedTypes
-    || (not . null) movedTerms
+   ,if (not . null) renamedTypes
+    || (not . null) renamedTerms
     then do
-      results <- prettyRenameGroups movedTypes movedTerms
+      results <- prettyRenameGroups renamedTypes renamedTerms
       pure $ P.sepNonEmpty "\n\n"
-        [ P.bold "Moves:"
+        [ P.bold "Name changes:"
         , P.indentN 2 . P.sepNonEmpty "\n\n" $ results
         ]
         -- todo: change separator to just '\n' here if all the results are 1 to 1
     else pure mempty
-   ,if (not . null) copiedTypes
-    || (not . null) copiedTerms
-    then do
-      results <- prettyRenameGroups copiedTypes copiedTerms
-      pure $ P.sepNonEmpty "\n\n"
-        [ P.bold "Copies:"
-        , P.indentN 2 . P.sepNonEmpty "\n\n" $ results
-        -- todo: change separator to just '\n' here if all the results are 1 to 1
-        ]
-    else pure mempty
    ]
 
   {-

unison-core/src/Unison/Util/Relation.hs

@@ -96,6 +96,20 @@ intersection r s
   | size r > size s = intersection s r
   | otherwise       = filter (\(a, b) -> member a b s) r
 
+outerJoinDomMultimaps :: (Ord a, Ord b, Ord c)
+                      => Relation a b
+                      -> Relation a c
+                      -> Map a (Set b, Set c)
+outerJoinDomMultimaps b c =
+  Map.fromList
+    [ (a, (lookupDom a b, lookupDom a c)) | a <- S.toList (dom b <> dom c) ]
+
+outerJoinRanMultimaps :: (Ord a, Ord b, Ord c)
+                      => Relation a c
+                      -> Relation b c
+                      -> Map c (Set a, Set b)
+outerJoinRanMultimaps a b = outerJoinDomMultimaps (swap a) (swap b)
+
 joinDom :: (Ord a, Ord b, Ord c) => Relation a b -> Relation a c -> Relation a (b,c)
 joinDom b c = swap $ joinRan (swap b) (swap c)