From f0683570f5fd158538acc4c5b75e84338052bb89 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Wed, 16 Oct 2024 13:06:28 -0400 Subject: [PATCH 1/5] move `dependents` implementation into its own module --- .../src/Unison/Cli/NameResolutionUtils.hs | 41 +++++++++++ .../src/Unison/Codebase/Editor/HandleInput.hs | 66 ++---------------- .../Codebase/Editor/HandleInput/Dependents.hs | 68 +++++++++++++++++++ unison-cli/unison-cli.cabal | 2 + 4 files changed, 115 insertions(+), 62 deletions(-) create mode 100644 unison-cli/src/Unison/Cli/NameResolutionUtils.hs create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs diff --git a/unison-cli/src/Unison/Cli/NameResolutionUtils.hs b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs new file mode 100644 index 0000000000..95939d8297 --- /dev/null +++ b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs @@ -0,0 +1,41 @@ +-- | Utilities related to resolving names to things. +module Unison.Cli.NameResolutionUtils + ( resolveHQToLabeledDependencies, + ) +where + +import Control.Monad.Reader (ask) +import Data.Set qualified as Set +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.HashQualified qualified as HQ +import Unison.LabeledDependency (LabeledDependency) +import Unison.LabeledDependency qualified as LD +import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.Names qualified as Names +import Unison.Prelude +import Unison.Server.NameSearch.Sqlite qualified as Sqlite + +-- todo: compare to `getHQTerms` / `getHQTypes`. Is one universally better? +resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) +resolveHQToLabeledDependencies = \case + HQ.NameOnly n -> do + names <- Cli.currentNames + let terms, types :: Set LabeledDependency + terms = Set.map LD.referent . Name.searchBySuffix n $ Names.terms names + types = Set.map LD.typeRef . Name.searchBySuffix n $ Names.types names + pure $ terms <> types + -- rationale: the hash should be unique enough that the name never helps + HQ.HashQualified _n sh -> resolveHashOnly sh + HQ.HashOnly sh -> resolveHashOnly sh + where + resolveHashOnly sh = do + Cli.Env {codebase} <- ask + (terms, types) <- + Cli.runTransaction do + terms <- Sqlite.termReferentsByShortHash codebase sh + types <- Sqlite.typeReferencesByShortHash sh + pure (terms, types) + pure $ Set.map LD.referent terms <> Set.map LD.typeRef types diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 265a04a886..c26b6e3c46 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -36,6 +36,7 @@ import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils (getCurrentProjectBranch) import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies) import Unison.Cli.NamesUtils qualified as Cli import Unison.Cli.ProjectUtils qualified as ProjectUtils import Unison.Codebase qualified as Codebase @@ -59,6 +60,7 @@ import Unison.Codebase.Editor.HandleInput.DebugFoldRanges qualified as DebugFold import Unison.Codebase.Editor.HandleInput.DebugSynhashTerm (handleDebugSynhashTerm) import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) +import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI) import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format @@ -771,7 +773,7 @@ loop e = do names <- lift Cli.currentNames let buildPPED uf tf = let names' = (fromMaybe mempty $ (UF.typecheckedToNames <$> tf) <|> (UF.toNames <$> uf)) `Names.shadowing` names - in pure (PPED.makePPED (PPE.hqNamer 10 names') (PPE.suffixifyByHashName names')) + in pure (PPED.makePPED (PPE.hqNamer 10 names') (PPE.suffixifyByHashName names')) let formatWidth = 80 currentPath <- lift $ Cli.getCurrentPath updates <- MaybeT $ Format.formatFile buildPPED formatWidth currentPath pf tf Nothing @@ -1226,44 +1228,6 @@ handleDependencies hq = do Cli.setNumberedArgs . map SA.HashQualified $ types <> terms Cli.respond $ ListDependencies suffixifiedPPE lds types terms -handleDependents :: HQ.HashQualified Name -> Cli () -handleDependents hq = do - -- todo: add flag to handle transitive efficiently - lds <- resolveHQToLabeledDependencies hq - -- Use an unsuffixified PPE here, so we display full names (relative to the current path), - -- rather than the shortest possible unambiguous name. - names <- Cli.currentNames - let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) - let fqppe = PPE.unsuffixifiedPPE pped - let ppe = PPE.suffixifiedPPE pped - when (null lds) do - Cli.returnEarly (LabeledReferenceNotFound hq) - - results <- for (toList lds) \ld -> do - -- The full set of dependent references, any number of which may not have names in the current namespace. - dependents <- - let tp = Codebase.dependents Queries.ExcludeOwnComponent - tm = \case - Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r - Referent.Con (ConstructorReference r _cid) _ct -> - Codebase.dependents Queries.ExcludeOwnComponent r - in Cli.runTransaction (LD.fold tp tm ld) - let -- True is term names, False is type names - results :: [(Bool, HQ.HashQualified Name, Reference)] - results = do - r <- Set.toList dependents - Just (isTerm, hq) <- [(True,) <$> PPE.terms fqppe (Referent.Ref r), (False,) <$> PPE.types fqppe r] - fullName <- [HQ'.toName hq] - guard (not (Name.beginsWithSegment fullName NameSegment.libSegment)) - Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r - pure (isTerm, HQ'.toHQ shortName, r) - pure results - let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) - let types = sort [(n, r) | (False, n, r) <- join results] - let terms = sort [(n, r) | (True, n, r) <- join results] - Cli.setNumberedArgs . map SA.HashQualified $ types <> terms - Cli.respond (ListDependents ppe lds types terms) - -- | Handle a @ShowDefinitionI@ input command, i.e. `view` or `edit`. handleShowDefinition :: OutputLocation -> ShowDefinitionScope -> NonEmpty (HQ.HashQualified Name) -> Cli () handleShowDefinition outputLoc showDefinitionScope query = do @@ -1308,28 +1272,6 @@ handleShowDefinition outputLoc showDefinitionScope query = do FileLocation _ -> Backend.IncludeCycles LatestFileLocation -> Backend.IncludeCycles --- todo: compare to `getHQTerms` / `getHQTypes`. Is one universally better? -resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) -resolveHQToLabeledDependencies = \case - HQ.NameOnly n -> do - names <- Cli.currentNames - let terms, types :: Set LabeledDependency - terms = Set.map LD.referent . Name.searchBySuffix n $ Names.terms names - types = Set.map LD.typeRef . Name.searchBySuffix n $ Names.types names - pure $ terms <> types - -- rationale: the hash should be unique enough that the name never helps - HQ.HashQualified _n sh -> resolveHashOnly sh - HQ.HashOnly sh -> resolveHashOnly sh - where - resolveHashOnly sh = do - Cli.Env {codebase} <- ask - (terms, types) <- - Cli.runTransaction do - terms <- Backend.termReferentsByShortHash codebase sh - types <- Backend.typeReferencesByShortHash sh - pure (terms, types) - pure $ Set.map LD.referent terms <> Set.map LD.typeRef types - doDisplay :: OutputLocation -> Names -> Term Symbol () -> Cli () doDisplay outputLoc names tm = do Cli.Env {codebase} <- ask @@ -1475,7 +1417,7 @@ doCompile profile native output main = do outf | native = output | otherwise = output <> ".uc" - copts = Runtime.defaultCompileOpts { Runtime.profile = profile } + copts = Runtime.defaultCompileOpts {Runtime.profile = profile} whenJustM ( liftIO $ Runtime.compileTo theRuntime copts codeLookup ppe ref outf diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs new file mode 100644 index 0000000000..46e279c0a8 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs @@ -0,0 +1,68 @@ +module Unison.Codebase.Editor.HandleInput.Dependents + ( handleDependents, + ) +where + +import Data.Set qualified as Set +import U.Codebase.Sqlite.Queries qualified as Queries +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQToLabeledDependencies) +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Editor.Output +import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.ConstructorReference (GConstructorReference (..)) +import Unison.HashQualified qualified as HQ +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.LabeledDependency qualified as LD +import Unison.Name (Name) +import Unison.Name qualified as Name +import Unison.NameSegment qualified as NameSegment +import Unison.Prelude +import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl qualified as PPE hiding (biasTo, empty) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (Reference) +import Unison.Referent qualified as Referent +import Unison.Syntax.HashQualified qualified as HQ (toText) +import Unison.Util.List (nubOrdOn) + +handleDependents :: HQ.HashQualified Name -> Cli () +handleDependents hq = do + -- todo: add flag to handle transitive efficiently + lds <- resolveHQToLabeledDependencies hq + -- Use an unsuffixified PPE here, so we display full names (relative to the current path), + -- rather than the shortest possible unambiguous name. + names <- Cli.currentNames + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + let fqppe = PPE.unsuffixifiedPPE pped + let ppe = PPE.suffixifiedPPE pped + when (null lds) do + Cli.returnEarly (LabeledReferenceNotFound hq) + + results <- for (toList lds) \ld -> do + -- The full set of dependent references, any number of which may not have names in the current namespace. + dependents <- + let tp = Codebase.dependents Queries.ExcludeOwnComponent + tm = \case + Referent.Ref r -> Codebase.dependents Queries.ExcludeOwnComponent r + Referent.Con (ConstructorReference r _cid) _ct -> + Codebase.dependents Queries.ExcludeOwnComponent r + in Cli.runTransaction (LD.fold tp tm ld) + let -- True is term names, False is type names + results :: [(Bool, HQ.HashQualified Name, Reference)] + results = do + r <- Set.toList dependents + Just (isTerm, hq) <- [(True,) <$> PPE.terms fqppe (Referent.Ref r), (False,) <$> PPE.types fqppe r] + fullName <- [HQ'.toName hq] + guard (not (Name.beginsWithSegment fullName NameSegment.libSegment)) + Just shortName <- pure $ PPE.terms ppe (Referent.Ref r) <|> PPE.types ppe r + pure (isTerm, HQ'.toHQ shortName, r) + pure results + let sort = fmap fst . nubOrdOn snd . Name.sortByText (HQ.toText . fst) + let types = sort [(n, r) | (False, n, r) <- join results] + let terms = sort [(n, r) | (True, n, r) <- join results] + Cli.setNumberedArgs . map SA.HashQualified $ types <> terms + Cli.respond (ListDependents ppe lds types terms) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index d7952578d9..eb6ee73132 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -38,6 +38,7 @@ library Unison.Cli.MergeTypes Unison.Cli.Monad Unison.Cli.MonadUtils + Unison.Cli.NameResolutionUtils Unison.Cli.NamesUtils Unison.Cli.Pretty Unison.Cli.ProjectUtils @@ -61,6 +62,7 @@ library Unison.Codebase.Editor.HandleInput.DebugSynhashTerm Unison.Codebase.Editor.HandleInput.DeleteBranch Unison.Codebase.Editor.HandleInput.DeleteProject + Unison.Codebase.Editor.HandleInput.Dependents Unison.Codebase.Editor.HandleInput.EditNamespace Unison.Codebase.Editor.HandleInput.FindAndReplace Unison.Codebase.Editor.HandleInput.FormatFile From 68f55ac89fd854495bf14b0f5d98473727356759 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Wed, 20 Nov 2024 10:46:05 -0500 Subject: [PATCH 2/5] add edit.dependents command --- lib/unison-prelude/src/Unison/Util/Set.hs | 6 + parser-typechecker/src/Unison/Codebase.hs | 21 +++- .../src/Unison/Cli/NameResolutionUtils.hs | 48 ++++--- .../src/Unison/Codebase/Editor/HandleInput.hs | 3 + .../Editor/HandleInput/EditDependents.hs | 83 +++++++++++++ .../Editor/HandleInput/EditNamespace.hs | 117 +++++++++++------- .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/CommandLine/InputPatterns.hs | 15 +++ unison-cli/unison-cli.cabal | 1 + unison-core/src/Unison/Util/Defns.hs | 10 ++ 10 files changed, 239 insertions(+), 66 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs diff --git a/lib/unison-prelude/src/Unison/Util/Set.hs b/lib/unison-prelude/src/Unison/Util/Set.hs index 50d2cff56a..4e3c6ef9b9 100644 --- a/lib/unison-prelude/src/Unison/Util/Set.hs +++ b/lib/unison-prelude/src/Unison/Util/Set.hs @@ -1,6 +1,7 @@ module Unison.Util.Set ( asSingleton, difference1, + intersects, mapMaybe, symmetricDifference, Unison.Util.Set.traverse, @@ -29,6 +30,11 @@ difference1 xs ys = where zs = Set.difference xs ys +-- | Get whether two sets intersect. +intersects :: (Ord a) => Set a -> Set a -> Bool +intersects xs ys = + not (Set.disjoint xs ys) + symmetricDifference :: (Ord a) => Set a -> Set a -> Set a symmetricDifference a b = (a `Set.difference` b) `Set.union` (b `Set.difference` a) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index fae356d3a2..1fcb0e5c7c 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -402,7 +402,6 @@ typeLookupForDependencies codebase s = do in depthFirstAccumTypes z (DD.typeDependencies dd) Nothing -> pure tl goType tl Reference.Builtin {} = pure tl -- codebase isn't consulted for builtins - unseen :: TL.TypeLookup Symbol a -> Reference -> Bool unseen tl r = isNothing @@ -469,14 +468,28 @@ termsOfTypeByReference c r = . Set.map (fmap Reference.DerivedId) <$> termsOfTypeImpl c r -filterTermsByReferentHavingType :: (Var v) => Codebase m v a -> Type v a -> Set Referent.Referent -> Sqlite.Transaction (Set Referent.Referent) +filterTermsByReferentHavingType :: + (Var v) => + Codebase m v a -> + Type v a -> + Set Referent.Referent -> + Sqlite.Transaction (Set Referent.Referent) filterTermsByReferentHavingType c ty = filterTermsByReferentHavingTypeByReference c $ Hashing.typeToReference ty -filterTermsByReferenceIdHavingType :: (Var v) => Codebase m v a -> Type v a -> Set TermReferenceId -> Sqlite.Transaction (Set TermReferenceId) +filterTermsByReferenceIdHavingType :: + (Var v) => + Codebase m v a -> + Type v a -> + Set TermReferenceId -> + Sqlite.Transaction (Set TermReferenceId) filterTermsByReferenceIdHavingType c ty = filterTermsByReferenceIdHavingTypeImpl c (Hashing.typeToReference ty) -- | Find the subset of `tms` which match the exact type `r` points to. -filterTermsByReferentHavingTypeByReference :: Codebase m v a -> TypeReference -> Set Referent.Referent -> Sqlite.Transaction (Set Referent.Referent) +filterTermsByReferentHavingTypeByReference :: + Codebase m v a -> + TypeReference -> + Set Referent.Referent -> + Sqlite.Transaction (Set Referent.Referent) filterTermsByReferentHavingTypeByReference c r tms = do let (builtins, derived) = partitionEithers . map p $ Set.toList tms let builtins' = diff --git a/unison-cli/src/Unison/Cli/NameResolutionUtils.hs b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs index 95939d8297..92b06f1e95 100644 --- a/unison-cli/src/Unison/Cli/NameResolutionUtils.hs +++ b/unison-cli/src/Unison/Cli/NameResolutionUtils.hs @@ -1,10 +1,12 @@ -- | Utilities related to resolving names to things. module Unison.Cli.NameResolutionUtils - ( resolveHQToLabeledDependencies, + ( resolveHQName, + resolveHQToLabeledDependencies, ) where import Control.Monad.Reader (ask) +import Data.Bifoldable (bifoldMap) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -16,26 +18,34 @@ import Unison.Name (Name) import Unison.Name qualified as Name import Unison.Names qualified as Names import Unison.Prelude +import Unison.Reference (TypeReference) +import Unison.Referent (Referent) import Unison.Server.NameSearch.Sqlite qualified as Sqlite +import Unison.ShortHash (ShortHash) +import Unison.Util.Defns (Defns (..), DefnsF) --- todo: compare to `getHQTerms` / `getHQTypes`. Is one universally better? -resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) -resolveHQToLabeledDependencies = \case - HQ.NameOnly n -> do +resolveHQName :: HQ.HashQualified Name -> Cli (DefnsF Set Referent TypeReference) +resolveHQName = \case + HQ.NameOnly name -> do names <- Cli.currentNames - let terms, types :: Set LabeledDependency - terms = Set.map LD.referent . Name.searchBySuffix n $ Names.terms names - types = Set.map LD.typeRef . Name.searchBySuffix n $ Names.types names - pure $ terms <> types + pure + Defns + { terms = Name.searchByRankedSuffix name names.terms, + types = Name.searchByRankedSuffix name names.types + } -- rationale: the hash should be unique enough that the name never helps - HQ.HashQualified _n sh -> resolveHashOnly sh - HQ.HashOnly sh -> resolveHashOnly sh + -- mitchell says: that seems wrong + HQ.HashQualified _n hash -> resolveHashOnly hash + HQ.HashOnly hash -> resolveHashOnly hash where - resolveHashOnly sh = do - Cli.Env {codebase} <- ask - (terms, types) <- - Cli.runTransaction do - terms <- Sqlite.termReferentsByShortHash codebase sh - types <- Sqlite.typeReferencesByShortHash sh - pure (terms, types) - pure $ Set.map LD.referent terms <> Set.map LD.typeRef types + resolveHashOnly :: ShortHash -> Cli (DefnsF Set Referent TypeReference) + resolveHashOnly hash = do + env <- ask + Cli.runTransaction do + terms <- Sqlite.termReferentsByShortHash env.codebase hash + types <- Sqlite.typeReferencesByShortHash hash + pure Defns {terms, types} + +resolveHQToLabeledDependencies :: HQ.HashQualified Name -> Cli (Set LabeledDependency) +resolveHQToLabeledDependencies = + fmap (bifoldMap (Set.map LD.referent) (Set.map LD.typeRef)) . resolveHQName diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index ce273ab063..fa9e44e950 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -61,6 +61,7 @@ import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) import Unison.Codebase.Editor.HandleInput.Dependents (handleDependents) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) +import Unison.Codebase.Editor.HandleInput.EditDependents (handleEditDependents) import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI, handleTextFindI) import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format import Unison.Codebase.Editor.HandleInput.Global qualified as Global @@ -884,6 +885,7 @@ loop e = do UpgradeCommitI -> handleCommitUpgrade LibInstallI remind libdep -> handleInstallLib remind libdep DebugSynhashTermI name -> handleDebugSynhashTerm name + EditDependentsI name -> handleEditDependents name inputDescription :: Input -> Cli Text inputDescription input = @@ -1025,6 +1027,7 @@ inputDescription input = DisplayI {} -> wat DocsI {} -> wat DocsToHtmlI {} -> wat + EditDependentsI {} -> wat FindI {} -> wat FindShallowI {} -> wat HistoryI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs new file mode 100644 index 0000000000..e0a7971a63 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs @@ -0,0 +1,83 @@ +module Unison.Codebase.Editor.HandleInput.EditDependents + ( handleEditDependents, + ) +where + +import Control.Monad.Reader (ask) +import Data.Bifoldable (bifold) +import Data.Set qualified as Set +import U.Codebase.Sqlite.Operations qualified as Operations +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.MonadUtils qualified as Cli +import Unison.Cli.NameResolutionUtils (resolveHQName) +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.HandleInput.EditNamespace (getNamesForEdit) +import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) +import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..)) +import Unison.ConstructorReference qualified as ConstructorReference +import Unison.HashQualified qualified as HQ +import Unison.Name (Name) +import Unison.Names (Names (..)) +import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (TermReference, TypeReference) +import Unison.Reference qualified as Reference +import Unison.Referent qualified as Referent +import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Defns qualified as Defns +import Unison.Util.Relation qualified as Relation + +handleEditDependents :: HQ.HashQualified Name -> Cli () +handleEditDependents name = do + -- Get all of the referents and type references this name refers to + refs0 <- resolveHQName name + + -- Since we don't track constructor dependents precisely, convert to just the term and type references + let refs :: DefnsF Set TermReference TypeReference + refs = + let f = \case + Referent.Con ref _ -> Defns.fromTypes (Set.singleton (ref ^. ConstructorReference.reference_)) + Referent.Ref ref -> Defns.fromTerms (Set.singleton ref) + in Defns Set.empty refs0.types <> foldMap f refs0.terms + + -- Load the current project namespace and throw away the libdeps + branch <- Cli.getCurrentBranch0 + let ppe = + let names = Branch.toNames branch + in PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHashName names) + + -- Throw away the libdeps + let branchWithoutLibdeps = Branch.deleteLibdeps branch + + -- Identify the local dependents of the input name + dependents <- + Cli.runTransaction do + Operations.transitiveDependentsWithinScope + (Branch.deepTermReferenceIds branchWithoutLibdeps <> Branch.deepTypeReferenceIds branchWithoutLibdeps) + (bifold refs) + + (types, terms) <- do + env <- ask + Cli.runTransaction + ( getNamesForEdit + env.codebase + ppe + Names + { terms = + branchWithoutLibdeps + & Branch.deepTerms + & Relation.restrictDom (Set.mapMonotonic Referent.fromTermReferenceId dependents.terms) + & Relation.swap, + types = + branchWithoutLibdeps + & Branch.deepTypes + & Relation.restrictDom (Set.mapMonotonic Reference.fromId dependents.types) + & Relation.swap + } + ) + + let misses = [] + showDefinitions (LatestFileLocation WithinFold) ppe terms types misses diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs index d50e776f05..f7dec844cf 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditNamespace.hs @@ -1,4 +1,8 @@ -module Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) where +module Unison.Codebase.Editor.HandleInput.EditNamespace + ( handleEditNamespace, + getNamesForEdit, + ) +where import Control.Monad.Reader import Data.Foldable qualified as Foldable @@ -9,25 +13,36 @@ import U.Codebase.Reference (Reference' (..)) import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli import Unison.Cli.MonadUtils qualified as Cli +import Unison.Codebase (Codebase) import Unison.Codebase qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.DisplayObject (DisplayObject) import Unison.Codebase.Editor.DisplayObject qualified as DisplayObject import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.Input (OutputLocation (..)) import Unison.Codebase.Path (Path) import Unison.Codebase.Path qualified as Path +import Unison.DataDeclaration (Decl) import Unison.HashQualified qualified as HQ import Unison.Name (Name) +import Unison.Names (Names) import Unison.Names qualified as Names +import Unison.Parser.Ann (Ann) import Unison.Prelude +import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.PrettyPrintEnvDecl (PrettyPrintEnvDecl (..)) +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (TermReference, TypeReference) import Unison.Referent qualified as Referent import Unison.Server.Backend qualified as Backend +import Unison.Sqlite qualified as Sqlite +import Unison.Symbol (Symbol) import Unison.Syntax.DeclPrinter qualified as DeclPrinter +import Unison.Term (Term) +import Unison.Type (Type) import Unison.Util.Monoid (foldMapM) -import qualified Unison.PrettyPrintEnv.Names as PPE -import qualified Unison.PrettyPrintEnvDecl.Names as PPED +import Unison.Util.Set qualified as Set handleEditNamespace :: OutputLocation -> [Path] -> Cli () handleEditNamespace outputLoc paths0 = do @@ -53,47 +68,63 @@ handleEditNamespace outputLoc paths0 = do Nothing -> names Just pathPrefix -> Names.prefix0 pathPrefix names + (types, terms) <- Cli.runTransaction (getNamesForEdit codebase ppe allNamesToEdit) + let misses = [] + showDefinitions outputLoc ppe terms types misses + +-- | Get names "for edit": gets types and terms out the codebase as display objects, but is careful not to get an +-- auto-generated record accessor term like `Foo.bar.set` if it's also getting the corresponding type `Foo`. This is +-- because these name are "for edit", i.e. going into a scratch file, where parsing the record type will generate +-- its accessors. +getNamesForEdit :: + Codebase m Symbol Ann -> + PrettyPrintEnvDecl -> + Names -> + Sqlite.Transaction + ( Map TypeReference (DisplayObject () (Decl Symbol Ann)), + Map TermReference (DisplayObject (Type Symbol Ann) (Term Symbol Ann)) + ) +getNamesForEdit codebase ppe allNamesToEdit = do let termRefs = Names.termReferences allNamesToEdit let typeRefs = Names.typeReferences allNamesToEdit - (types, terms) <- - Cli.runTransaction do - (types, accessorNames) <- - Foldable.foldlM - ( \(types, accessorNames) ref -> - case ref of - ReferenceBuiltin _ -> do - let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types - pure (types1, accessorNames) - ReferenceDerived refId -> do - decl <- Codebase.unsafeGetTypeDeclaration codebase refId - let !types1 = Map.insert ref (DisplayObject.UserObject decl) types - let !accessorNames1 = - accessorNames <> case decl of - Left _effectDecl -> Set.empty - Right dataDecl -> - let declAccessorNames :: Name -> Set Name - declAccessorNames declName = - case DeclPrinter.getFieldAndAccessorNames - ppe.unsuffixifiedPPE - ref - (HQ.fromName declName) - dataDecl of - Nothing -> Set.empty - Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames - in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref) - pure (types1, accessorNames1) - ) - (Map.empty, Set.empty) - typeRefs - terms <- - termRefs & foldMapM \ref -> - let isRecordAccessor = - not (Set.disjoint (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) accessorNames) - in if isRecordAccessor - then pure Map.empty - else Map.singleton ref <$> Backend.displayTerm codebase ref - pure (types, terms) + (types, accessorNames) <- + Foldable.foldlM + ( \(types, accessorNames) ref -> + case ref of + ReferenceBuiltin _ -> do + let !types1 = Map.insert ref (DisplayObject.BuiltinObject ()) types + pure (types1, accessorNames) + ReferenceDerived refId -> do + decl <- Codebase.unsafeGetTypeDeclaration codebase refId + let !types1 = Map.insert ref (DisplayObject.UserObject decl) types + let !accessorNames1 = + accessorNames <> case decl of + Left _effectDecl -> Set.empty + Right dataDecl -> + let declAccessorNames :: Name -> Set Name + declAccessorNames declName = + case DeclPrinter.getFieldAndAccessorNames + ppe.unsuffixifiedPPE + ref + (HQ.fromName declName) + dataDecl of + Nothing -> Set.empty + Just (_fieldNames, theAccessorNames) -> Set.fromList theAccessorNames + in foldMap declAccessorNames (Names.namesForReference allNamesToEdit ref) + pure (types1, accessorNames1) + ) + (Map.empty, Set.empty) + typeRefs - let misses = [] - showDefinitions outputLoc ppe terms types misses + terms <- + termRefs & foldMapM \ref -> + let isRecordAccessor = + Set.intersects + (Names.namesForReferent allNamesToEdit (Referent.fromTermReference ref)) + accessorNames + in if isRecordAccessor + then pure Map.empty + else Map.singleton ref <$> Backend.displayTerm codebase ref + + pure (types, terms) diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index d33a3cfb20..cb4c05a9f5 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -244,6 +244,7 @@ data Input | UpgradeCommitI | MergeCommitI | DebugSynhashTermI !Name + | EditDependentsI !(HQ.HashQualified Name) deriving (Eq, Show) -- | The source of a `branch` command: what to make the new branch from. diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 40623a8c63..4365b33d7c 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -51,6 +51,7 @@ module Unison.CommandLine.InputPatterns docs, docsToHtml, edit, + editDependents, editNamespace, execute, find, @@ -2404,6 +2405,19 @@ editNew = . NE.nonEmpty } +editDependents :: InputPattern +editDependents = + InputPattern + { patternName = "edit.dependents", + aliases = [], + visibility = I.Visible, + args = [("definition to edit", Required, definitionQueryArg)], + help = "Like `edit`, but also includes all transitive dependents in the current project.", + parse = \case + [name] -> Input.EditDependentsI <$> handleHashQualifiedNameArg name + args -> wrongArgsLength "exactly one argument" args + } + editNamespace :: InputPattern editNamespace = InputPattern @@ -3601,6 +3615,7 @@ validInputs = docs, docsToHtml, edit, + editDependents, editNamespace, editNew, execute, diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index c0371af27a..2ac65887c1 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -63,6 +63,7 @@ library Unison.Codebase.Editor.HandleInput.DeleteBranch Unison.Codebase.Editor.HandleInput.DeleteProject Unison.Codebase.Editor.HandleInput.Dependents + Unison.Codebase.Editor.HandleInput.EditDependents Unison.Codebase.Editor.HandleInput.EditNamespace Unison.Codebase.Editor.HandleInput.FindAndReplace Unison.Codebase.Editor.HandleInput.FormatFile diff --git a/unison-core/src/Unison/Util/Defns.hs b/unison-core/src/Unison/Util/Defns.hs index 5f56166d01..fed00742b4 100644 --- a/unison-core/src/Unison/Util/Defns.hs +++ b/unison-core/src/Unison/Util/Defns.hs @@ -6,6 +6,8 @@ module Unison.Util.Defns DefnsF4, alignDefnsWith, defnsAreEmpty, + fromTerms, + fromTypes, hoistDefnsF, mapDefns, unzipDefns, @@ -65,6 +67,14 @@ defnsAreEmpty :: (Foldable f, Foldable g) => Defns (f a) (g b) -> Bool defnsAreEmpty defns = null defns.terms && null defns.types +fromTerms :: (Monoid types) => terms -> Defns terms types +fromTerms terms = + Defns {terms, types = mempty} + +fromTypes :: (Monoid terms) => types -> Defns terms types +fromTypes types = + Defns {terms = mempty, types} + hoistDefnsF :: (forall x. f x -> g x) -> DefnsF f a b -> DefnsF g a b hoistDefnsF f (Defns x y) = Defns (f x) (f y) From 111356eb90f79b8a237750542a3731d4ff7ddf54 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Wed, 20 Nov 2024 11:04:52 -0500 Subject: [PATCH 3/5] add progress messages to edit.dependents --- .../Editor/HandleInput/EditDependents.hs | 72 ++++++++++--------- .../Codebase/Editor/HandleInput/Merge2.hs | 12 ++-- .../src/Unison/Codebase/Editor/Output.hs | 15 ++-- .../src/Unison/CommandLine/OutputMessages.hs | 8 +-- 4 files changed, 51 insertions(+), 56 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs index e0a7971a63..884451576c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs @@ -16,6 +16,7 @@ import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.HandleInput.EditNamespace (getNamesForEdit) import Unison.Codebase.Editor.HandleInput.ShowDefinition (showDefinitions) import Unison.Codebase.Editor.Input (OutputLocation (..), RelativeToFold (..)) +import Unison.Codebase.Editor.Output qualified as Output import Unison.ConstructorReference qualified as ConstructorReference import Unison.HashQualified qualified as HQ import Unison.Name (Name) @@ -43,41 +44,48 @@ handleEditDependents name = do Referent.Ref ref -> Defns.fromTerms (Set.singleton ref) in Defns Set.empty refs0.types <> foldMap f refs0.terms - -- Load the current project namespace and throw away the libdeps - branch <- Cli.getCurrentBranch0 - let ppe = - let names = Branch.toNames branch - in PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHashName names) + (ppe, types, terms) <- + Cli.withRespondRegion \respondRegion -> do + respondRegion (Output.Literal "Loading branch...") - -- Throw away the libdeps - let branchWithoutLibdeps = Branch.deleteLibdeps branch + -- Load the current project namespace and throw away the libdeps + branch <- Cli.getCurrentBranch0 + let ppe = + let names = Branch.toNames branch + in PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHashName names) - -- Identify the local dependents of the input name - dependents <- - Cli.runTransaction do - Operations.transitiveDependentsWithinScope - (Branch.deepTermReferenceIds branchWithoutLibdeps <> Branch.deepTypeReferenceIds branchWithoutLibdeps) - (bifold refs) + -- Throw away the libdeps + let branchWithoutLibdeps = Branch.deleteLibdeps branch - (types, terms) <- do - env <- ask - Cli.runTransaction - ( getNamesForEdit - env.codebase - ppe - Names - { terms = - branchWithoutLibdeps - & Branch.deepTerms - & Relation.restrictDom (Set.mapMonotonic Referent.fromTermReferenceId dependents.terms) - & Relation.swap, - types = - branchWithoutLibdeps - & Branch.deepTypes - & Relation.restrictDom (Set.mapMonotonic Reference.fromId dependents.types) - & Relation.swap - } - ) + -- Identify the local dependents of the input name + respondRegion (Output.Literal "Identifying dependents...") + dependents <- + Cli.runTransaction do + Operations.transitiveDependentsWithinScope + (Branch.deepTermReferenceIds branchWithoutLibdeps <> Branch.deepTypeReferenceIds branchWithoutLibdeps) + (bifold refs) + + respondRegion (Output.Literal "Loading dependents...") + env <- ask + (types, terms) <- + Cli.runTransaction + ( getNamesForEdit + env.codebase + ppe + Names + { terms = + branchWithoutLibdeps + & Branch.deepTerms + & Relation.restrictDom (Set.mapMonotonic Referent.fromTermReferenceId dependents.terms) + & Relation.swap, + types = + branchWithoutLibdeps + & Branch.deepTypes + & Relation.restrictDom (Set.mapMonotonic Reference.fromId dependents.types) + & Relation.swap + } + ) + pure (ppe, types, terms) let misses = [] showDefinitions (LatestFileLocation WithinFold) ppe terms types misses diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs index 1dec15d091..72920b190d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Merge2.hs @@ -189,7 +189,7 @@ doMerge info = do done (Output.MergeSuccessFastForward mergeSourceAndTarget) Cli.withRespondRegion \respondRegion -> do - respondRegion (Output.MergeProgress Output.MergeProgress'LoadingBranches) + respondRegion (Output.Literal "Loading branches...") -- Load Alice/Bob/LCA causals causals <- @@ -260,7 +260,7 @@ doMerge info = do in bimap f g <$> blob0.defns ) - respondRegion (Output.MergeProgress Output.MergeProgress'DiffingBranches) + respondRegion (Output.Literal "Computing diff between branches...") blob1 <- Merge.makeMergeblob1 blob0 hydratedDefns & onLeft \case @@ -282,14 +282,14 @@ doMerge info = do liftIO (debugFunctions.debugPartitionedDiff blob2.conflicts blob2.unconflicts) - respondRegion (Output.MergeProgress Output.MergeProgress'LoadingDependents) + respondRegion (Output.Literal "Loading dependents of changes...") dependents0 <- Cli.runTransaction $ for ((,) <$> ThreeWay.forgetLca blob2.defns <*> blob2.coreDependencies) \(defns, deps) -> getNamespaceDependentsOf3 defns deps - respondRegion (Output.MergeProgress Output.MergeProgress'LoadingAndMergingLibdeps) + respondRegion (Output.Literal "Loading and merging library dependencies...") -- Load libdeps (mergedLibdeps, lcaLibdeps) <- do @@ -310,7 +310,7 @@ doMerge info = do let hasConflicts = blob2.hasConflicts - respondRegion (Output.MergeProgress Output.MergeProgress'RenderingUnisonFile) + respondRegion (Output.Literal "Rendering Unison file...") let blob3 = Merge.makeMergeblob3 @@ -338,7 +338,7 @@ doMerge info = do else case Merge.makeMergeblob4 blob3 of Left _parseErr -> pure Nothing Right blob4 -> do - respondRegion (Output.MergeProgress Output.MergeProgress'TypecheckingUnisonFile) + respondRegion (Output.Literal "Typechecking Unison file...") typeLookup <- Cli.runTransaction (Codebase.typeLookupForDependencies env.codebase blob4.dependencies) pure case Merge.makeMergeblob5 blob4 typeLookup of Left _typecheckErr -> Nothing diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b811fde7f9..28f98e16a2 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -16,7 +16,6 @@ module Unison.Codebase.Editor.Output UpdateOrUpgrade (..), isFailure, isNumberedFailure, - MergeProgress (..), ) where @@ -441,15 +440,9 @@ data Output | ConflictedDefn !Text {- what operation? -} !(Defn (Conflicted Name Referent) (Conflicted Name TypeReference)) | IncoherentDeclDuringMerge !MergeSourceOrTarget !IncoherentDeclReason | IncoherentDeclDuringUpdate !IncoherentDeclReason - | MergeProgress !MergeProgress - -data MergeProgress - = MergeProgress'LoadingBranches - | MergeProgress'DiffingBranches - | MergeProgress'LoadingDependents - | MergeProgress'LoadingAndMergingLibdeps - | MergeProgress'RenderingUnisonFile - | MergeProgress'TypecheckingUnisonFile + | -- | A literal output message. Use this if it's too cumbersome to create a new Output constructor, e.g. for + -- ephemeral progress messages that are just simple strings like "Loading branch..." + Literal !(P.Pretty P.ColorText) data MoreEntriesThanShown = MoreEntriesThanShown | AllEntriesShown deriving (Eq, Show) @@ -690,7 +683,7 @@ isFailure o = case o of ConflictedDefn {} -> True IncoherentDeclDuringMerge {} -> True IncoherentDeclDuringUpdate {} -> True - MergeProgress _ -> False + Literal _ -> False isNumberedFailure :: NumberedOutput -> Bool isNumberedFailure = \case diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 147b3f32f4..b8462e7cd1 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -50,7 +50,6 @@ import Unison.Codebase.Editor.Input (BranchIdG (..)) import Unison.Codebase.Editor.Input qualified as Input import Unison.Codebase.Editor.Output ( CreatedProjectBranchFrom (..), - MergeProgress (..), NumberedArgs, NumberedOutput (..), Output (..), @@ -2261,12 +2260,7 @@ notifyUser dir = \case <> IP.makeExample' IP.delete <> "it. Then try the update again." ] - MergeProgress MergeProgress'LoadingBranches -> pure "Loading branches..." - MergeProgress MergeProgress'DiffingBranches -> pure "Computing diff between branches..." - MergeProgress MergeProgress'LoadingDependents -> pure "Loading dependents of changes..." - MergeProgress MergeProgress'LoadingAndMergingLibdeps -> pure "Loading and merging library dependencies..." - MergeProgress MergeProgress'RenderingUnisonFile -> pure "Rendering Unison file..." - MergeProgress MergeProgress'TypecheckingUnisonFile -> pure "Typechecking Unison file..." + Literal message -> pure message prettyShareError :: ShareError -> Pretty prettyShareError = From 0d7fefa02c0884ccc8194efa23341574ef33c31f Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Tue, 26 Nov 2024 12:51:36 -0500 Subject: [PATCH 4/5] make edit.dependents pull in the edited thing as well, not just dependents --- unison-cli/src/Unison/Cli/Monad.hs | 22 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 1 - .../Editor/HandleInput/EditDependents.hs | 18 +- .../transcripts/edit-dependents-command.md | 35 ++ .../edit-dependents-command.output.md | 92 +++++ unison-src/transcripts/fix-5326.output.md | 12 + unison-src/transcripts/help.output.md | 3 + unison-src/transcripts/merge.output.md | 326 ++++++++++++++++++ 8 files changed, 498 insertions(+), 11 deletions(-) create mode 100644 unison-src/transcripts/edit-dependents-command.md create mode 100644 unison-src/transcripts/edit-dependents-command.output.md diff --git a/unison-cli/src/Unison/Cli/Monad.hs b/unison-cli/src/Unison/Cli/Monad.hs index 4656cc1d5d..cede3035fb 100644 --- a/unison-cli/src/Unison/Cli/Monad.hs +++ b/unison-cli/src/Unison/Cli/Monad.hs @@ -431,15 +431,21 @@ respondNumbered output = do setNumberedArgs args -- | Perform a Cli action with access to a console region, which is closed upon completion. +-- +-- (In transcripts, this just outputs messages as normal). withRespondRegion :: ((Output -> Cli ()) -> Cli a) -> Cli a -withRespondRegion action = - with_ Console.Regions.displayConsoleRegions do - with (Console.Regions.withConsoleRegion Console.Regions.Linear) \region -> - action \output -> - liftIO do - string <- (OutputMessages.notifyUser "." output) - width <- PrettyTerminal.getAvailableWidth - Console.Regions.setConsoleRegion region (Pretty.toANSI width (Pretty.border 2 string)) +withRespondRegion action = do + env <- ask + case env.isTranscriptTest of + False -> + with_ Console.Regions.displayConsoleRegions do + with (Console.Regions.withConsoleRegion Console.Regions.Linear) \region -> + action \output -> + liftIO do + string <- (OutputMessages.notifyUser "." output) + width <- PrettyTerminal.getAvailableWidth + Console.Regions.setConsoleRegion region (Pretty.toANSI width (Pretty.border 2 string)) + True -> action respond -- | Updates the numbered args, but only if the new args are non-empty. setNumberedArgs :: NumberedArgs -> Cli () diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 621791b85b..7f585cb329 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -26,7 +26,6 @@ import U.Codebase.Branch.Diff qualified as V2Branch.Diff import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash (..)) import U.Codebase.Reflog qualified as Reflog -import U.Codebase.Sqlite.Queries qualified as Queries import Unison.ABT qualified as ABT import Unison.Builtin qualified as Builtin import Unison.Builtin.Terms qualified as Builtin diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs index 884451576c..b2124c7628 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/EditDependents.hs @@ -65,6 +65,20 @@ handleEditDependents name = do (Branch.deepTermReferenceIds branchWithoutLibdeps <> Branch.deepTypeReferenceIds branchWithoutLibdeps) (bifold refs) + let refsAndDependents = + Defns + { terms = + Set.unions + [ Set.mapMonotonic Referent.fromTermReference refs.terms, + Set.mapMonotonic Referent.fromTermReferenceId dependents.terms + ], + types = + Set.unions + [ refs.types, + Set.mapMonotonic Reference.fromId dependents.types + ] + } + respondRegion (Output.Literal "Loading dependents...") env <- ask (types, terms) <- @@ -76,12 +90,12 @@ handleEditDependents name = do { terms = branchWithoutLibdeps & Branch.deepTerms - & Relation.restrictDom (Set.mapMonotonic Referent.fromTermReferenceId dependents.terms) + & Relation.restrictDom refsAndDependents.terms & Relation.swap, types = branchWithoutLibdeps & Branch.deepTypes - & Relation.restrictDom (Set.mapMonotonic Reference.fromId dependents.types) + & Relation.restrictDom refsAndDependents.types & Relation.swap } ) diff --git a/unison-src/transcripts/edit-dependents-command.md b/unison-src/transcripts/edit-dependents-command.md new file mode 100644 index 0000000000..1ffe0f04c7 --- /dev/null +++ b/unison-src/transcripts/edit-dependents-command.md @@ -0,0 +1,35 @@ +# `edit.dependents` + +The `edit.dependents` command is like `edit`, but it adds a definition and all of its transitive dependents to the file +(being careful not to add anything that's already there). + +``` ucm :hide +scratch/main> builtins.mergeio lib.builtin +``` + +``` unison +type Foo = Foo Nat Nat +type Bar = { bar : Foo } + +baz : Bar -> Bar +baz x = x +``` + +``` ucm +scratch/main> add +``` + +Let's populate our scratch file with `Bar` (and its auto-generated accessors), then `edit.dependents` its dependency +`Foo`, which should add `Foo` and `baz`. + +``` unison +type Bar = { bar : Nat } +``` + +``` ucm +scratch/main> edit.dependents Foo +``` + +``` ucm :hide +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/edit-dependents-command.output.md b/unison-src/transcripts/edit-dependents-command.output.md new file mode 100644 index 0000000000..0a574359eb --- /dev/null +++ b/unison-src/transcripts/edit-dependents-command.output.md @@ -0,0 +1,92 @@ +# `edit.dependents` + +The `edit.dependents` command is like `edit`, but it adds a definition and all of its transitive dependents to the file +(being careful not to add anything that's already there). + +``` unison +type Foo = Foo Nat Nat +type Bar = { bar : Foo } + +baz : Bar -> Bar +baz x = x +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These new definitions are ok to `add`: + + type Bar + type Foo + Bar.bar : Bar -> Foo + Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar + Bar.bar.set : Foo -> Bar -> Bar + baz : Bar -> Bar + +``` +``` ucm +scratch/main> add + + ⍟ I've added these definitions: + + type Bar + type Foo + Bar.bar : Bar -> Foo + Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar + Bar.bar.set : Foo -> Bar -> Bar + baz : Bar -> Bar + +``` +Let's populate our scratch file with `Bar` (and its auto-generated accessors), then `edit.dependents` its dependency +`Foo`, which should add `Foo` and `baz`. + +``` unison +type Bar = { bar : Nat } +``` + +``` ucm + + Loading changes detected in scratch.u. + + I found and typechecked these definitions in scratch.u. If you + do an `add` or `update`, here's how your codebase would + change: + + ⍟ These names already exist. You can `update` them to your + new definition: + + type Bar + Bar.bar : Bar -> Nat + Bar.bar.modify : (Nat ->{g} Nat) -> Bar ->{g} Bar + Bar.bar.set : Nat -> Bar -> Bar + +``` +``` ucm +scratch/main> edit.dependents Foo + + Loading branch... + + Identifying dependents... + + Loading dependents... + + ☝️ + + I added 2 definitions to the top of scratch.u + + You can edit them there, then run `update` to replace the + definitions currently in this namespace. + +``` +``` unison :added-by-ucm scratch.u +type Foo = Foo Nat Nat + +baz : Bar -> Bar +baz x = x +``` + diff --git a/unison-src/transcripts/fix-5326.output.md b/unison-src/transcripts/fix-5326.output.md index bdddcbb6f0..76aaefaeaa 100644 --- a/unison-src/transcripts/fix-5326.output.md +++ b/unison-src/transcripts/fix-5326.output.md @@ -196,6 +196,18 @@ D - C - B - A ``` ucm scratch/main> merge /foo + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/foo into scratch/main. ``` diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 510fe617cc..6b57971d95 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -278,6 +278,9 @@ scratch/main> help `edit foo` prepends the definition of `foo` to the top of the most recently saved file. `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. + edit.dependents + Like `edit`, but also includes all transitive dependents in the current project. + edit.namespace `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces. diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 53c8c73dbd..40af4e3f07 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -48,6 +48,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar @@ -85,6 +97,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar @@ -132,6 +156,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar @@ -199,6 +235,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar baz @@ -273,6 +321,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar baz @@ -326,6 +386,18 @@ Merge result: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo @@ -371,6 +443,18 @@ Merge result: ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. scratch/alice> view foo bar baz @@ -553,6 +637,18 @@ scratch/bob> add scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -608,6 +704,18 @@ bar = foo ++ " - " ++ foo ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -674,6 +782,16 @@ baz = "bobs baz" ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -745,6 +863,16 @@ unique type Foo = MkFoo Nat Text ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -798,6 +926,16 @@ scratch/bob> move.term Foo.Qux Foo.BobQux ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -853,6 +991,16 @@ scratch/bob> move.term Foo.Qux Foo.Bob ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -900,6 +1048,16 @@ unique ability my.cool where ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -961,6 +1119,16 @@ These won't cleanly merge. ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1034,6 +1202,16 @@ Notably, Alice's "unconflicted" update on the name "Foo.Bar.Baz" (because she ch ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1094,6 +1272,16 @@ bob _ = 19 ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1162,6 +1350,16 @@ Attempt to merge: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -1294,6 +1492,10 @@ baz = "baz" ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + Sorry, I wasn't able to perform the merge: On the merge ancestor, bar and foo were aliases for the same @@ -1336,6 +1538,10 @@ unique type MyNat = MyNat Nat ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + Sorry, I wasn't able to perform the merge: There's a merge conflict on type MyNat, but it's a builtin on @@ -1373,6 +1579,10 @@ bob = 100 ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + Sorry, I wasn't able to perform the merge: On scratch/alice, the type Foo has a constructor with multiple @@ -1411,6 +1621,10 @@ bob = 100 ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + Sorry, I wasn't able to perform the merge: On scratch/alice, the type Foo has some constructors with @@ -1450,6 +1664,10 @@ bob = 100 ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + On scratch/alice, the type A.inner.X is an alias of A. I'm not able to perform a merge when a type exists nested under an alias of itself. Please separate them or delete one copy, and @@ -1487,6 +1705,10 @@ scratch/bob> add ``` ucm scratch/alice> merge bob + Loading branches... + + Computing diff between branches... + Sorry, I wasn't able to perform the merge, because I need all constructor names to be nested somewhere beneath the corresponding type name. @@ -1518,6 +1740,8 @@ bob = 100 ``` ucm scratch/alice> merge /bob + Loading branches... + Sorry, I wasn't able to perform the merge: On scratch/alice, there's a type or term at the top level of @@ -1660,6 +1884,18 @@ Now we merge: ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. ``` @@ -1768,6 +2004,18 @@ scratch/bob> add ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. ``` @@ -1860,6 +2108,18 @@ scratch/main> update ``` ucm scratch/main> merge topic + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/topic into scratch/main. scratch/main> view Foo @@ -1990,6 +2250,16 @@ the underlying namespace. ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -2153,10 +2423,34 @@ scratch/carol> add scratch/bob> merge /alice + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/alice into scratch/bob. scratch/carol> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/carol. scratch/carol> history @@ -2294,6 +2588,18 @@ scratch/alice> update ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + + Typechecking Unison file... + I merged scratch/bob into scratch/alice. ``` @@ -2355,6 +2661,16 @@ scratch/bob> move.term Foo.Lca Foo.Bob ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. @@ -2539,6 +2855,16 @@ Note Bob's `hello` references `foo` (Alice's name), not `bar` (Bob's name). ``` ucm scratch/alice> merge /bob + Loading branches... + + Computing diff between branches... + + Loading dependents of changes... + + Loading and merging library dependencies... + + Rendering Unison file... + I couldn't automatically merge scratch/bob into scratch/alice. However, I've added the definitions that need attention to the top of scratch.u. From 6c2a6e90f9d0a6c8bee20d142bd571d675d8e6a1 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Mon, 2 Dec 2024 13:33:20 -0500 Subject: [PATCH 5/5] run transcripts --- .../transcripts/edit-dependents-command.md | 35 ------------------- .../edit-dependents-command.md} | 31 +++++++++------- unison-src/transcripts/idempotent/help.md | 3 ++ 3 files changed, 21 insertions(+), 48 deletions(-) delete mode 100644 unison-src/transcripts/edit-dependents-command.md rename unison-src/transcripts/{edit-dependents-command.output.md => idempotent/edit-dependents-command.md} (92%) diff --git a/unison-src/transcripts/edit-dependents-command.md b/unison-src/transcripts/edit-dependents-command.md deleted file mode 100644 index 1ffe0f04c7..0000000000 --- a/unison-src/transcripts/edit-dependents-command.md +++ /dev/null @@ -1,35 +0,0 @@ -# `edit.dependents` - -The `edit.dependents` command is like `edit`, but it adds a definition and all of its transitive dependents to the file -(being careful not to add anything that's already there). - -``` ucm :hide -scratch/main> builtins.mergeio lib.builtin -``` - -``` unison -type Foo = Foo Nat Nat -type Bar = { bar : Foo } - -baz : Bar -> Bar -baz x = x -``` - -``` ucm -scratch/main> add -``` - -Let's populate our scratch file with `Bar` (and its auto-generated accessors), then `edit.dependents` its dependency -`Foo`, which should add `Foo` and `baz`. - -``` unison -type Bar = { bar : Nat } -``` - -``` ucm -scratch/main> edit.dependents Foo -``` - -``` ucm :hide -scratch/main> project.delete scratch -``` diff --git a/unison-src/transcripts/edit-dependents-command.output.md b/unison-src/transcripts/idempotent/edit-dependents-command.md similarity index 92% rename from unison-src/transcripts/edit-dependents-command.output.md rename to unison-src/transcripts/idempotent/edit-dependents-command.md index 0a574359eb..736197fb19 100644 --- a/unison-src/transcripts/edit-dependents-command.output.md +++ b/unison-src/transcripts/idempotent/edit-dependents-command.md @@ -3,6 +3,10 @@ The `edit.dependents` command is like `edit`, but it adds a definition and all of its transitive dependents to the file (being careful not to add anything that's already there). +``` ucm :hide +scratch/main> builtins.mergeio lib.builtin +``` + ``` unison type Foo = Foo Nat Nat type Bar = { bar : Foo } @@ -11,14 +15,13 @@ baz : Bar -> Bar baz x = x ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These new definitions are ok to `add`: type Bar @@ -27,21 +30,21 @@ baz x = x Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar Bar.bar.set : Foo -> Bar -> Bar baz : Bar -> Bar - ``` + ``` ucm scratch/main> add ⍟ I've added these definitions: - + type Bar type Foo Bar.bar : Bar -> Foo Bar.bar.modify : (Foo ->{g} Foo) -> Bar ->{g} Bar Bar.bar.set : Foo -> Bar -> Bar baz : Bar -> Bar - ``` + Let's populate our scratch file with `Bar` (and its auto-generated accessors), then `edit.dependents` its dependency `Foo`, which should add `Foo` and `baz`. @@ -49,14 +52,13 @@ Let's populate our scratch file with `Bar` (and its auto-generated accessors), t type Bar = { bar : Nat } ``` -``` ucm - +``` ucm :added-by-ucm Loading changes detected in scratch.u. I found and typechecked these definitions in scratch.u. If you do an `add` or `update`, here's how your codebase would change: - + ⍟ These names already exist. You can `update` them to your new definition: @@ -64,8 +66,8 @@ type Bar = { bar : Nat } Bar.bar : Bar -> Nat Bar.bar.modify : (Nat ->{g} Nat) -> Bar ->{g} Bar Bar.bar.set : Nat -> Bar -> Bar - ``` + ``` ucm scratch/main> edit.dependents Foo @@ -76,13 +78,13 @@ scratch/main> edit.dependents Foo Loading dependents... ☝️ - + I added 2 definitions to the top of scratch.u - + You can edit them there, then run `update` to replace the definitions currently in this namespace. - ``` + ``` unison :added-by-ucm scratch.u type Foo = Foo Nat Nat @@ -90,3 +92,6 @@ baz : Bar -> Bar baz x = x ``` +``` ucm :hide +scratch/main> project.delete scratch +``` diff --git a/unison-src/transcripts/idempotent/help.md b/unison-src/transcripts/idempotent/help.md index 3e69e4999e..7dc5975ed0 100644 --- a/unison-src/transcripts/idempotent/help.md +++ b/unison-src/transcripts/idempotent/help.md @@ -278,6 +278,9 @@ scratch/main> help `edit foo` prepends the definition of `foo` to the top of the most recently saved file. `edit` without arguments invokes a search to select a definition for editing, which requires that `fzf` can be found within your PATH. + edit.dependents + Like `edit`, but also includes all transitive dependents in the current project. + edit.namespace `edit.namespace` will load all terms and types contained within the current namespace into your scratch file. This includes definitions in namespaces, but excludes libraries. `edit.namespace ns1 ns2 ...` loads the terms and types contained within the provided namespaces.