Merge pull request #4503 from unisonweb/fix/4491

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

@@ -150,7 +150,7 @@ handleUpdate2 = do
         Cli.respond Output.UpdateTypecheckingSuccess
         pure secondTuf
 
-  saveTuf (findCtorNames namesExcludingLibdeps ctorNames Nothing) secondTuf
+  saveTuf (findCtorNames Output.UOUUpdate namesExcludingLibdeps ctorNames Nothing) secondTuf
   Cli.respond Output.Success
 
 -- TODO: find a better module for this function, as it's used in a couple places
@@ -284,22 +284,23 @@ buildBigUnisonFile ::
   Map ForwardName (Referent, Name) ->
   Transaction (UnisonFile Symbol Ann)
 buildBigUnisonFile abort c tuf dependents names ctorNames =
-  addDefinitionsToUnisonFile abort c names ctorNames dependents (UF.discardTypes tuf)
+  addDefinitionsToUnisonFile Output.UOUUpdate abort c names ctorNames dependents (UF.discardTypes tuf)
 
 -- | @addDefinitionsToUnisonFile abort codebase names ctorNames definitions file@ adds all @definitions@ to @file@, avoiding
 -- overwriting anything already in @file@. Every definition is put into the file with every naming it has in @names@ "on
 -- the left-hand-side of the equals" (but yes type decls don't really have a LHS).
 --
 -- TODO: find a better module for this function, as it's used in a couple places
 addDefinitionsToUnisonFile ::
+  Output.UpdateOrUpgrade ->
   (forall void. Output -> Transaction void) ->
   Codebase IO Symbol Ann ->
   Names ->
   Map ForwardName (Referent, Name) ->
   Map Reference.Id ReferenceType ->
   UnisonFile Symbol Ann ->
   Transaction (UnisonFile Symbol Ann)
-addDefinitionsToUnisonFile abort c names ctorNames dependents initialUnisonFile =
+addDefinitionsToUnisonFile operation abort c names ctorNames dependents initialUnisonFile =
   -- for each dependent, add its definition with all its names to the UnisonFile
   foldM addComponent initialUnisonFile (Map.toList dependents')
   where
@@ -358,7 +359,7 @@ addDefinitionsToUnisonFile abort c names ctorNames dependents initialUnisonFile
         overwriteConstructorNames :: Name -> DataDeclaration Symbol Ann -> Transaction (DataDeclaration Symbol Ann)
         overwriteConstructorNames name dd =
           let constructorNames :: Transaction [Symbol]
-              constructorNames = case findCtorNames names ctorNames (Just $ Decl.constructorCount dd) name of
+              constructorNames = case findCtorNames operation names ctorNames (Just $ Decl.constructorCount dd) name of
                 Left err -> abort err
                 Right array ->
                   case traverse (fmap Name.toVar . Name.stripNamePrefix name) array of
@@ -387,8 +388,8 @@ forwardCtorNames names =
     ]
 
 -- | given a decl name, find names for all of its constructors, in order.
-findCtorNames :: Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
-findCtorNames names forwardCtorNames ctorCount n =
+findCtorNames :: Output.UpdateOrUpgrade -> Names -> Map ForwardName (Referent, Name) -> Maybe Int -> Name -> Either Output.Output [Name]
+findCtorNames operation names forwardCtorNames ctorCount n =
   let declRef = Set.findMin $ Relation.lookupDom n names.types
       f = ForwardName.fromName n
       (_, centerRight) = Map.split f forwardCtorNames
@@ -407,7 +408,7 @@ findCtorNames names forwardCtorNames ctorCount n =
       ctorCountGuess = fromMaybe (Map.size m) ctorCount
    in if Map.size m == ctorCountGuess && all (isJust . flip Map.lookup m . fromIntegral) [0 .. ctorCountGuess - 1]
         then Right $ Map.elems m
-        else Left $ Output.UpdateIncompleteConstructorSet n m ctorCount
+        else Left $ Output.UpdateIncompleteConstructorSet operation n m ctorCount
 
 -- Used by `findCtorNames` to filter `forwardCtorNames` to a narrow range which will be searched linearly.
 -- >>> incrementLastSegmentChar $ ForwardName.fromName $ Name.unsafeFromText "foo.bar.quux"

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

@@ -163,6 +163,7 @@ handleUpgrade oldDepName newDepName = do
                 <> filterTransitiveTypes (Branch.deepTypes oldTransitiveDeps)
             )
         addDefinitionsToUnisonFile
+          Output.UOUUpgrade
           abort
           codebase
           namesExcludingLibdeps
@@ -206,7 +207,7 @@ handleUpgrade oldDepName newDepName = do
       Codebase.addDefsToCodebase codebase typecheckedUnisonFile
       typecheckedUnisonFileToBranchUpdates
         abort
-        (findCtorNames namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
+        (findCtorNames Output.UOUUpgrade namesExcludingLibdeps constructorNamesExcludingLibdeps Nothing)
         typecheckedUnisonFile
   Cli.stepAt
     textualDescriptionOfUpgrade

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

@@ -11,6 +11,7 @@ module Unison.Codebase.Editor.Output
     TestReportStats (..),
     UndoFailureReason (..),
     ShareError (..),
+    UpdateOrUpgrade (..),
     isFailure,
     isNumberedFailure,
   )
@@ -391,10 +392,12 @@ data Output
   | UpdateStartTypechecking
   | UpdateTypecheckingFailure
   | UpdateTypecheckingSuccess
-  | UpdateIncompleteConstructorSet Name (Map ConstructorId Name) (Maybe Int)
+  | UpdateIncompleteConstructorSet UpdateOrUpgrade Name (Map ConstructorId Name) (Maybe Int)
   | UpgradeFailure !NameSegment !NameSegment
   | UpgradeSuccess !NameSegment !NameSegment
 
+data UpdateOrUpgrade = UOUUpdate | UOUUpgrade
+
 -- | What did we create a project branch from?
 --
 --   * Loose code

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

@@ -2191,25 +2191,27 @@ notifyUser dir = \case
         <> "Once the file is compiling, try"
         <> makeExample' IP.update
         <> "again."
-  UpdateIncompleteConstructorSet name ctorMap expectedCount ->
-    pure $
-      P.lines
-        [ P.wrap $
-            "I couldn't complete the update because I couldn't find"
-              <> fromString (maybe "" show expectedCount)
-              <> "constructor(s) for"
-              <> prettyName name
-              <> "where I expected to."
-              <> "I found:"
-              <> fromString (show (Map.toList ctorMap)),
-          "",
-          P.wrap $
-            "You can use"
-              <> P.indentNAfterNewline 2 (IP.makeExample IP.view [prettyName name])
-              <> "and"
-              <> P.indentNAfterNewline 2 (IP.makeExample IP.aliasTerm ["<hash>", prettyName name <> ".<ConstructorName>"])
-              <> "to give names to each constructor, and then try again."
-        ]
+  UpdateIncompleteConstructorSet operation typeName _ctorMap _expectedCount ->
+    let operationName = case operation of E.UOUUpdate -> "update"; E.UOUUpgrade -> "upgrade"
+     in pure $
+          P.lines
+            [ P.wrap $
+                "I couldn't complete the"
+                  <> operationName
+                  <> "because the type"
+                  <> prettyName typeName
+                  <> "has unnamed constructors."
+                  <> "(I currently need each constructor to have a name somewhere under the type name.)",
+              "",
+              P.wrap $
+                "You can use"
+                  <> P.indentNAfterNewline 2 (IP.makeExample IP.view [prettyName typeName])
+                  <> "and"
+                  <> P.indentNAfterNewline 2 (IP.makeExample IP.aliasTerm ["<hash>", prettyName typeName <> ".<ConstructorName>"])
+                  <> "to give names to each constructor, and then try the"
+                  <> operationName
+                  <> "again."
+            ]
   UpgradeFailure old new ->
     pure . P.wrap $
       "I couldn't automatically upgrade"

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

@@ -53,11 +53,12 @@ unique type Foo = Bar Nat Nat
   Okay, I'm searching the branch for code that needs to be
   updated...
 
-  I couldn't complete the update because I couldn't find 1
-  constructor(s) for Foo where I expected to. I found: []
+  I couldn't complete the update because the type Foo has
+  unnamed constructors. (I currently need each constructor to
+  have a name somewhere under the type name.)
   
   You can use `view Foo` and
   `alias.term <hash> Foo.<ConstructorName>` to give names to
-  each constructor, and then try again.
+  each constructor, and then try the update again.
 
 ```

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

@@ -55,11 +55,12 @@ Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`)
   Okay, I'm searching the branch for code that needs to be
   updated...
 
-  I couldn't complete the update because I couldn't find 1
-  constructor(s) for Foo where I expected to. I found: []
+  I couldn't complete the update because the type Foo has
+  unnamed constructors. (I currently need each constructor to
+  have a name somewhere under the type name.)
   
   You can use `view Foo` and
   `alias.term <hash> Foo.<ConstructorName>` to give names to
-  each constructor, and then try again.
+  each constructor, and then try the update again.
 
 ```