Skip to content

Commit 6e59c0a

Browse files
aryairaniaryairani
authored
Merge pull request #5989 from unisonweb/25-11-05-difftool
2 parents de74c75 + d3cb1e2 commit 6e59c0a

File tree

12 files changed

+458
-98
lines changed

12 files changed

+458
-98
lines changed

‎unison-cli/src/Unison/Codebase/Editor/HandleInput/DiffBranch.hs‎

Lines changed: 131 additions & 65 deletions
Original file line numberDiff line numberDiff line change
@@ -40,9 +40,11 @@ import Unison.DeclCoherencyCheck (asOneRandomIncoherentDeclReason)
4040
import Unison.DeclNameLookup (DeclNameLookup)
4141
import Unison.Merge qualified as Merge
4242
import Unison.Merge.DiffOp qualified as Merge.DiffOp
43+
import Unison.Merge.Diffblob qualified as Merge
4344
import Unison.Merge.ThreeWay qualified as Merge.ThreeWay
44-
import Unison.Merge.TwoOrThreeWay qualified as TwoOrThreeWay
45+
import Unison.Merge.TwoOrThreeWay qualified as Merge.TwoOrThreeWay
4546
import Unison.Merge.TwoWay qualified as Merge.TwoWay
47+
import Unison.Merge.Updated qualified as Merge.Updated
4648
import Unison.Name (Name)
4749
import Unison.NameSegment (NameSegment)
4850
import Unison.NamesUtils qualified as NamesUtils
@@ -76,25 +78,47 @@ import Unison.Var (Var)
7678

7779
handleDiffBranch :: DiffBranchArg -> DiffBranchArg -> Cli ()
7880
handleDiffBranch aliceArg bobArg = do
79-
let args = Merge.TwoWay {alice = aliceArg, bob = bobArg}
81+
let originalArgs = Merge.TwoWay {alice = aliceArg, bob = bobArg}
8082

8183
env <- ask
8284

8385
currentProject <- Cli.getCurrentProject
8486

85-
(namespaces, diffblob) <-
87+
(namespaces, diffblob, swapped) <-
8688
Cli.runTransactionWithRollback \abort -> do
87-
aliceAndBobCausalHashes <- traverse (resolveDiffBranchArg abort currentProject) args
88-
lcaCausalHash <- Operations.lca aliceAndBobCausalHashes.alice aliceAndBobCausalHashes.bob
89-
let causalHashes0 =
90-
Merge.TwoOrThreeWay
91-
{ alice = aliceAndBobCausalHashes.alice,
92-
bob = aliceAndBobCausalHashes.bob,
93-
lca = lcaCausalHash
94-
}
95-
96-
let causalHashes =
97-
TwoOrThreeWay.toThreeWay causalHashes0.alice causalHashes0
89+
causalHashes2 <-
90+
traverse (resolveDiffBranchArg abort currentProject) originalArgs
91+
92+
-- If the causal hashes are the same, there's certainly no diff to show
93+
when (Merge.TwoWay.twoWay (==) causalHashes2) do
94+
abort Output.ShowEmptyBranchDiff
95+
96+
maybeLcaCausalHash <-
97+
Operations.lca causalHashes2.alice causalHashes2.bob
98+
99+
-- From now on, all throughout the algorithm, a missing LCA means one of two things, which we treat uniformly:
100+
--
101+
-- 1. The LCA is Alice, i.e. this is is a fast-forward to Bob
102+
-- 2. The LCA is actually missing, i.e. the branches don't share a history
103+
--
104+
-- In both cases, we treat Alice as the effective LCA for the purpose of the diff. (In the no-history case, this
105+
-- allows users to see the diff between e.g. two squashed releases, in a readable/intuitive way, so long as they
106+
-- put the older release first on the command line.
107+
--
108+
-- You might wonder: what if the LCA is actually Bob, and Alice is ahead? We track that with a separate boolean,
109+
-- "swapped". If swapped, we're treating Alice as Bob and vice-versa, so just before displaying the diff, we swap
110+
-- them back. So, this case is also (1).
111+
let causalHashes :: Merge.TwoOrThreeWay CausalHash
112+
swapped :: Bool
113+
(causalHashes, swapped) =
114+
case maybeLcaCausalHash of
115+
Nothing -> (Merge.TwoWay.toTwoOrThreeWay Nothing causalHashes2, False)
116+
Just lcaCausalHash
117+
| lcaCausalHash == causalHashes2.alice ->
118+
(Merge.TwoWay.toTwoOrThreeWay Nothing causalHashes2, False)
119+
| lcaCausalHash == causalHashes2.bob ->
120+
(Merge.TwoWay.toTwoOrThreeWay Nothing (Merge.TwoWay.swap causalHashes2), True)
121+
| otherwise -> (Merge.TwoWay.toTwoOrThreeWay maybeLcaCausalHash causalHashes2, False)
98122

99123
namespaces <-
100124
for causalHashes (Codebase.expectBranchForHashTx env.codebase)
@@ -107,47 +131,74 @@ handleDiffBranch aliceArg bobArg = do
107131
Branch.asUnconflicted namespace
108132
& onLeft (abort . Output.ConflictedDefn)
109133

110-
declNameLookups <- do
111-
aliceAndBob <-
112-
sequence $
113-
( \x y z ->
114-
Codebase.getBranchDeclNameLookup env.codebase (Branch.namespaceHash x) y
115-
& onLeftM
116-
( abort
117-
. Output.IncoherentDeclDuringDiffBranch z
118-
. asOneRandomIncoherentDeclReason
119-
)
120-
)
121-
<$> Merge.ThreeWay.forgetLca namespaces
122-
<*> Merge.ThreeWay.forgetLca defns
123-
<*> args
124-
lca <- Codebase.getBranchPartialDeclNameLookup env.codebase (Branch.namespaceHash namespaces.lca) defns.lca
125-
pure (Merge.ThreeWay.gfromTwoWay lca aliceAndBob)
134+
declNameLookups2 :: Merge.TwoWay DeclNameLookup <-
135+
sequence $
136+
( \x y z ->
137+
Codebase.getBranchDeclNameLookup env.codebase (Branch.namespaceHash x) y
138+
& onLeftM
139+
( abort
140+
. Output.IncoherentDeclDuringDiffBranch z
141+
. asOneRandomIncoherentDeclReason
142+
)
143+
)
144+
<$> Merge.TwoOrThreeWay.forgetLca namespaces
145+
<*> Merge.TwoOrThreeWay.forgetLca defns
146+
<*> (if swapped then Merge.TwoWay.swap originalArgs else originalArgs)
126147

127148
diffblob <-
128-
Merge.makeDiffblob
129-
Merge.emptyDiffblobLog
130-
(UpdateUtils.hydrateRefs env.codebase . fold)
131-
(\_ -> pure (Branch.toNames <$> namespaces0))
132-
defns
133-
(view Branch.libdeps_ <$> namespaces0)
134-
declNameLookups
135-
136-
pure (namespaces0, diffblob)
149+
-- These are all Just or all Nothing
150+
case (namespaces.lca, defns.lca) of
151+
(Just lcaNamespace, Just lcaDefns) -> do
152+
let namespaces0' = Merge.TwoOrThreeWay.toThreeWay (Branch.head lcaNamespace) namespaces0
153+
lcaDeclNameLookup <-
154+
Codebase.getBranchPartialDeclNameLookup env.codebase (Branch.namespaceHash lcaNamespace) lcaDefns
155+
Merge.makeDiffblob
156+
Merge.emptyDiffblobLog
157+
(UpdateUtils.hydrateRefs env.codebase . fold)
158+
(\_ -> pure (Branch.toNames <$> namespaces0'))
159+
(Merge.TwoOrThreeWay.toThreeWay lcaDefns defns)
160+
(view Branch.libdeps_ <$> namespaces0')
161+
(Merge.TwoWay.gtoThreeWay lcaDeclNameLookup declNameLookups2)
162+
_ ->
163+
let f :: Merge.TwoOrThreeWay a -> Merge.Updated a
164+
f x =
165+
Merge.Updated x.alice x.bob
166+
in Merge.makeFastForwardDiffblob
167+
(UpdateUtils.hydrateRefs env.codebase . Merge.Updated.fold)
168+
(\_ -> pure (Merge.Updated.map Branch.toNames (f namespaces0)))
169+
(f defns)
170+
(Merge.Updated.map (view Branch.libdeps_) (f namespaces0))
171+
(Merge.TwoWay.twoWay Merge.Updated declNameLookups2)
172+
173+
pure (namespaces0, diffblob, swapped)
174+
175+
let maybeSwap :: Merge.TwoWay a -> Merge.TwoWay a
176+
maybeSwap
177+
| swapped = Merge.TwoWay.swap
178+
| otherwise = id
137179

138180
-- Identify the set of all names changed (added, deleted, updated) on both branches.
139181
let changedNames :: DefnsF Set Name Name
140182
changedNames =
141183
foldMap (bimap Map.keysSet Map.keysSet) diffblob.diffsFromLCA
142184

143185
-- Restrict all definitions to just those changed names (regardless of which branch changed it)
144-
let changedDefns :: Merge.ThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
186+
let changedDefns :: Merge.TwoOrThreeWay (Defns (BiMultimap Referent Name) (BiMultimap TypeReference Name))
145187
changedDefns =
146-
diffblob.defns <&> \defns ->
147-
NamesUtils.restrictNames changedNames defns.defns
188+
( if isJust namespaces.lca
189+
then
190+
diffblob.defns
191+
& Merge.ThreeWay.toTwoOrThreeWay
192+
else
193+
diffblob.defns
194+
& Merge.ThreeWay.forgetLca
195+
& Merge.TwoWay.toTwoOrThreeWay Nothing
196+
)
197+
<&> \defns ->
198+
NamesUtils.restrictNames changedNames defns.defns
148199

149200
-- Extract out just the builtins, to be rendered specially in the file later
150-
let changedBuiltinDefns :: Merge.ThreeWay (DefnsF (Map Name) Text Text)
201+
let changedBuiltinDefns :: Merge.TwoOrThreeWay (DefnsF (Map Name) Text Text)
151202
changedBuiltinDefns =
152203
changedDefns
153204
<&> bimap
@@ -219,6 +270,7 @@ handleDiffBranch aliceArg bobArg = do
219270
lcaLibdepsDiff :: Map NameSegment CausalHash
220271
lcaLibdepsDiff =
221272
namespaces.lca
273+
& fromMaybe namespaces.alice -- a missing LCA means we're treating Alice as LCA
222274
& view Branch.libdeps_
223275
& (`Map.restrictKeys` deletedAndUpdatedLibdepsNames)
224276
& Map.map Branch.headHash
@@ -247,7 +299,7 @@ handleDiffBranch aliceArg bobArg = do
247299
}
248300
where
249301
slugs =
250-
mangleDiffBranchArg <$> args
302+
mangleDiffBranchArg <$> maybeSwap originalArgs
251303

252304
let difftool =
253305
difftool0
@@ -259,23 +311,37 @@ handleDiffBranch aliceArg bobArg = do
259311

260312
exitCode <-
261313
liftIO do
262-
for_
263-
( (,,,,,)
264-
<$> filenames
265-
<*> ( diffblob.declNameLookups
266-
& over #lca (PartialDeclNameLookup.toDeclNameLookup Name.unsafeParseText)
267-
& Merge.ThreeWay.gtoThreeWay
268-
)
269-
<*> namespaces
270-
<*> diffblob.defns
271-
<*> changedBuiltinDefns
272-
<*> libdepsDiffs
273-
)
274-
\(name, declNameLookup, namespace, defns, builtinDefns, libdeps) ->
275-
env.writeSource
276-
name
277-
(renderUnisonFile declNameLookup namespace libdeps defns builtinDefns hydratedDefns)
278-
True
314+
let renderedUnisonFiles :: Merge.ThreeWay Text
315+
renderedUnisonFiles =
316+
Merge.TwoWay.toThreeWay
317+
( -- These either both have a Nothing lca or both have a Just lca
318+
case (namespaces.lca, changedBuiltinDefns.lca) of
319+
(Just lca, Just builtins) ->
320+
renderUnisonFile
321+
-- FIXME whoops, we can't always `unsafeParseText` out of a missing name in the LCA here...
322+
-- need a rendering function that knows how to print decls with missing names, I guess
323+
(PartialDeclNameLookup.toDeclNameLookup Name.unsafeParseText diffblob.declNameLookups.lca)
324+
lca
325+
libdepsDiffs.lca
326+
diffblob.defns.lca
327+
builtins
328+
hydratedDefns
329+
_ -> aliceAndBobFiles.alice
330+
)
331+
aliceAndBobFiles
332+
where
333+
aliceAndBobFiles :: Merge.TwoWay Text
334+
aliceAndBobFiles =
335+
renderUnisonFile
336+
<$> Merge.ThreeWay.gforgetLca diffblob.declNameLookups
337+
<*> Merge.TwoOrThreeWay.forgetLca namespaces
338+
<*> Merge.ThreeWay.forgetLca libdepsDiffs
339+
<*> Merge.ThreeWay.forgetLca diffblob.defns
340+
<*> Merge.TwoOrThreeWay.forgetLca changedBuiltinDefns
341+
<*> pure hydratedDefns
342+
343+
for_ ((,) <$> filenames <*> renderedUnisonFiles) \(name, contents) ->
344+
env.writeSource name contents True
279345
let createProcess = (Process.shell (Text.unpack difftool)) {Process.delegate_ctlc = True}
280346
Process.withCreateProcess createProcess \_ _ _ -> Process.waitForProcess
281347

@@ -360,10 +426,10 @@ handleDiffBranch aliceArg bobArg = do
360426

361427
Cli.respond $
362428
Output.ShowBranchDiff
363-
args
364-
((.suffixifiedPPE) . Branch.toPrettyPrintEnvDecl 10 <$> Merge.ThreeWay.forgetLca namespaces)
365-
(Map.map (Merge.DiffOp.map Branch.headHash) <$> diffblob.libdepsDiffs)
366-
diffs
429+
originalArgs
430+
((.suffixifiedPPE) . Branch.toPrettyPrintEnvDecl 10 <$> maybeSwap (Merge.TwoOrThreeWay.forgetLca namespaces))
431+
(Map.map (Merge.DiffOp.map Branch.headHash) <$> maybeSwap diffblob.libdepsDiffs)
432+
(maybeSwap diffs)
367433
maybeDifftoolResult
368434

369435
resolveDiffBranchArg ::

‎unison-cli/src/Unison/Codebase/Editor/Output.hs‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -456,6 +456,7 @@ data Output
456456
| SyncingFromTo CausalHash CausalHash
457457
| CantDeleteConstructor !(NESet Name)
458458
| CantDoThatDuring !Text {- "an upgrade" / "a merge" -} !Text {- "upgrade" / "merge" -}
459+
| ShowEmptyBranchDiff
459460
| ShowBranchDiff
460461
!(Merge.TwoWay DiffBranchArg)
461462
!(Merge.TwoWay PPE.PrettyPrintEnv)
@@ -721,6 +722,7 @@ isFailure o = case o of
721722
SyncingFromTo {} -> False
722723
CantDeleteConstructor {} -> True
723724
CantDoThatDuring {} -> True
725+
ShowEmptyBranchDiff {} -> False
724726
ShowBranchDiff {} -> False
725727
StaleRun {} -> True
726728
InvalidCommentTarget {} -> True

‎unison-cli/src/Unison/CommandLine/OutputMessages.hs‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2393,6 +2393,7 @@ notifyUser dir issueFn = \case
23932393
<> "Please complete the"
23942394
<> (P.group (P.text verb) <> ",")
23952395
<> "then try again."
2396+
ShowEmptyBranchDiff -> pure prettyEmptyBranchDiff
23962397
ShowBranchDiff branchArgs ppes libdepsDiffs diffs _maybeDifftoolResult -> do
23972398
let isEmpty
23982399
libdepsDiff
@@ -2529,7 +2530,7 @@ notifyUser dir issueFn = \case
25292530

25302531
pure $
25312532
if isEmpty libdepsDiffs.alice diffs.alice && isEmpty libdepsDiffs.bob diffs.bob
2532-
then "Those branches are the same."
2533+
then prettyEmptyBranchDiff
25332534
else
25342535
P.sepNonEmpty
25352536
"\n\n"
@@ -4255,3 +4256,7 @@ strayConstructorError verb theConstructor name =
42554256
<> verb
42564257
<> "again."
42574258
]
4259+
4260+
prettyEmptyBranchDiff :: Pretty
4261+
prettyEmptyBranchDiff =
4262+
"Those branches are the same."

‎unison-core/src/Unison/PartialDeclNameLookup.hs‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@ module Unison.PartialDeclNameLookup
44
expectDeclName,
55
expectConstructorNames,
66
toDeclNameLookup,
7+
fromDeclNameLookup,
78
)
89
where
910

@@ -81,3 +82,10 @@ toDeclNameLookup unsafeParseText partialDeclNameLookup =
8182
name :: Name
8283
name =
8384
unsafeParseText (name0 <> if i == 0 then Text.empty else Text.pack (show i))
85+
86+
fromDeclNameLookup :: DeclNameLookup -> PartialDeclNameLookup
87+
fromDeclNameLookup declNameLookup =
88+
PartialDeclNameLookup
89+
{ constructorToDecl = declNameLookup.constructorToDecl,
90+
declToConstructors = Map.map (map Just) declNameLookup.declToConstructors
91+
}

‎unison-merge/src/Unison/Merge/Diff.hs‎

Lines changed: 12 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,12 @@
11
module Unison.Merge.Diff
22
( diffSynhashedDefns,
3+
diffSynhashedDefns1,
34
)
45
where
56

67
import Data.Map.Merge.Strict qualified as Map
78
import Data.Map.Strict qualified as Map
89
import Data.Zip qualified as Zip
9-
import U.Codebase.Reference (TypeReference)
1010
import Unison.Merge.DiffOp (DiffOp (..), DiffOp2 (..))
1111
import Unison.Merge.Synhashed (Synhashed (..))
1212
import Unison.Merge.Synhashed qualified as Synhashed
@@ -15,31 +15,32 @@ import Unison.Merge.Updated (GUpdated (..), Updated)
1515
import Unison.Merge.Updated qualified as Updated
1616
import Unison.Name (Name)
1717
import Unison.Prelude hiding (catMaybes)
18-
import Unison.Referent (Referent)
1918
import Unison.Util.Defns (DefnsF, DefnsF2, DefnsF3, unzipDefns, zipDefnsWith)
2019

2120
-- | @diffSynhashedDefns defns@, given the output of @synhashDefns@, computes the two two-way diffs (each consisting of
2221
-- the "core" diffs, i.e. adds/delete/updates, alongside the propagated updates, i.e. updates that have the same synhash
2322
-- but different Unison hashes).
2423
diffSynhashedDefns ::
25-
TwoWay (Updated (DefnsF2 (Map Name) Synhashed Referent TypeReference)) ->
24+
(Eq term, Eq typ) =>
25+
TwoWay (Updated (DefnsF2 (Map Name) Synhashed term typ)) ->
2626
( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
27-
TwoWay (DefnsF3 (Map Name) DiffOp Synhashed Referent TypeReference),
27+
TwoWay (DefnsF3 (Map Name) DiffOp Synhashed term typ),
2828
-- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
29-
TwoWay (DefnsF (Map Name) (Updated Referent) (Updated TypeReference))
29+
TwoWay (DefnsF (Map Name) (Updated term) (Updated typ))
3030
)
3131
diffSynhashedDefns =
32-
Zip.unzip . fmap diffSynhashedDefns0
32+
Zip.unzip . fmap diffSynhashedDefns1
3333

34-
diffSynhashedDefns0 ::
34+
-- | Like 'diffSynhashedDefns', but for just one LCA->Head side.
35+
diffSynhashedDefns1 ::
3536
(Eq term, Eq typ) =>
3637
Updated (DefnsF2 (Map Name) Synhashed term typ) ->
3738
( -- Core diffs, i.e. adds, deletes, and updates which have different synhashes.
3839
DefnsF3 (Map Name) DiffOp Synhashed term typ,
3940
-- Propagated updates, i.e. updates which have the same synhash but different Unison hashes.
4041
DefnsF (Map Name) (Updated term) (Updated typ)
4142
)
42-
diffSynhashedDefns0 defns =
43+
diffSynhashedDefns1 defns =
4344
unzipDefns (zipDefnsWith f f defns.old defns.new)
4445
where
4546
f ::
@@ -48,17 +49,17 @@ diffSynhashedDefns0 defns =
4849
Map Name (Synhashed ref) ->
4950
(Map Name (DiffOp (Synhashed ref)), Map Name (Updated ref))
5051
f old new =
51-
partitionPropagated (diffSynhashedDefns1 old new)
52+
partitionPropagated (diffSynhashedDefns2 old new)
5253

5354
-- Compute the diff by comparing old-and-new values, resulting in either an add, delete, update (propagated or not),
5455
-- or dropping the thing entirely (because old and new have the same hash).
55-
diffSynhashedDefns1 ::
56+
diffSynhashedDefns2 ::
5657
forall ref.
5758
(Eq ref) =>
5859
Map Name (Synhashed ref) ->
5960
Map Name (Synhashed ref) ->
6061
Map Name (DiffOp2 (Synhashed ref))
61-
diffSynhashedDefns1 =
62+
diffSynhashedDefns2 =
6263
Map.merge
6364
(Map.mapMissing \_ -> DiffOp2'Delete)
6465
(Map.mapMissing \_ -> DiffOp2'Add)

0 commit comments

Comments
 (0)