diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs index fb2568dd3d..a4aedebb30 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Update2.hs +++ b/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,7 +284,7 @@ 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 @@ -292,6 +292,7 @@ buildBigUnisonFile abort c tuf dependents names ctorNames = -- -- 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 -> @@ -299,7 +300,7 @@ addDefinitionsToUnisonFile :: 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" diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs index ed066419f3..7773a2ce71 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Upgrade.hs +++ b/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 diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 609264ca73..ba96f2686a 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/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 diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 8bc60ef36e..467df0ca6f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/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 ["", prettyName name <> "."]) - <> "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 ["", prettyName typeName <> "."]) + <> "to give names to each constructor, and then try the" + <> operationName + <> "again." + ] UpgradeFailure old new -> pure . P.wrap $ "I couldn't automatically upgrade" diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 9058463f18..ef1aa1dcfc 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/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 Foo.` to give names to - each constructor, and then try again. + each constructor, and then try the update again. ``` diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 028661c703..bd919fc0b5 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/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 Foo.` to give names to - each constructor, and then try again. + each constructor, and then try the update again. ```