mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 02:25:39 +03:00
more mergeblob work
This commit is contained in:
parent
c88c4a3643
commit
53209c3b69
@ -49,7 +49,6 @@ import Unison.Cli.UpdateUtils
|
||||
( getNamespaceDependentsOf3,
|
||||
hydrateDefns,
|
||||
loadNamespaceDefinitions,
|
||||
parseAndTypecheck,
|
||||
renderDefnsForUnisonFile,
|
||||
)
|
||||
import Unison.Codebase (Codebase)
|
||||
@ -73,6 +72,7 @@ import Unison.ConstructorType (ConstructorType)
|
||||
import Unison.DataDeclaration (Decl)
|
||||
import Unison.DataDeclaration qualified as DataDeclaration
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.FileParsers qualified as FileParsers
|
||||
import Unison.Hash qualified as Hash
|
||||
import Unison.Merge qualified as Merge
|
||||
import Unison.Merge.DeclNameLookup (expectConstructorNames)
|
||||
@ -84,9 +84,10 @@ import Unison.Merge.Unconflicts qualified as Unconflicts
|
||||
import Unison.Name (Name)
|
||||
import Unison.NameSegment (NameSegment)
|
||||
import Unison.NameSegment qualified as NameSegment
|
||||
import Unison.Names (Names)
|
||||
import Unison.Names (Names (..))
|
||||
import Unison.Names qualified as Names
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Parsers qualified as Parsers
|
||||
import Unison.Prelude
|
||||
import Unison.Project
|
||||
( ProjectAndBranch (..),
|
||||
@ -101,13 +102,18 @@ import Unison.Reference qualified as Reference
|
||||
import Unison.Referent (Referent)
|
||||
import Unison.Referent qualified as Referent
|
||||
import Unison.ReferentPrime qualified as Referent'
|
||||
import Unison.Result qualified as Result
|
||||
import Unison.Sqlite (Transaction)
|
||||
import Unison.Sqlite qualified as Sqlite
|
||||
import Unison.Symbol (Symbol)
|
||||
import Unison.Syntax.Name qualified as Name
|
||||
import Unison.Syntax.Parser (ParsingEnv (..), UniqueName)
|
||||
import Unison.Syntax.Parser qualified as Parser
|
||||
import Unison.Term (Term)
|
||||
import Unison.Type (Type)
|
||||
import Unison.UnisonFile (TypecheckedUnisonFile)
|
||||
import Unison.Typechecker qualified as Typechecker
|
||||
import Unison.Typechecker.TypeLookup (TypeLookup)
|
||||
import Unison.UnisonFile (TypecheckedUnisonFile, UnisonFile)
|
||||
import Unison.UnisonFile qualified as UnisonFile
|
||||
import Unison.Util.BiMultimap (BiMultimap)
|
||||
import Unison.Util.BiMultimap qualified as BiMultimap
|
||||
@ -297,14 +303,16 @@ doMerge info = do
|
||||
mergedLibdeps <-
|
||||
Cli.runTransaction (libdepsToBranch0 (Codebase.getDeclType env.codebase) blob2.libdeps)
|
||||
|
||||
let blob3 = makeMergeblob3 blob2 dependents0 (Branch.toNames mergedLibdeps)
|
||||
uniqueName <- liftIO env.generateUniqueName
|
||||
|
||||
liftIO (debugFunctions.debugDependents (bimap Map.keysSet Map.keysSet <$> blob3.dependents))
|
||||
let hasConflicts =
|
||||
blob2.hasConflicts
|
||||
|
||||
liftIO (debugFunctions.debugStageOne blob3.stageOne)
|
||||
|
||||
let prettyUnisonFile =
|
||||
makePrettyUnisonFile
|
||||
let blob3 =
|
||||
makeMergeblob3
|
||||
blob2
|
||||
dependents0
|
||||
(Branch.toNames mergedLibdeps)
|
||||
Merge.TwoWay
|
||||
{ alice = into @Text aliceBranchNames,
|
||||
bob =
|
||||
@ -318,27 +326,25 @@ doMerge info = do
|
||||
Nothing -> "<root>"
|
||||
Just name -> Name.toText name
|
||||
}
|
||||
blob3.conflicts
|
||||
blob3.dependents
|
||||
|
||||
maybeBlob5 <-
|
||||
if hasConflicts
|
||||
then pure Nothing
|
||||
else case makeMergeblob4 blob3 uniqueName of
|
||||
Left _parseErr -> pure Nothing
|
||||
Right blob4 -> do
|
||||
typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies)
|
||||
pure case makeMergeblob5 blob4 typeLookup of
|
||||
Left _typecheckErr -> Nothing
|
||||
Right blob5 -> Just blob5
|
||||
|
||||
let stageOneBranch = defnsAndLibdepsToBranch0 env.codebase blob3.stageOne mergedLibdeps
|
||||
|
||||
maybeTypecheckedUnisonFile <-
|
||||
let thisMergeHasConflicts =
|
||||
-- Eh, they'd either both be null, or neither, but just check both maps anyway
|
||||
not (defnsAreEmpty blob3.conflicts.alice) || not (defnsAreEmpty blob3.conflicts.bob)
|
||||
in if thisMergeHasConflicts
|
||||
then pure Nothing
|
||||
else do
|
||||
currentPath <- Cli.getCurrentProjectPath
|
||||
parsingEnv <- Cli.makeParsingEnv currentPath (Branch.toNames stageOneBranch)
|
||||
parseAndTypecheck prettyUnisonFile parsingEnv
|
||||
|
||||
let parents =
|
||||
causals <&> \causal -> (causal.causalHash, Codebase.expectBranchForHash env.codebase causal.causalHash)
|
||||
|
||||
case maybeTypecheckedUnisonFile of
|
||||
Nothing -> do
|
||||
blob5 <-
|
||||
maybeBlob5 & onNothing do
|
||||
Cli.Env {writeSource} <- ask
|
||||
(_temporaryBranchId, temporaryBranchName) <-
|
||||
HandleInput.Branch.createBranch
|
||||
@ -349,21 +355,20 @@ doMerge info = do
|
||||
)
|
||||
info.alice.projectAndBranch.project
|
||||
(findTemporaryBranchName info.alice.projectAndBranch.project.projectId mergeSourceAndTarget)
|
||||
|
||||
scratchFilePath <-
|
||||
Cli.getLatestFile <&> \case
|
||||
Nothing -> "scratch.u"
|
||||
Just (file, _) -> file
|
||||
liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 prettyUnisonFile)
|
||||
pure (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName)
|
||||
Just tuf -> do
|
||||
Cli.runTransaction (Codebase.addDefsToCodebase env.codebase tuf)
|
||||
let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds tuf) stageOneBranch
|
||||
Cli.updateProjectBranchRoot_
|
||||
info.alice.projectAndBranch.branch
|
||||
info.description
|
||||
(\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob)
|
||||
pure (Output.MergeSuccess mergeSourceAndTarget)
|
||||
liftIO $ writeSource (Text.pack scratchFilePath) (Text.pack $ Pretty.toPlain 80 blob3.unparsedFile)
|
||||
done (Output.MergeFailure scratchFilePath mergeSourceAndTarget temporaryBranchName)
|
||||
|
||||
Cli.runTransaction (Codebase.addDefsToCodebase env.codebase blob5.file)
|
||||
let stageTwoBranch = Branch.batchUpdates (typecheckedUnisonFileToBranchAdds blob5.file) stageOneBranch
|
||||
Cli.updateProjectBranchRoot_
|
||||
info.alice.projectAndBranch.branch
|
||||
info.description
|
||||
(\_aliceBranch -> Branch.mergeNode stageTwoBranch parents.alice parents.bob)
|
||||
pure (Output.MergeSuccess mergeSourceAndTarget)
|
||||
|
||||
Cli.respond finalOutput
|
||||
|
||||
@ -496,6 +501,7 @@ data Mergeblob2 libdep = Mergeblob2
|
||||
coreDependencies :: Merge.TwoWay (DefnsF Set TermReference TypeReference),
|
||||
declNameLookups :: Merge.TwoWay Merge.DeclNameLookup,
|
||||
defns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name)),
|
||||
hasConflicts :: Bool,
|
||||
hydratedDefns ::
|
||||
Merge.TwoWay
|
||||
( DefnsF
|
||||
@ -535,6 +541,8 @@ makeMergeblob2 blob = do
|
||||
coreDependencies,
|
||||
declNameLookups = blob.declNameLookups,
|
||||
defns = blob.defns,
|
||||
-- Eh, they'd either both be null, or neither, but just check both maps anyway
|
||||
hasConflicts = not (defnsAreEmpty conflicts.alice) || not (defnsAreEmpty conflicts.bob),
|
||||
hydratedDefns = ThreeWay.forgetLca blob.hydratedDefns,
|
||||
lcaDeclNameLookup = blob.lcaDeclNameLookup,
|
||||
libdeps = blob.libdeps,
|
||||
@ -543,17 +551,18 @@ makeMergeblob2 blob = do
|
||||
}
|
||||
|
||||
data Mergeblob3 = Mergeblob3
|
||||
{ conflicts :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
|
||||
dependents :: Merge.TwoWay (DefnsF (Map Name) (Pretty ColorText) (Pretty ColorText)),
|
||||
stageOne :: DefnsF (Map Name) Referent TypeReference
|
||||
{ libdeps :: Names,
|
||||
stageOne :: DefnsF (Map Name) Referent TypeReference,
|
||||
unparsedFile :: Pretty ColorText
|
||||
}
|
||||
|
||||
makeMergeblob3 ::
|
||||
Mergeblob2 libdep ->
|
||||
Merge.TwoWay (DefnsF Set TermReferenceId TypeReferenceId) ->
|
||||
Names ->
|
||||
Merge.TwoWay Text ->
|
||||
Mergeblob3
|
||||
makeMergeblob3 blob dependents0 libdeps =
|
||||
makeMergeblob3 blob dependents0 libdeps authors =
|
||||
-- Identify the unconflicted dependents we need to pull into the Unison file (either first for typechecking, if
|
||||
-- there aren't conflicts, or else for manual conflict resolution without a typechecking step, if there are)
|
||||
let dependents =
|
||||
@ -579,14 +588,6 @@ makeMergeblob3 blob dependents0 libdeps =
|
||||
<*> dependents0
|
||||
)
|
||||
|
||||
stageOne =
|
||||
makeStageOne
|
||||
blob.declNameLookups
|
||||
blob.conflictsNames
|
||||
blob.unconflicts
|
||||
dependents
|
||||
(bimap BiMultimap.range BiMultimap.range blob.defns.lca)
|
||||
|
||||
(renderedConflicts, renderedDependents) =
|
||||
renderConflictsAndDependents
|
||||
blob.declNameLookups
|
||||
@ -596,11 +597,59 @@ makeMergeblob3 blob dependents0 libdeps =
|
||||
(defnsToNames <$> ThreeWay.forgetLca blob.defns)
|
||||
libdeps
|
||||
in Mergeblob3
|
||||
{ conflicts = renderedConflicts,
|
||||
dependents = renderedDependents,
|
||||
stageOne
|
||||
{ libdeps,
|
||||
stageOne =
|
||||
makeStageOne
|
||||
blob.declNameLookups
|
||||
blob.conflictsNames
|
||||
blob.unconflicts
|
||||
dependents
|
||||
(bimap BiMultimap.range BiMultimap.range blob.defns.lca),
|
||||
unparsedFile = makePrettyUnisonFile authors renderedConflicts renderedDependents
|
||||
}
|
||||
|
||||
data Mergeblob4 = Mergeblob4
|
||||
{ dependencies :: Set Reference,
|
||||
file :: UnisonFile Symbol Ann
|
||||
}
|
||||
|
||||
makeMergeblob4 :: Mergeblob3 -> UniqueName -> Either (Parser.Err Symbol) Mergeblob4
|
||||
makeMergeblob4 blob uniqueName = 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,
|
||||
names = stageOneNames
|
||||
}
|
||||
file <- runIdentity (Parsers.parseFile "<merge>" (Pretty.toPlain 80 blob.unparsedFile) parsingEnv)
|
||||
Right
|
||||
Mergeblob4
|
||||
{ dependencies = UnisonFile.dependencies file,
|
||||
file
|
||||
}
|
||||
|
||||
data Mergeblob5 = Mergeblob5
|
||||
{ file :: TypecheckedUnisonFile Symbol Ann
|
||||
}
|
||||
|
||||
makeMergeblob5 :: Mergeblob4 -> TypeLookup Symbol Ann -> Either (Seq (Result.Note Symbol Ann)) Mergeblob5
|
||||
makeMergeblob5 blob typeLookup =
|
||||
let typecheckingEnv =
|
||||
Typechecker.Env
|
||||
{ ambientAbilities = [],
|
||||
termsByShortname = Map.empty,
|
||||
typeLookup
|
||||
}
|
||||
in case runIdentity (Result.runResultT (FileParsers.synthesizeFile typecheckingEnv blob.file)) of
|
||||
(Nothing, notes) -> Left notes
|
||||
(Just file, _) -> Right Mergeblob5 {file}
|
||||
|
||||
renderConflictsAndDependents ::
|
||||
Merge.TwoWay Merge.DeclNameLookup ->
|
||||
Merge.TwoWay (DefnsF (Map Name) (TermReferenceId, (Term Symbol Ann, Type Symbol Ann)) (TypeReferenceId, Decl Symbol Ann)) ->
|
||||
@ -1058,9 +1107,7 @@ data DebugFunctions = DebugFunctions
|
||||
debugPartitionedDiff ::
|
||||
Merge.TwoWay (DefnsF (Map Name) TermReferenceId TypeReferenceId) ->
|
||||
DefnsF Merge.Unconflicts Referent TypeReference ->
|
||||
IO (),
|
||||
debugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO (),
|
||||
debugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO ()
|
||||
IO ()
|
||||
}
|
||||
|
||||
realDebugFunctions :: DebugFunctions
|
||||
@ -1069,14 +1116,12 @@ realDebugFunctions =
|
||||
{ debugCausals = realDebugCausals,
|
||||
debugDiffs = realDebugDiffs,
|
||||
debugCombinedDiff = realDebugCombinedDiff,
|
||||
debugPartitionedDiff = realDebugPartitionedDiff,
|
||||
debugDependents = realDebugDependents,
|
||||
debugStageOne = realDebugStageOne
|
||||
debugPartitionedDiff = realDebugPartitionedDiff
|
||||
}
|
||||
|
||||
fakeDebugFunctions :: DebugFunctions
|
||||
fakeDebugFunctions =
|
||||
DebugFunctions mempty mempty mempty mempty mempty mempty
|
||||
DebugFunctions mempty mempty mempty mempty
|
||||
|
||||
realDebugCausals :: Merge.TwoOrThreeWay (V2.CausalBranch Transaction) -> IO ()
|
||||
realDebugCausals causals = do
|
||||
@ -1251,38 +1296,6 @@ realDebugPartitionedDiff conflicts unconflicts = do
|
||||
<> " "
|
||||
<> renderRef ref
|
||||
|
||||
realDebugDependents :: Merge.TwoWay (DefnsF Set Name Name) -> IO ()
|
||||
realDebugDependents dependents = do
|
||||
Text.putStrLn (Text.bold "\n=== Alice dependents of Bob deletes, Bob updates, and Alice conflicts ===")
|
||||
renderThings "termid" dependents.alice.terms
|
||||
renderThings "typeid" dependents.alice.types
|
||||
Text.putStrLn (Text.bold "\n=== Bob dependents of Alice deletes, Alice updates, and Bob conflicts ===")
|
||||
renderThings "termid" dependents.bob.terms
|
||||
renderThings "typeid" dependents.bob.types
|
||||
where
|
||||
renderThings :: Text -> Set Name -> IO ()
|
||||
renderThings label things =
|
||||
for_ (Set.toList things) \name ->
|
||||
Text.putStrLn $
|
||||
Text.italic label
|
||||
<> " "
|
||||
<> Name.toText name
|
||||
|
||||
realDebugStageOne :: DefnsF (Map Name) Referent TypeReference -> IO ()
|
||||
realDebugStageOne defns = do
|
||||
Text.putStrLn (Text.bold "\n=== Stage 1 ===")
|
||||
debugDefns1 defns
|
||||
|
||||
debugDefns1 :: DefnsF (Map Name) Referent TypeReference -> IO ()
|
||||
debugDefns1 defns = do
|
||||
renderThings referentLabel Referent.toText defns.terms
|
||||
renderThings (const "type") Reference.toText defns.types
|
||||
where
|
||||
renderThings :: (ref -> Text) -> (ref -> Text) -> Map Name ref -> IO ()
|
||||
renderThings label renderRef things =
|
||||
for_ (Map.toList things) \(name, ref) ->
|
||||
Text.putStrLn (Text.italic (label ref) <> " " <> Name.toText name <> " " <> renderRef ref)
|
||||
|
||||
referentLabel :: Referent -> Text
|
||||
referentLabel ref
|
||||
| Referent'.isConstructor ref = "constructor"
|
||||
|
@ -699,11 +699,8 @@ project/main> branch bob
|
||||
```
|
||||
|
||||
Bob's renames `Qux` to `BobQux`:
|
||||
```unison:hide
|
||||
unique type Foo = Baz Nat | BobQux Text
|
||||
```
|
||||
```ucm:hide
|
||||
project/bob> update
|
||||
```ucm
|
||||
project/bob> move.term Foo.Qux Foo.BobQux
|
||||
```
|
||||
```ucm:error
|
||||
project/alice> merge /bob
|
||||
|
@ -789,10 +789,12 @@ unique type Foo = Baz Nat Nat | Qux Text
|
||||
|
||||
Bob's renames `Qux` to `BobQux`:
|
||||
|
||||
``` unison
|
||||
unique type Foo = Baz Nat | BobQux Text
|
||||
```
|
||||
``` ucm
|
||||
project/bob> move.term Foo.Qux Foo.BobQux
|
||||
|
||||
Done.
|
||||
|
||||
```
|
||||
``` ucm
|
||||
project/alice> merge /bob
|
||||
|
||||
@ -818,7 +820,7 @@ project/alice> merge /bob
|
||||
type Foo = Baz Nat Nat | Qux Text
|
||||
|
||||
-- project/bob
|
||||
type Foo = Baz Nat | BobQux Text
|
||||
type Foo = BobQux Text | Baz Nat
|
||||
|
||||
```
|
||||
|
||||
@ -1022,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 = Baz Nat | Hello Nat Nat
|
||||
type Foo.Bar = Hello Nat Nat | Baz 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.
|
||||
@ -1059,7 +1061,7 @@ Foo.Bar.Hello : Nat
|
||||
Foo.Bar.Hello = 18
|
||||
|
||||
-- project/bob
|
||||
type Foo.Bar = Baz Nat | Hello Nat Nat
|
||||
type Foo.Bar = Hello Nat Nat | Baz Nat
|
||||
|
||||
```
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user