Skip to content

bugfix: make upgrade not over-suffixify in certain cases #4500

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Dec 12, 2023
Merged

bugfix: make upgrade not over-suffixify in certain cases #4500

Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
e9529b8
bugfix: make upgrade not over-suffixify in certain cases
mitchellwrosen Dec 12, 2023
7ea7c4e
fix bug in upgrade bugfix
mitchellwrosen Dec 12, 2023
2a3184c
tweak
mitchellwrosen Dec 12, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
166 changes: 63 additions & 103 deletions unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,12 +74,13 @@ handleUpgrade oldDepName newDepName = do
currentV1Branch <- Cli.getBranch0At projectPath
let currentV1BranchWithoutOldDep = deleteLibdep oldDepName currentV1Branch
oldDep <- Cli.expectBranch0AtPath' oldDepPath
let oldDepWithoutDeps = over Branch.children (Map.delete Name.libSegment) oldDep
let oldDepWithoutDeps = deleteLibdeps oldDep
let oldTransitiveDeps = fromMaybe Branch.empty0 $ fmap Branch.head $ Map.lookup Name.libSegment (oldDep ^. Branch.children)

newDepV1Branch <- Cli.expectBranch0AtPath' newDepPath
newDep <- Cli.expectBranch0AtPath' newDepPath
let newDepWithoutDeps = deleteLibdeps newDep

let namesExcludingLibdeps = Branch.toNames (currentV1Branch & over Branch.children (Map.delete Name.libSegment))
let namesExcludingLibdeps = Branch.toNames (deleteLibdeps currentV1Branch)
let constructorNamesExcludingLibdeps = forwardCtorNames namesExcludingLibdeps
let namesExcludingOldDep = Branch.toNames currentV1BranchWithoutOldDep

Expand Down Expand Up @@ -110,7 +111,6 @@ handleUpgrade oldDepName newDepName = do
--
-- mything#mything2 = #newfoo + 10

let newDepWithoutDeps = over Branch.children (Map.delete Name.libSegment) newDepV1Branch
let filterUnchangedTerms :: Relation Referent Name -> Set TermReference
filterUnchangedTerms oldTerms =
let phi ref oldNames = case Referent.toTermReference ref of
Expand Down Expand Up @@ -170,7 +170,7 @@ handleUpgrade oldDepName newDepName = do
dependents
UnisonFile.emptyUnisonFile
hashLength <- Codebase.hashLength
let primaryPPE = makeOldDepPPE oldDepName newDepName namesExcludingOldDep oldDep
let primaryPPE = makeOldDepPPE oldDepName newDepName namesExcludingOldDep oldDep oldDepWithoutDeps newDepWithoutDeps
let secondaryPPE = PPED.fromNamesDecl hashLength (NamesWithHistory.fromCurrentNames namesExcludingOldDep)
pure (unisonFile, primaryPPE `PPED.addFallback` secondaryPPE)

Expand Down Expand Up @@ -219,115 +219,71 @@ handleUpgrade oldDepName newDepName = do
textualDescriptionOfUpgrade =
Text.unwords ["upgrade", NameSegment.toText oldDepName, NameSegment.toText newDepName]

-- `makeOldDepPPE oldDepName newDepName namesExcludingOldDep oldDepBranch` makes a PPE(D) that only knows how to render
-- `old` direct defns; other names should be provided by some fallback PPE.
--
-- How we render `old` deps is rather subtle and complicated, but the basic idea is that an `upgrade old new` ought to
-- render all of the old things like `lib.old.foo#oldfoo` as `lib.new.foo` to be parsed and typechecked.
--
-- To render some reference #foo, if it's not a reference that's directly part of old's API (i.e. it has some name in
-- `lib.old.*` that isn't in one of old's deps `lib.old.lib.*`, then return the empty list of names. (Again, the
-- fallback PPE will ultimately provide a name for such a #foo).
--
-- Otherwise, we have some #foo that has at least one name in `lib.old.*`; say it's called `lib.old.foo`. The goal is to
-- render this as `lib.new.foo`, regardless of how many other aliases #foo has in the namespace. (It may be the case
-- that #foo has a name outside of the libdeps, like `my.name.for.foo`, or maybe it has a name in another dependency
-- entirely, like `lib.otherdep.othername`).
makeOldDepPPE :: NameSegment -> NameSegment -> Names -> Branch0 m -> PrettyPrintEnvDecl
makeOldDepPPE oldDepName newDepName namesExcludingOldDep oldDepBranch =
makeOldDepPPE ::
NameSegment ->
NameSegment ->
Names ->
Branch0 m ->
Branch0 m ->
Branch0 m ->
PrettyPrintEnvDecl
makeOldDepPPE oldDepName newDepName namesExcludingOldDep oldDep oldDepWithoutDeps newDepWithoutDeps =
let makePPE suffixifyTerms suffixifyTypes =
PrettyPrintEnv
{ termNames = \ref ->
case ( Set.member ref termsDirectlyInOldDep,
Set.member ref oldTerms,
Relation.memberRan ref (terms namesExcludingOldDep)
) of
(True, _, _) ->
-- Say ref is #oldfoo, with two names in `old`:
--
-- [ lib.old.foo, lib.old.fooalias ]
--
-- We start from that same list of names with `new` swapped in for `old`:
--
-- [ lib.new.foo, lib.new.fooalias ]
Names.namesForReferent fakeNames ref
& Set.toList
-- We manually lift those to hashless hash-qualified names, which isn't a very significant
-- implementation detail, we just happen to not want hashes, even if the old name like "lib.old.foo"
-- was conflicted in `old`.
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
-- We find the shortest unique suffix of each name in a naming context which:
--
-- 1. Starts from all names, minus the entire `lib.old` namespace.
--
-- 2. Deletes every name for references directly in `lib.old` (i.e. in `lib.old.*` without having
-- to descend into some `lib.old.lib.*`.
--
-- For example, if there's both
--
-- lib.old.foo#oldfoo
-- someAlias#oldfoo
--
-- then (again, because #oldfoo has a name directly in `lib.old`), we delete names like
-- `someAlias#oldfoo`.
--
-- 3. Adds back in names like `lib.new.*` for every hash directly referenced in `lib.old.*`, which
-- would be
--
-- [ lib.new.foo#oldfoo, lib.new.fooalias#oldfoo ]
& suffixifyTerms
& PPE.Names.prioritize
(False, True, False) ->
Names.namesForReferent (Names.prefix0 (Name.fromReverseSegments (oldDepName :| [Name.libSegment])) $ Branch.toNames oldDepBranch) ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& PPE.Names.prioritize
_ -> [],
let oldDirectNames = Relation.lookupDom ref (Branch.deepTerms oldDepWithoutDeps)
newDirectRefsForOldDirectNames =
Relation.range (Branch.deepTerms newDepWithoutDeps) `Map.restrictKeys` oldDirectNames
in case ( Set.null oldDirectNames,
Map.null newDirectRefsForOldDirectNames,
Set.member ref (Branch.deepReferents oldDep),
Relation.memberRan ref (Names.terms namesExcludingOldDep)
) of
(False, False, _, _) ->
Names.namesForReferent fakeNames ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& suffixifyTerms
& PPE.Names.prioritize
(_, _, True, False) ->
Names.namesForReferent prefixedOldNames ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& PPE.Names.prioritize
_ -> [],
typeNames = \ref ->
case ( Set.member ref typesDirectlyInOldDep,
Set.member ref oldTypes,
Relation.memberRan ref (types namesExcludingOldDep)
) of
(True, _, _) ->
Names.namesForReference fakeNames ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& suffixifyTypes
& PPE.Names.prioritize
(False, True, False) ->
Names.namesForReference (Names.prefix0 (Name.fromReverseSegments (oldDepName :| [Name.libSegment])) $ Branch.toNames oldDepBranch) ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& PPE.Names.prioritize
_ -> []
let oldDirectNames = Relation.lookupDom ref (Branch.deepTypes oldDepWithoutDeps)
newDirectRefsForOldDirectNames =
Relation.range (Branch.deepTypes newDepWithoutDeps) `Map.restrictKeys` oldDirectNames
in case ( Set.null oldDirectNames,
Map.null newDirectRefsForOldDirectNames,
Set.member ref (Branch.deepTypeReferences oldDep),
Relation.memberRan ref (Names.types namesExcludingOldDep)
) of
(False, False, _, _) ->
Names.namesForReference fakeNames ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& suffixifyTypes
& PPE.Names.prioritize
(_, _, True, False) ->
Names.namesForReference prefixedOldNames ref
& Set.toList
& map (\name -> (HQ'.fromName name, HQ'.fromName name))
& PPE.Names.prioritize
_ -> []
}
in PrettyPrintEnvDecl
{ unsuffixifiedPPE = makePPE id id,
suffixifiedPPE =
makePPE
( PPE.Names.shortestUniqueSuffixes $
namesExcludingOldDep
& Names.terms
& Relation.subtractRan termsDirectlyInOldDep
& Relation.union (Names.terms fakeNames)
)
( PPE.Names.shortestUniqueSuffixes $
namesExcludingOldDep
& Names.types
& Relation.subtractRan typesDirectlyInOldDep
& Relation.union (Names.types fakeNames)
)
(PPE.Names.shortestUniqueSuffixes (Names.terms namesExcludingOldDep))
(PPE.Names.shortestUniqueSuffixes (Names.types namesExcludingOldDep))
}
where
oldTypes = Branch.deepTypeReferences oldDepBranch
oldTerms = Branch.deepReferents oldDepBranch
oldDepWithoutItsDeps = over Branch.children (Map.delete Name.libSegment) oldDepBranch
termsDirectlyInOldDep = Branch.deepReferents oldDepWithoutItsDeps
typesDirectlyInOldDep = Branch.deepTypeReferences oldDepWithoutItsDeps
fakeNames =
oldDepWithoutItsDeps
& Branch.toNames
& Names.prefix0 (Name.fromReverseSegments (newDepName :| [Name.libSegment]))
oldNames = Branch.toNames oldDep
prefixedOldNames = Names.prefix0 (Name.fromReverseSegments (oldDepName :| [Name.libSegment])) oldNames
fakeNames = Names.prefix0 (Name.fromReverseSegments (newDepName :| [Name.libSegment])) oldNames

-- @findTemporaryBranchName projectId oldDepName newDepName@ finds some unused branch name in @projectId@ with a name
-- like "upgrade-<oldDepName>-to-<newDepName>".
Expand Down Expand Up @@ -361,3 +317,7 @@ findTemporaryBranchName projectId oldDepName newDepName = do
deleteLibdep :: NameSegment -> Branch0 m -> Branch0 m
deleteLibdep dep =
over (Branch.children . ix Name.libSegment . Branch.head_ . Branch.children) (Map.delete dep)

deleteLibdeps :: Branch0 m -> Branch0 m
deleteLibdeps =
over Branch.children (Map.delete Name.libSegment)