Skip to content

Commit 309517c

Browse files
authored
Merge pull request #4503 from unisonweb/fix/4491
2 parents 37ca00c + a62aece commit 309517c

File tree

6 files changed

+43
-34
lines changed

6 files changed

+43
-34
lines changed

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

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -150,7 +150,7 @@ handleUpdate2 = do
150150
Cli.respond Output.UpdateTypecheckingSuccess
151151
pure secondTuf
152152

153-
saveTuf (findCtorNames namesExcludingLibdeps ctorNames Nothing) secondTuf
153+
saveTuf (findCtorNames Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
154154
Cli.respond Output.Success
155155

156156
-- TODO: find a better module for this function, as it's used in a couple places
@@ -284,22 +284,23 @@ buildBigUnisonFile ::
284284
Map ForwardName (Referent, Name) ->
285285
Transaction (UnisonFile Symbol Ann)
286286
buildBigUnisonFile abort c tuf dependents names ctorNames =
287-
addDefinitionsToUnisonFile abort c names ctorNames dependents (UF.discardTypes tuf)
287+
addDefinitionsToUnisonFile Output.UOUUpdate abort c names ctorNames dependents (UF.discardTypes tuf)
288288

289289
-- | @addDefinitionsToUnisonFile abort codebase names ctorNames definitions file@ adds all @definitions@ to @file@, avoiding
290290
-- overwriting anything already in @file@. Every definition is put into the file with every naming it has in @names@ "on
291291
-- the left-hand-side of the equals" (but yes type decls don't really have a LHS).
292292
--
293293
-- TODO: find a better module for this function, as it's used in a couple places
294294
addDefinitionsToUnisonFile ::
295+
Output.UpdateOrUpgrade ->
295296
(forall void. Output -> Transaction void) ->
296297
Codebase IO Symbol Ann ->
297298
Names ->
298299
Map ForwardName (Referent, Name) ->
299300
Map Reference.Id ReferenceType ->
300301
UnisonFile Symbol Ann ->
301302
Transaction (UnisonFile Symbol Ann)
302-
addDefinitionsToUnisonFile abort c names ctorNames dependents initialUnisonFile =
303+
addDefinitionsToUnisonFile operation abort c names ctorNames dependents initialUnisonFile =
303304
-- for each dependent, add its definition with all its names to the UnisonFile
304305
foldM addComponent initialUnisonFile (Map.toList dependents')
305306
where
@@ -358,7 +359,7 @@ addDefinitionsToUnisonFile abort c names ctorNames dependents initialUnisonFile
358359
overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann)
359360
overwriteConstructorNames name dd =
360361
let constructorNames :: Transaction [Symbol]
361-
constructorNames = case findCtorNames names ctorNames (Just $ Decl.constructorCount dd) name of
362+
constructorNames = case findCtorNames operation names ctorNames (Just $ Decl.constructorCount dd) name of
362363
Left err -> abort err
363364
Right array ->
364365
case traverse (fmap Name.toVar . Name.stripNamePrefix name) array of
@@ -387,8 +388,8 @@ forwardCtorNames names =
387388
]
388389

389390
-- | given a decl name, find names for all of its constructors, in order.
390-
findCtorNames :: Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
391-
findCtorNames names forwardCtorNames ctorCount n =
391+
findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
392+
findCtorNames operation names forwardCtorNames ctorCount n =
392393
let declRef = Set.findMin $ Relation.lookupDom n names.types
393394
f = ForwardName.fromName n
394395
(_, centerRight) = Map.split f forwardCtorNames
@@ -407,7 +408,7 @@ findCtorNames names forwardCtorNames ctorCount n =
407408
ctorCountGuess = fromMaybe (Map.size m) ctorCount
408409
in if Map.size m == ctorCountGuess && all (isJust . flip Map.lookup m . fromIntegral) [0 .. ctorCountGuess - 1]
409410
then Right $ Map.elems m
410-
else Left $ Output.UpdateIncompleteConstructorSet n m ctorCount
411+
else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount
411412

412413
-- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly.
413414
-- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux"

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

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -163,6 +163,7 @@ handleUpgrade oldDepName newDepName = do
163163
<> filterTransitiveTypes (Branch.deepTypes oldTransitiveDeps)
164164
)
165165
addDefinitionsToUnisonFile
166+
Output.UOUUpgrade
166167
abort
167168
codebase
168169
namesExcludingLibdeps
@@ -206,7 +207,7 @@ handleUpgrade oldDepName newDepName = do
206207
Codebase.addDefsToCodebase codebase typecheckedUnisonFile
207208
typecheckedUnisonFileToBranchUpdates
208209
abort
209-
(findCtorNames namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
210+
(findCtorNames Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
210211
typecheckedUnisonFile
211212
Cli.stepAt
212213
textualDescriptionOfUpgrade

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

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ module Unison.Codebase.Editor.Output
1111
TestReportStats (..),
1212
UndoFailureReason (..),
1313
ShareError (..),
14+
UpdateOrUpgrade (..),
1415
isFailure,
1516
isNumberedFailure,
1617
)
@@ -391,10 +392,12 @@ data Output
391392
| UpdateStartTypechecking
392393
| UpdateTypecheckingFailure
393394
| UpdateTypecheckingSuccess
394-
| UpdateIncompleteConstructorSet Name (Map ConstructorId Name) (Maybe Int)
395+
| UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int)
395396
| UpgradeFailure !NameSegment !NameSegment
396397
| UpgradeSuccess !NameSegment !NameSegment
397398

399+
data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
400+
398401
-- | What did we create a project branch from?
399402
--
400403
-- * Loose code

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

Lines changed: 21 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -2191,25 +2191,27 @@ notifyUser dir = \case
21912191
<> "Once the file is compiling, try"
21922192
<> makeExample' IP.update
21932193
<> "again."
2194-
UpdateIncompleteConstructorSet name ctorMap expectedCount ->
2195-
pure $
2196-
P.lines
2197-
[ P.wrap $
2198-
"I couldn't complete the update because I couldn't find"
2199-
<> fromString (maybe "" show expectedCount)
2200-
<> "constructor(s) for"
2201-
<> prettyName name
2202-
<> "where I expected to."
2203-
<> "I found:"
2204-
<> fromString (show (Map.toList ctorMap)),
2205-
"",
2206-
P.wrap $
2207-
"You can use"
2208-
<> P.indentNAfterNewline 2 (IP.makeExample IP.view [prettyName name])
2209-
<> "and"
2210-
<> P.indentNAfterNewline 2 (IP.makeExample IP.aliasTerm ["<hash>", prettyName name <> ".<ConstructorName>"])
2211-
<> "to give names to each constructor, and then try again."
2212-
]
2194+
UpdateIncompleteConstructorSet operation typeName _ctorMap _expectedCount ->
2195+
let operationName = case operation of E.UOUUpdate -> "update"; E.UOUUpgrade -> "upgrade"
2196+
in pure $
2197+
P.lines
2198+
[ P.wrap $
2199+
"I couldn't complete the"
2200+
<> operationName
2201+
<> "because the type"
2202+
<> prettyName typeName
2203+
<> "has unnamed constructors."
2204+
<> "(I currently need each constructor to have a name somewhere under the type name.)",
2205+
"",
2206+
P.wrap $
2207+
"You can use"
2208+
<> P.indentNAfterNewline 2 (IP.makeExample IP.view [prettyName typeName])
2209+
<> "and"
2210+
<> P.indentNAfterNewline 2 (IP.makeExample IP.aliasTerm ["<hash>", prettyName typeName <> ".<ConstructorName>"])
2211+
<> "to give names to each constructor, and then try the"
2212+
<> operationName
2213+
<> "again."
2214+
]
22132215
UpgradeFailure old new ->
22142216
pure . P.wrap $
22152217
"I couldn't automatically upgrade"

unison-src/transcripts/update-type-missing-constructor.output.md

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -53,11 +53,12 @@ unique type Foo = Bar Nat Nat
5353
Okay, I'm searching the branch for code that needs to be
5454
updated...
5555
56-
I couldn't complete the update because I couldn't find 1
57-
constructor(s) for Foo where I expected to. I found: []
56+
I couldn't complete the update because the type Foo has
57+
unnamed constructors. (I currently need each constructor to
58+
have a name somewhere under the type name.)
5859
5960
You can use `view Foo` and
6061
`alias.term <hash> Foo.<ConstructorName>` to give names to
61-
each constructor, and then try again.
62+
each constructor, and then try the update again.
6263
6364
```

unison-src/transcripts/update-type-stray-constructor.output.md

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -55,11 +55,12 @@ Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`)
5555
Okay, I'm searching the branch for code that needs to be
5656
updated...
5757
58-
I couldn't complete the update because I couldn't find 1
59-
constructor(s) for Foo where I expected to. I found: []
58+
I couldn't complete the update because the type Foo has
59+
unnamed constructors. (I currently need each constructor to
60+
have a name somewhere under the type name.)
6061
6162
You can use `view Foo` and
6263
`alias.term <hash> Foo.<ConstructorName>` to give names to
63-
each constructor, and then try again.
64+
each constructor, and then try the update again.
6465
6566
```

0 commit comments

Comments
 (0)