mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
reuse unique type guids in merge after all
This commit is contained in:
parent
4c30192553
commit
28543adcdd
@ -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)
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
@ -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
|
||||
|
||||
```
|
||||
|
||||
|
@ -9,7 +9,7 @@ module Unison.Syntax.Parser
|
||||
Input (..),
|
||||
P,
|
||||
ParsingEnv (..),
|
||||
UniqueName,
|
||||
UniqueName(..),
|
||||
anyToken,
|
||||
blank,
|
||||
bytesToken,
|
||||
|
Loading…
Reference in New Issue
Block a user