reuse unique type guids in merge after all

unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs

@@ -280,8 +280,6 @@ doMerge info = do
       mergedLibdeps <-
         Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps)
 
-      uniqueName <- liftIO env.generateUniqueName
-
       let hasConflicts =
             blob2.hasConflicts
 
@@ -307,7 +305,7 @@ doMerge info = do
       maybeBlob5 <-
         if hasConflicts
           then pure Nothing
-          else case Merge.makeMergeblob4 blob3 uniqueName of
+          else case Merge.makeMergeblob4 blob3 of
             Left _parseErr -> pure Nothing
             Right blob4 -> do
               typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies)

unison-merge/src/Unison/Merge/Mergeblob3.hs

@@ -15,6 +15,7 @@ import Data.Set.NonEmpty qualified as Set.NonEmpty
 import Data.These (These (..))
 import Data.Zip (unzip)
 import Unison.DataDeclaration (Decl)
+import Unison.DataDeclaration qualified as DataDeclaration
 import Unison.DeclNameLookup (DeclNameLookup, expectConstructorNames)
 import Unison.Merge.Mergeblob2 (Mergeblob2 (..))
 import Unison.Merge.PrettyPrintEnv (makePrettyPrintEnvs)
@@ -46,6 +47,7 @@ import Prelude hiding (unzip)
 data Mergeblob3 = Mergeblob3
   { libdeps :: Names,
     stageOne :: DefnsF (Map Name) Referent TypeReference,
+    uniqueTypeGuids :: Map Name Text,
     unparsedFile :: Pretty ColorText
   }
 
@@ -102,6 +104,7 @@ makeMergeblob3 blob dependents0 libdeps authors =
               blob.unconflicts
               dependents
               (bimap BiMultimap.range BiMultimap.range blob.defns.lca),
+          uniqueTypeGuids = makeUniqueTypeGuids blob.hydratedDefns,
           unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents
         }
 
@@ -295,3 +298,46 @@ makePrettyUnisonFile authors conflicts dependents =
       bimap f f
       where
         f = map snd . List.sortOn (Name.toText . fst) . Map.toList
+
+-- Given Alice's and Bob's hydrated defns, make a mapping from unique type name to unique type GUID, preferring Alice's
+-- GUID if they both have one.
+makeUniqueTypeGuids ::
+  TwoWay
+    ( DefnsF
+        (Map Name)
+        (TermReferenceId, (Term Symbol Ann, Type Symbol Ann))
+        (TypeReferenceId, Decl Symbol Ann)
+    ) ->
+  Map Name Text
+makeUniqueTypeGuids hydratedDefns =
+  let -- Start off with just Alice's GUIDs
+      aliceGuids :: Map Name Text
+      aliceGuids =
+        Map.mapMaybe (declGuid . snd) hydratedDefns.alice.types
+
+      -- Define a helper that adds a Bob GUID only if it's not already in the map (so, preferring Alice)
+      addBobGuid :: Map Name Text -> (Name, (TypeReferenceId, Decl Symbol Ann)) -> Map Name Text
+      addBobGuid acc (name, (_, bobDecl)) =
+        Map.alter
+          ( \case
+              Nothing -> bobGuid
+              Just aliceGuid -> Just aliceGuid
+          )
+          name
+          acc
+        where
+          bobGuid :: Maybe Text
+          bobGuid =
+            declGuid bobDecl
+
+      -- Tumble in all of Bob's GUIDs with that helper
+      allTheGuids :: Map Name Text
+      allTheGuids =
+        List.foldl' addBobGuid aliceGuids (Map.toList hydratedDefns.bob.types)
+   in allTheGuids
+  where
+    declGuid :: Decl v a -> Maybe Text
+    declGuid decl =
+      case (DataDeclaration.asDataDecl decl).modifier of
+        DataDeclaration.Structural -> Nothing
+        DataDeclaration.Unique guid -> Just guid

unison-merge/src/Unison/Merge/Mergeblob4.hs

@@ -4,6 +4,7 @@ module Unison.Merge.Mergeblob4
   )
 where
 
+import Data.Map.Strict qualified as Map
 import Unison.Merge.Mergeblob3 (Mergeblob3 (..))
 import Unison.Names (Names (..))
 import Unison.Parser.Ann (Ann)
@@ -11,7 +12,7 @@ import Unison.Parsers qualified as Parsers
 import Unison.Prelude
 import Unison.Reference (Reference)
 import Unison.Symbol (Symbol)
-import Unison.Syntax.Parser (ParsingEnv (..), UniqueName)
+import Unison.Syntax.Parser (ParsingEnv (..))
 import Unison.Syntax.Parser qualified as Parser
 import Unison.UnisonFile (UnisonFile)
 import Unison.UnisonFile qualified as UnisonFile
@@ -24,18 +25,18 @@ data Mergeblob4 = Mergeblob4
     file :: UnisonFile Symbol Ann
   }
 
-makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4
-makeMergeblob4 blob uniqueName = do
+makeMergeblob4 :: Mergeblob3 -> Either (Parser.Err Symbol) Mergeblob4
+makeMergeblob4 blob = do
   let stageOneNames =
         Names (Relation.fromMap blob.stageOne.terms) (Relation.fromMap blob.stageOne.types) <> blob.libdeps
 
       parsingEnv =
         ParsingEnv
-          { uniqueNames = uniqueName,
-            -- The codebase names are disjoint from the file names, i.e. there aren't any things that
-            -- would be classified as an update upon parsing. So, there's no need to try to look up any
-            -- existing unique type GUIDs to reuse.
-            uniqueTypeGuid = \_ -> Identity Nothing,
+          { -- We don't expect to have to generate any new GUIDs, since the uniqueTypeGuid lookup function below should
+            -- cover all name in the merged file we're about to parse and typecheck. So, this might be more correct as a
+            -- call to `error`.
+            uniqueNames = Parser.UniqueName \_ _ -> Nothing,
+            uniqueTypeGuid = \name -> Identity (Map.lookup name blob.uniqueTypeGuids),
             names = stageOneNames
           }
   file <- runIdentity (Parsers.parseFile "<merge>" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv)

unison-src/transcripts/merge.output.md

@@ -1024,7 +1024,7 @@ Bob, meanwhile, first deletes the term, then sort of deletes the type and re-add
 ``` ucm
 project/bob> view Foo.Bar
 
-  type Foo.Bar = Hello Nat Nat | Baz Nat
+  type Foo.Bar = Baz Nat | Hello Nat Nat
 
 ```
 At this point, Bob and alice have both updated the name `Foo.Bar.Hello` in different ways, so that's a conflict. Therefore, Bob's entire type (`Foo.Bar` with constructors `Foo.Bar.Baz` and `Foo.Bar.Hello`) gets rendered into the scratch file.
@@ -1061,7 +1061,7 @@ Foo.Bar.Hello : Nat
 Foo.Bar.Hello = 18
 
 -- project/bob
-type Foo.Bar = Hello Nat Nat | Baz Nat
+type Foo.Bar = Baz Nat | Hello Nat Nat
 
 ```
 

unison-syntax/src/Unison/Syntax/Parser.hs

@@ -9,7 +9,7 @@ module Unison.Syntax.Parser
     Input (..),
     P,
     ParsingEnv (..),
-    UniqueName,
+    UniqueName(..),
     anyToken,
     blank,
     bytesToken,