From 5b5d2c666feee99981ad8f3e63c6c9faf955c5a1 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 12 Dec 2023 20:04:54 -1000 Subject: [PATCH 1/3] update UpdateIncompleteConstructorSet message closes #4491 --- .../Codebase/Editor/HandleInput/Update2.hs | 15 +++---- .../Codebase/Editor/HandleInput/Upgrade.hs | 3 +- .../src/Unison/Codebase/Editor/Output.hs | 5 ++- .../src/Unison/CommandLine/OutputMessages.hs | 41 ++++++++++--------- .../update-type-missing-constructor.output.md | 9 ++-- .../update-type-stray-constructor.output.md | 9 ++-- 6 files changed, 48 insertions(+), 34 deletions(-) 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 7396511b49..188482a0f0 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..7733c3ddd4 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2191,25 +2191,28 @@ 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 one of your types," + <> P.group (prettyName typeName <> ",") + <> "has unnamed constructors.", + "", + P.wrap $ "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..d00d7a989a 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -53,11 +53,14 @@ 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 one of your types, 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..3e0b17b617 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -55,11 +55,14 @@ 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 one of your types, 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. ``` From 84ace9d57e5428c70329edbf8946b0669e5e114b Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 12 Dec 2023 20:39:46 -1000 Subject: [PATCH 2/3] update message again --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 5 ++--- .../transcripts/update-type-missing-constructor.output.md | 6 ++---- .../transcripts/update-type-stray-constructor.output.md | 6 ++---- 3 files changed, 6 insertions(+), 11 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 7733c3ddd4..ec02a44f4f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2200,9 +2200,8 @@ notifyUser dir = \case <> operationName <> "because one of your types," <> P.group (prettyName typeName <> ",") - <> "has unnamed constructors.", - "", - P.wrap $ "I currently need each constructor to have a name somewhere under the type name.", + <> "has unnamed constructors." + <> "(I currently need each constructor to have a name somewhere under the type name.)", "", P.wrap $ "You can use" diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index d00d7a989a..1c545b2ab0 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -54,10 +54,8 @@ unique type Foo = Bar Nat Nat updated... I couldn't complete the update because one of your types, Foo, - has unnamed constructors. - - I currently need each constructor to have a name somewhere - under the type name. + 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 diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index 3e0b17b617..ea408dac54 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -56,10 +56,8 @@ Note that the constructor name shown here (implied to be called `Foo.Stray.Bar`) updated... I couldn't complete the update because one of your types, Foo, - has unnamed constructors. - - I currently need each constructor to have a name somewhere - under the type name. + 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 From a62aece02628b40703281a412cd608eb4870e7b8 Mon Sep 17 00:00:00 2001 From: Arya Irani Date: Tue, 12 Dec 2023 22:47:17 -1000 Subject: [PATCH 3/3] update message again --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 4 ++-- .../transcripts/update-type-missing-constructor.output.md | 6 +++--- .../transcripts/update-type-stray-constructor.output.md | 6 +++--- 3 files changed, 8 insertions(+), 8 deletions(-) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index ec02a44f4f..467df0ca6f 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -2198,8 +2198,8 @@ notifyUser dir = \case [ P.wrap $ "I couldn't complete the" <> operationName - <> "because one of your types," - <> P.group (prettyName typeName <> ",") + <> "because the type" + <> prettyName typeName <> "has unnamed constructors." <> "(I currently need each constructor to have a name somewhere under the type name.)", "", diff --git a/unison-src/transcripts/update-type-missing-constructor.output.md b/unison-src/transcripts/update-type-missing-constructor.output.md index 1c545b2ab0..ef1aa1dcfc 100644 --- a/unison-src/transcripts/update-type-missing-constructor.output.md +++ b/unison-src/transcripts/update-type-missing-constructor.output.md @@ -53,9 +53,9 @@ 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 one of your types, Foo, - has unnamed constructors. (I currently need each constructor - to have a name somewhere under the type name.) + 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 diff --git a/unison-src/transcripts/update-type-stray-constructor.output.md b/unison-src/transcripts/update-type-stray-constructor.output.md index ea408dac54..bd919fc0b5 100644 --- a/unison-src/transcripts/update-type-stray-constructor.output.md +++ b/unison-src/transcripts/update-type-stray-constructor.output.md @@ -55,9 +55,9 @@ 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 one of your types, Foo, - has unnamed constructors. (I currently need each constructor - to have a name somewhere under the type name.) + 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