From 87346da5bef8f3d427408fd8158f5907fff46133 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Fri, 14 Nov 2025 10:17:17 -0500 Subject: [PATCH 1/2] first cut at dependents of file symbol --- parser-typechecker/src/Unison/Codebase.hs | 21 +- .../src/Unison/UnisonFile/Names.hs | 2 +- .../Editor/HandleInput/Dependencies.hs | 21 +- .../Codebase/Editor/HandleInput/Dependents.hs | 277 ++++++++++++++++-- .../src/Unison/Codebase/Editor/Output.hs | 10 +- .../src/Unison/CommandLine/OutputMessages.hs | 42 ++- unison-core/src/Unison/NamesUtils.hs | 25 +- 7 files changed, 327 insertions(+), 71 deletions(-) diff --git a/parser-typechecker/src/Unison/Codebase.hs b/parser-typechecker/src/Unison/Codebase.hs index 9998e302c0..a34ec3386b 100644 --- a/parser-typechecker/src/Unison/Codebase.hs +++ b/parser-typechecker/src/Unison/Codebase.hs @@ -130,7 +130,6 @@ import Control.Monad.Except (ExceptT) import Data.Map qualified as Map import Data.Set qualified as Set import Data.Text qualified as Text -import Data.These (These (..)) import U.Codebase.Branch qualified as V2Branch import U.Codebase.Causal qualified as V2Causal import U.Codebase.HashTags (CausalHash) @@ -159,6 +158,7 @@ import Unison.DataDeclaration qualified as DD import Unison.Hash (Hash) import Unison.Hashing.V2.Convert qualified as Hashing import Unison.LabeledDependency qualified as LD +import Unison.NamesUtils qualified as NamesUtils import Unison.Parser.Ann (Ann) import Unison.Parser.Ann qualified as Parser import Unison.Prelude @@ -535,7 +535,7 @@ dependentsWithinBranchScope :: DefnsF Set Referent TypeReference -> Sqlite.Transaction (DefnsF Set TermReferenceId Reference.TypeReferenceId) dependentsWithinBranchScope branch0 refs = do - Operations.directDependentsWithinScope (Branch.deepDefnsIds branch0) (defnsToRefs refs) + Operations.directDependentsWithinScope (Branch.deepDefnsIds branch0) (NamesUtils.referentsToRefs refs) directDependencies :: DefnsF Set Referent TypeReference -> @@ -543,23 +543,6 @@ directDependencies :: directDependencies refs = do Operations.directDependenciesOfScope Builtin.isBuiltinType (defnsToRefsIds refs) -defnsToRefs :: DefnsF Set Referent TypeReference -> DefnsF Set TermReference TypeReference -defnsToRefs defns = - Defns - { terms = termRefs, - types = Set.union constructorRefs defns.types - } - where - termRefs :: Set TermReference - constructorRefs :: Set TypeReference - (termRefs, constructorRefs) = - Set.unalignWith - ( \case - Referent.Con (ConstructorReference ref _) _ -> That ref - Referent.Ref ref -> This ref - ) - defns.terms - defnsToRefsIds :: DefnsF Set Referent TypeReference -> DefnsF Set TermReferenceId TypeReferenceId defnsToRefsIds defns = Defns diff --git a/parser-typechecker/src/Unison/UnisonFile/Names.hs b/parser-typechecker/src/Unison/UnisonFile/Names.hs index c6ead705a1..9e1efe0d64 100644 --- a/parser-typechecker/src/Unison/UnisonFile/Names.hs +++ b/parser-typechecker/src/Unison/UnisonFile/Names.hs @@ -54,7 +54,7 @@ typecheckedToNames uf = Names (terms <> ctors) types Relation.fromList [ (Name.unsafeParseVar v, Referent.Ref r) | (v, (_a, r, wk, _, _)) <- Map.toList $ UF.hashTerms uf, - wk == Nothing || wk == Just WK.TestWatch + WK.watchKindShouldBeStoredInDatabase wk ] types = Relation.fromList diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependencies.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependencies.hs index a543d0e924..55971d4593 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependencies.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependencies.hs @@ -4,7 +4,7 @@ module Unison.Codebase.Editor.HandleInput.Dependencies where import Control.Arrow ((***)) -import Data.Bifoldable (bifoldMap, binull) +import Data.Bifoldable (binull) import Data.Set qualified as Set import Unison.Cli.Monad (Cli) import Unison.Cli.Monad qualified as Cli @@ -16,7 +16,6 @@ import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA 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.Prelude @@ -25,13 +24,13 @@ import Unison.PrettyPrintEnv.Names qualified as PPE import Unison.Reference (Reference) import Unison.Referent qualified as Referent import Unison.Syntax.HashQualifiedPrime qualified as HQ' -import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) handleDependencies :: HQ.HashQualified Name -> Cli () handleDependencies hq = do - refs <- resolveHQName hq + dependentsRefs <- resolveHQName hq - when (binull refs) do + when (binull dependentsRefs) do Cli.returnEarly (LabeledReferenceNotFound hq) namespace <- Cli.getCurrentProjectRoot0 @@ -40,7 +39,7 @@ handleDependencies hq = do in PPE.makePPE (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) dependencies <- do - Cli.runTransaction $ Codebase.directDependencies refs + Cli.runTransaction $ Codebase.directDependencies dependentsRefs let dependencyNames :: DefnsF @@ -82,5 +81,11 @@ handleDependencies hq = do & map (SA.HashQualified . fst) & Cli.setNumberedArgs - let lds = bifoldMap (Set.map LD.referent) (Set.map LD.typeRef) refs - Cli.respond (ListDependencies ppe lds dependencyNames) + let dependentsNames :: DefnsF2 Set HQ.HashQualified Name Name + dependentsNames = + bimap + (Set.map (PPE.termNameOrHashOnly ppe)) + (Set.map (PPE.typeNameOrHashOnly ppe)) + dependentsRefs + + Cli.respond (ListDependencies dependentsNames dependencyNames) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs index 7484ea368b..3690019cff 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs @@ -3,8 +3,14 @@ module Unison.Codebase.Editor.HandleInput.Dependents ) where +import Control.Lens (review) import Data.Bifoldable (bifoldMap, binull) +import Data.Map.Strict qualified as Map import Data.Set qualified as Set +import Data.Set.NonEmpty (NESet) +import Data.Set.NonEmpty qualified as Set.NonEmpty +import Data.These (These (..)) +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 @@ -14,32 +20,63 @@ import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA +import Unison.ConstructorReference (ConstructorReferenceId, GConstructorReference (..)) +import Unison.DataDeclaration (Decl) +import Unison.DataDeclaration qualified as DataDeclaration 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.Names (Names (..)) +import Unison.NamesUtils qualified as NamesUtils +import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.Reference (TermReference, TermReferenceId, TypeReference, TypeReferenceId) import Unison.Reference qualified as Reference +import Unison.Referent (Referent) import Unison.Referent qualified as Referent +import Unison.ReferentPrime qualified as Referent' +import Unison.Symbol (Symbol) import Unison.Syntax.HashQualifiedPrime qualified as HQ' -import Unison.Util.Defns (Defns (..), DefnsF) +import Unison.Syntax.Name qualified as Name +import Unison.Term qualified as Term +import Unison.Type qualified as Type +import Unison.UnisonFile qualified as UnisonFile +import Unison.UnisonFile.Names qualified as UnisonFile +import Unison.Util.Defn (Defn (..)) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) +import Unison.Util.Map qualified as Map +import Unison.Util.Relation (Relation) +import Unison.Util.Relation qualified as Relation +import Unison.Util.Set qualified as Set +import Unison.WatchKind qualified as WatchKind handleDependents :: HQ.HashQualified Name -> Cli () handleDependents hq = do - refs <- resolveHQName hq + codebaseRefs <- resolveHQName hq - when (binull refs) do - Cli.returnEarly (LabeledReferenceNotFound hq) + -- If the given name doesn't match anything in the codebase, then as a fallback, we look at the latest Unison file to + -- report dependents. This covers the common case that something (and all of its dependents) were removed from the + -- underlying namespace and placed in a file, e.g. when resolving a failed update. + if binull codebaseRefs + then handleFileDependents hq + else handleCodebaseDependents codebaseRefs +handleCodebaseDependents :: DefnsF Set Referent TypeReference -> Cli () +handleCodebaseDependents dependenciesRefs = do namespace <- Cli.getCurrentProjectRoot0 - let namespaceWithoutLibdeps = Branch.deleteLibdeps namespace - let ppeWithoutLibdeps = - let names = Branch.toNames namespaceWithoutLibdeps + let ppe = + let names = Branch.toNames (Branch.deleteLibdeps namespace) in PPE.makePPE (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) - dependents <- Cli.runTransaction $ Codebase.dependentsWithinBranchScope namespaceWithoutLibdeps refs + + dependents <- + Cli.runTransaction do + Operations.directDependentsWithinScope + (Branch.deepDefnsIds namespace) + (NamesUtils.referentsToRefs dependenciesRefs) let dependentNames :: DefnsF @@ -47,24 +84,224 @@ handleDependents hq = do (HQ'.HashQualified Name, HQ'.HashQualified Name) (HQ'.HashQualified Name, HQ'.HashQualified Name) dependentNames = - bimap - (f (Referent.fromTermReferenceId >>> PPE.termNames ppeWithoutLibdeps)) - (f (Reference.fromId >>> PPE.typeNames ppeWithoutLibdeps)) - dependents - where - f g = - Set.toList - >>> mapMaybe (g >>> listToMaybe) - >>> Name.sortByText (fst >>> HQ'.toText) + nameDependents ppe dependents + -- Set numbered args (dependentNames.types ++ dependentNames.terms) & map (SA.HashQualified . HQ'.toHQ . fst) & Cli.setNumberedArgs - let lds = bifoldMap (Set.map LD.referent) (Set.map LD.typeRef) refs - let ppe = let names = Branch.toNames namespace in PPE.makePPE (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) - Cli.respond (ListDependents ppe lds dependentNames) + Cli.respond (ListDependents (nameDependencies ppe dependenciesRefs) dependentNames) + +handleFileDependents :: HQ.HashQualified Name -> Cli () +handleFileDependents hq = do + -- If searching with a hash, don't bother looking in the file. + name <- + case hq of + HQ.NameOnly name -> pure name + _ -> notFound + + -- Require a latest typechecked file to search. + unisonFile <- + Cli.getLatestTypecheckedFile & onNothingM do + notFound + + let fileConstructors :: Map Symbol (ConstructorReferenceId, Decl Symbol Ann) + fileConstructors = + UnisonFile.constructorsId unisonFile + + let fileTermReferences :: Relation Name Referent.Id + fileTermReferences = + Relation.empty + & addRefs + & addCons + where + addRefs :: Relation Name Referent.Id -> Relation Name Referent.Id + addRefs acc = + Map.foldlWithKey' f acc unisonFile.hashTermsId + where + f acc var (_, ref, _, _, _) = + Relation.insert + (Name.unsafeParseVar var) + (review Referent'.termReference_ ref) + acc + + addCons :: Relation Name Referent.Id -> Relation Name Referent.Id + addCons acc = + Map.foldlWithKey' f acc fileConstructors + where + f :: + Relation Name Referent.Id -> + Symbol -> + (ConstructorReferenceId, Decl Symbol Ann) -> + Relation Name Referent.Id + f acc var (ref, decl) = + Relation.insert + (Name.unsafeParseVar var) + (Referent'.Con' ref (DataDeclaration.constructorType decl)) + acc + + let fileTypeReferences :: Relation Name TypeReferenceId + fileTypeReferences = + Relation.empty + & g unisonFile.dataDeclarationsId' + & g unisonFile.effectDeclarationsId' + where + g :: Map Symbol (TypeReferenceId, decl) -> Relation Name TypeReferenceId -> Relation Name TypeReferenceId + g decls acc = + Map.foldlWithKey' f acc decls + + f :: Relation Name TypeReferenceId -> Symbol -> (TypeReferenceId, decl) -> Relation Name TypeReferenceId + f acc var (ref, _) = + Relation.insert (Name.unsafeParseVar var) ref acc + + -- Search the file for dependencies that match the given name. + let dependenciesRefs :: DefnsF Set Referent.Id TypeReferenceId + dependenciesRefs = + Defns + { terms = Name.searchByRankedSuffix name fileTermReferences, + types = Name.searchByRankedSuffix name fileTypeReferences + } + + when (binull dependenciesRefs) do + notFound + + let dependenciesRefs1 :: DefnsF Set TermReferenceId TypeReferenceId + dependenciesRefs1 = + NamesUtils.referentsToRefs dependenciesRefs + + let termDependents :: Map TermReferenceId (NESet TermReferenceId) + typeTermDependents :: Map TypeReferenceId (NESet TermReferenceId) + (termDependents, typeTermDependents) = + Map.foldl' f (Map.empty, Map.empty) unisonFile.hashTermsId + where + f (accTerms, accTypes) (_, x, wk, term, _) + | WatchKind.watchKindShouldBeStoredInDatabase wk = + ( Set.foldl' dependsOnTerm accTerms dependencies.terms, + Set.foldl' dependsOnType accTypes dependencies.types + ) + | otherwise = (accTerms, accTypes) + where + dependencies :: DefnsF Set TermReference TypeReference + dependencies = + Term.dependencies term + + -- If `term x` depends on `term y`, and `term y` is in the set of things we want to report dependents of, + -- then record `term y` => {`term x`} in our term dependents map. + dependsOnTerm acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member (Referent'.Ref' y') dependenciesRefs.terms) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + + -- If `term x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, + -- then record `type y` => {`term x`} in our type dependents map. + dependsOnType acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member y' dependenciesRefs.types) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + + let typeTypeDependents :: Map TypeReferenceId (NESet TypeReferenceId) + typeTypeDependents = + Map.foldl' g (Map.foldl' f Map.empty unisonFile.dataDeclarationsId') unisonFile.effectDeclarationsId' + where + f acc (x, dataDecl) = + Set.foldl (h2 x) acc (DataDeclaration.typeDependencies dataDecl) + + g acc (x, effectDecl) = + f acc (x, DataDeclaration.toDataDecl effectDecl) + + -- If `type x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, + -- either directly or because we want to report dependents of one of its constructors, then record + -- `type y` => {`type x`} in our type dependents map. + h2 :: + TypeReferenceId -> + Map TypeReferenceId (NESet TypeReferenceId) -> + TypeReference -> + Map TypeReferenceId (NESet TypeReferenceId) + h2 x acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member y' dependenciesRefs1.types) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + + namespace <- Cli.getCurrentProjectRoot0 + let ppe = + let names = + namespace + & Branch.deleteLibdeps + & Branch.toNames + & UnisonFile.addNamesFromTypeCheckedUnisonFile unisonFile + in PPE.makePPE (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + + let dependents :: DefnsF Set TermReferenceId TypeReferenceId + dependents = + let f deps ref = + maybe Set.empty Set.NonEmpty.toSet (Map.lookup ref deps) + in Defns + { terms = + Set.union + (foldMap (f termDependents) dependenciesRefs1.terms) + (foldMap (f typeTermDependents) dependenciesRefs1.types), + types = foldMap (f typeTypeDependents) dependenciesRefs1.types + } + + let dependentNames :: + DefnsF + [] + (HQ'.HashQualified Name, HQ'.HashQualified Name) + (HQ'.HashQualified Name, HQ'.HashQualified Name) + dependentNames = + nameDependents ppe dependents + + -- Set numbered args + (dependentNames.types ++ dependentNames.terms) + & map (SA.HashQualified . HQ'.toHQ . fst) + & Cli.setNumberedArgs + + Cli.respond $ + ListDependents + ( nameDependencies + ppe + ( bimap + (Set.map Referent.fromId) + (Set.map Reference.fromId) + dependenciesRefs + ) + ) + dependentNames + where + notFound :: Cli a + notFound = + Cli.returnEarly (LabeledReferenceNotFound hq) + +nameDependencies :: + PPE.PrettyPrintEnv -> + DefnsF Set Referent TypeReference -> + DefnsF2 Set HQ.HashQualified Name Name +nameDependencies ppe = + bimap + (Set.map (PPE.termNameOrHashOnly ppe)) + (Set.map (PPE.typeNameOrHashOnly ppe)) + +nameDependents :: + PPE.PrettyPrintEnv -> + DefnsF Set TermReferenceId TypeReferenceId -> + DefnsF + [] + (HQ'.HashQualified Name, HQ'.HashQualified Name) + (HQ'.HashQualified Name, HQ'.HashQualified Name) +nameDependents ppe = + bimap + (f (Referent.fromTermReferenceId >>> PPE.termNames ppe)) + (f (Reference.fromId >>> PPE.typeNames ppe)) + where + f g = + Set.toList + >>> mapMaybe (g >>> listToMaybe) + >>> Name.sortByText (fst >>> HQ'.toText) diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 55bb9f9ab6..2d2eca6016 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -94,7 +94,7 @@ import Unison.Type (Type) import Unison.Typechecker.Context qualified as Context import Unison.Util.Conflicted (Conflicted) import Unison.Util.Defn (Defn) -import Unison.Util.Defns (Defns, DefnsF, defnsAreEmpty) +import Unison.Util.Defns (Defns, DefnsF, DefnsF2, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK @@ -322,17 +322,15 @@ data Output | NoBranchWithHash ShortCausalHash | -- | List direct dependencies of a type or term. ListDependencies - PPE.PrettyPrintEnv - (Set LabeledDependency) + (DefnsF2 Set HQ.HashQualified Name Name) ( DefnsF [] (HQ.HashQualified Name, HQ.HashQualified Name) (HQ.HashQualified Name, HQ.HashQualified Name) ) - | -- | List dependents of a type or term. + | -- | List direct dependents of a type or term. ListDependents - PPE.PrettyPrintEnv - (Set LabeledDependency) + (DefnsF2 Set HQ.HashQualified Name Name) ( DefnsF [] (HQ'.HashQualified Name, HQ'.HashQualified Name) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 61b6bc4f2b..56ddd72a49 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -159,7 +159,7 @@ import Unison.Typed (Typed (..)) import Unison.Util.Alphabetical (sortAlphabetically, sortAlphabeticallyOn) import Unison.Util.Conflicted (Conflicted (..)) import Unison.Util.Defn (Defn (..)) -import Unison.Util.Defns (Defns (..)) +import Unison.Util.Defns (Defns (..), DefnsF2) import Unison.Util.List qualified as List import Unison.Util.Monoid (intercalateMap) import Unison.Util.Monoid qualified as Monoid @@ -1501,24 +1501,22 @@ notifyUser dir issueFn = \case "", "Paste that output into http://bit-booster.com/graph.html" ] - ListDependents ppe lds defns -> + ListDependents dependencies dependents -> pure $ listDependentsOrDependencies - ppe "Dependents" "dependents" - lds - (map (HQ'.toHQ *** HQ'.toHQ) defns.types) - (map (HQ'.toHQ *** HQ'.toHQ) defns.terms) - ListDependencies ppe lds defns -> + dependencies + (map (HQ'.toHQ *** HQ'.toHQ) dependents.types) + (map (HQ'.toHQ *** HQ'.toHQ) dependents.terms) + ListDependencies dependents dependencies -> pure $ listDependentsOrDependencies - ppe "Dependencies" "dependencies" - lds - defns.types - defns.terms + dependents + dependencies.types + dependencies.terms ListStructuredFind terms -> pure $ listFind False Nothing terms ListTextFind True terms -> @@ -4103,21 +4101,33 @@ listFind allowLib _ tms = <> " to bring these into your scratch file." listDependentsOrDependencies :: - PPE.PrettyPrintEnv -> Text -> Text -> - Set LabeledDependency -> + DefnsF2 Set HQ.HashQualified Name Name -> [(HQ.HashQualified Name, HQ.HashQualified Name)] -> [(HQ.HashQualified Name, HQ.HashQualified Name)] -> Pretty -listDependentsOrDependencies ppe labelStart label lds types terms = +listDependentsOrDependencies labelStart label targets types terms = if null types && null terms - then prettyLabeledDependencies ppe lds <> " has no " <> P.text label <> "." + then + P.wrap $ + prettyTargets + <> ( if Set.size targets.terms + Set.size targets.types == 1 + then "has" + else "have" + ) + <> "no" + <> P.group (P.text label <> ".") else P.sepNonEmpty "\n\n" [hdr, typesOut, termsOut, tip msg] where + prettyTargets = + P.syntaxToColor $ + P.sep ", " $ + map (\name -> "type " <> prettyHashQualified name) (Set.toList targets.types) + ++ map prettyHashQualified (Set.toList targets.terms) msg = "Try " <> IP.makeExample IP.view args <> " to see the source of any numbered item in the above list." args = [P.shown (length types + length terms)] - hdr = P.text labelStart <> " of: " <> prettyLabeledDependencies ppe lds + hdr = P.text labelStart <> " of: " <> prettyTargets typesOut = if null types then mempty diff --git a/unison-core/src/Unison/NamesUtils.hs b/unison-core/src/Unison/NamesUtils.hs index d94de84bfd..e1f6a4dada 100644 --- a/unison-core/src/Unison/NamesUtils.hs +++ b/unison-core/src/Unison/NamesUtils.hs @@ -3,6 +3,7 @@ module Unison.NamesUtils ( byName, forgetNames, referentsToIds, + referentsToRefs, restrictNames, ) where @@ -14,6 +15,8 @@ import Unison.Reference (Reference' (..), TermReferenceId, TypeReference, TypeRe import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent +import Unison.ReferentPrime (Referent') +import Unison.ReferentPrime qualified as Referent' import Unison.Util.BiMultimap (BiMultimap) import Unison.Util.BiMultimap qualified as BiMultimap import Unison.Util.Defns (Defns (..), DefnsF, zipDefnsWith) @@ -39,7 +42,7 @@ restrictNames = referentsToIds :: DefnsF Set Referent TypeReference -> DefnsF Set TermReferenceId TypeReferenceId referentsToIds defns = - fromTerms <> Defns.fromTypes (Set.mapMaybe Reference.toId defns.types) + fromTerms <> fromTypes where fromTerms = Set.foldl' @@ -52,3 +55,23 @@ referentsToIds defns = ) (Defns Set.empty Set.empty) defns.terms + + fromTypes = + Defns.fromTypes (Set.mapMaybe Reference.toId defns.types) + +referentsToRefs :: (Ord r) => DefnsF Set (Referent' r) r -> DefnsF Set r r +referentsToRefs defns = + fromTerms <> fromTypes + where + fromTerms = + Set.foldl' + ( \acc -> \case + Referent'.Ref' ref -> let !terms = Set.insert ref acc.terms in Defns terms acc.types + Referent'.Con' (ConstructorReference ref _) _ -> + let !types = Set.insert ref acc.types in Defns acc.terms types + ) + (Defns Set.empty Set.empty) + defns.terms + + fromTypes = + Defns.fromTypes defns.types From 5302fe9fde13b6a6f07c9973dda43fe568096f45 Mon Sep 17 00:00:00 2001 From: Mitchell Dalvi Rosen Date: Fri, 14 Nov 2025 13:48:22 -0500 Subject: [PATCH 2/2] refactoring and cleanup --- .../Codebase/Editor/HandleInput/Dependents.hs | 298 ++++++++++-------- unison-core/src/Unison/Name.hs | 25 +- 2 files changed, 183 insertions(+), 140 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs index 3690019cff..cbc5f4d04d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs @@ -4,33 +4,28 @@ module Unison.Codebase.Editor.HandleInput.Dependents where import Control.Lens (review) -import Data.Bifoldable (bifoldMap, binull) +import Data.Bifoldable (binull) import Data.Map.Strict qualified as Map import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) import Data.Set.NonEmpty qualified as Set.NonEmpty -import Data.These (These (..)) 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 qualified as Codebase import Unison.Codebase.Branch qualified as Branch import Unison.Codebase.Branch.Names qualified as Branch import Unison.Codebase.Editor.Output import Unison.Codebase.Editor.StructuredArgument qualified as SA -import Unison.ConstructorReference (ConstructorReferenceId, GConstructorReference (..)) -import Unison.DataDeclaration (Decl) +import Unison.ConstructorReference (ConstructorReferenceId) +import Unison.DataDeclaration (DataDeclaration, Decl, EffectDeclaration) import Unison.DataDeclaration qualified as DataDeclaration 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.Names (Names (..)) import Unison.NamesUtils qualified as NamesUtils -import Unison.Parser.Ann (Ann) import Unison.Prelude import Unison.PrettyPrintEnv qualified as PPE import Unison.PrettyPrintEnv.Names qualified as PPE @@ -39,19 +34,18 @@ import Unison.Reference qualified as Reference import Unison.Referent (Referent) import Unison.Referent qualified as Referent import Unison.ReferentPrime qualified as Referent' -import Unison.Symbol (Symbol) import Unison.Syntax.HashQualifiedPrime qualified as HQ' import Unison.Syntax.Name qualified as Name +import Unison.Term (Term) import Unison.Term qualified as Term -import Unison.Type qualified as Type +import Unison.Type (Type) +import Unison.UnisonFile (TypecheckedUnisonFile) import Unison.UnisonFile qualified as UnisonFile import Unison.UnisonFile.Names qualified as UnisonFile -import Unison.Util.Defn (Defn (..)) -import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2) +import Unison.Util.Defns (Defns (..), DefnsF, DefnsF2, defnsAreEmpty) import Unison.Util.Map qualified as Map -import Unison.Util.Relation (Relation) -import Unison.Util.Relation qualified as Relation -import Unison.Util.Set qualified as Set +import Unison.Var (Var) +import Unison.WatchKind (WatchKind) import Unison.WatchKind qualified as WatchKind handleDependents :: HQ.HashQualified Name -> Cli () @@ -61,7 +55,7 @@ handleDependents hq = do -- If the given name doesn't match anything in the codebase, then as a fallback, we look at the latest Unison file to -- report dependents. This covers the common case that something (and all of its dependents) were removed from the -- underlying namespace and placed in a file, e.g. when resolving a failed update. - if binull codebaseRefs + if defnsAreEmpty codebaseRefs then handleFileDependents hq else handleCodebaseDependents codebaseRefs @@ -110,62 +104,19 @@ handleFileDependents hq = do Cli.getLatestTypecheckedFile & onNothingM do notFound - let fileConstructors :: Map Symbol (ConstructorReferenceId, Decl Symbol Ann) - fileConstructors = - UnisonFile.constructorsId unisonFile - - let fileTermReferences :: Relation Name Referent.Id - fileTermReferences = - Relation.empty - & addRefs - & addCons - where - addRefs :: Relation Name Referent.Id -> Relation Name Referent.Id - addRefs acc = - Map.foldlWithKey' f acc unisonFile.hashTermsId - where - f acc var (_, ref, _, _, _) = - Relation.insert - (Name.unsafeParseVar var) - (review Referent'.termReference_ ref) - acc - - addCons :: Relation Name Referent.Id -> Relation Name Referent.Id - addCons acc = - Map.foldlWithKey' f acc fileConstructors - where - f :: - Relation Name Referent.Id -> - Symbol -> - (ConstructorReferenceId, Decl Symbol Ann) -> - Relation Name Referent.Id - f acc var (ref, decl) = - Relation.insert - (Name.unsafeParseVar var) - (Referent'.Con' ref (DataDeclaration.constructorType decl)) - acc - - let fileTypeReferences :: Relation Name TypeReferenceId - fileTypeReferences = - Relation.empty - & g unisonFile.dataDeclarationsId' - & g unisonFile.effectDeclarationsId' - where - g :: Map Symbol (TypeReferenceId, decl) -> Relation Name TypeReferenceId -> Relation Name TypeReferenceId - g decls acc = - Map.foldlWithKey' f acc decls - - f :: Relation Name TypeReferenceId -> Symbol -> (TypeReferenceId, decl) -> Relation Name TypeReferenceId - f acc var (ref, _) = - Relation.insert (Name.unsafeParseVar var) ref acc - -- Search the file for dependencies that match the given name. let dependenciesRefs :: DefnsF Set Referent.Id TypeReferenceId dependenciesRefs = - Defns - { terms = Name.searchByRankedSuffix name fileTermReferences, - types = Name.searchByRankedSuffix name fileTypeReferences - } + unisonFile + & fileToReferentsIds + & bimap search search + where + search :: (Ord ref) => Map Name ref -> Set ref + search defns = + Name.gsearchBySuffix + (maybe Set.empty Set.singleton . (`Map.lookup` defns)) + (\order -> Map.search (\_ -> Set.singleton) order defns) + name when (binull dependenciesRefs) do notFound @@ -174,62 +125,6 @@ handleFileDependents hq = do dependenciesRefs1 = NamesUtils.referentsToRefs dependenciesRefs - let termDependents :: Map TermReferenceId (NESet TermReferenceId) - typeTermDependents :: Map TypeReferenceId (NESet TermReferenceId) - (termDependents, typeTermDependents) = - Map.foldl' f (Map.empty, Map.empty) unisonFile.hashTermsId - where - f (accTerms, accTypes) (_, x, wk, term, _) - | WatchKind.watchKindShouldBeStoredInDatabase wk = - ( Set.foldl' dependsOnTerm accTerms dependencies.terms, - Set.foldl' dependsOnType accTypes dependencies.types - ) - | otherwise = (accTerms, accTypes) - where - dependencies :: DefnsF Set TermReference TypeReference - dependencies = - Term.dependencies term - - -- If `term x` depends on `term y`, and `term y` is in the set of things we want to report dependents of, - -- then record `term y` => {`term x`} in our term dependents map. - dependsOnTerm acc y = - fromMaybe acc do - y' <- Reference.toId y - guard (Set.member (Referent'.Ref' y') dependenciesRefs.terms) - Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) - - -- If `term x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, - -- then record `type y` => {`term x`} in our type dependents map. - dependsOnType acc y = - fromMaybe acc do - y' <- Reference.toId y - guard (Set.member y' dependenciesRefs.types) - Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) - - let typeTypeDependents :: Map TypeReferenceId (NESet TypeReferenceId) - typeTypeDependents = - Map.foldl' g (Map.foldl' f Map.empty unisonFile.dataDeclarationsId') unisonFile.effectDeclarationsId' - where - f acc (x, dataDecl) = - Set.foldl (h2 x) acc (DataDeclaration.typeDependencies dataDecl) - - g acc (x, effectDecl) = - f acc (x, DataDeclaration.toDataDecl effectDecl) - - -- If `type x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, - -- either directly or because we want to report dependents of one of its constructors, then record - -- `type y` => {`type x`} in our type dependents map. - h2 :: - TypeReferenceId -> - Map TypeReferenceId (NESet TypeReferenceId) -> - TypeReference -> - Map TypeReferenceId (NESet TypeReferenceId) - h2 x acc y = - fromMaybe acc do - y' <- Reference.toId y - guard (Set.member y' dependenciesRefs1.types) - Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) - namespace <- Cli.getCurrentProjectRoot0 let ppe = let names = @@ -241,15 +136,7 @@ handleFileDependents hq = do let dependents :: DefnsF Set TermReferenceId TypeReferenceId dependents = - let f deps ref = - maybe Set.empty Set.NonEmpty.toSet (Map.lookup ref deps) - in Defns - { terms = - Set.union - (foldMap (f termDependents) dependenciesRefs1.terms) - (foldMap (f typeTermDependents) dependenciesRefs1.types), - types = foldMap (f typeTypeDependents) dependenciesRefs1.types - } + identifyFileDependents dependenciesRefs1 unisonFile let dependentNames :: DefnsF @@ -280,6 +167,149 @@ handleFileDependents hq = do notFound = Cli.returnEarly (LabeledReferenceNotFound hq) +-- Extract the referents ids out of a unison file. This probably doesn't belong in this module; it's just kind of a +-- variant of 'toNames', but more efficient (no relations, just maps) and with fewer impossible cases (e.g. conflicted +-- names, builtins). +fileToReferentsIds :: forall a v. (Var v) => TypecheckedUnisonFile v a -> DefnsF (Map Name) Referent.Id TypeReferenceId +fileToReferentsIds unisonFile = + Defns + { terms = + Map.empty + & addTerms unisonFile.hashTermsId + & addConstructors (UnisonFile.constructorsId unisonFile), + types = + Map.empty + & addDecls unisonFile.dataDeclarationsId' + & addDecls unisonFile.effectDeclarationsId' + } + where + addTerms :: + Map v (a, TermReferenceId, Maybe WatchKind, Term v a, Type v a) -> + Map Name Referent.Id -> + Map Name Referent.Id + addTerms terms acc = + Map.foldlWithKey' f acc terms + where + f acc var (_, ref, _, _, _) = + Map.insert + (Name.unsafeParseVar var) + (review Referent'.termReference_ ref) + acc + + addConstructors :: Map v (ConstructorReferenceId, Decl v a) -> Map Name Referent.Id -> Map Name Referent.Id + addConstructors constructors acc = + Map.foldlWithKey' f acc constructors + where + f acc var (ref, decl) = + Map.insert + (Name.unsafeParseVar var) + (Referent'.Con' ref (DataDeclaration.constructorType decl)) + acc + + addDecls :: Map v (TypeReferenceId, decl) -> Map Name TypeReferenceId -> Map Name TypeReferenceId + addDecls decls acc = + Map.foldlWithKey' f acc decls + where + f acc var (ref, _) = + Map.insert (Name.unsafeParseVar var) ref acc + +identifyFileDependents :: + forall a v. + (Ord v) => + DefnsF Set TermReferenceId TypeReferenceId -> + TypecheckedUnisonFile v a -> + DefnsF Set TermReferenceId TypeReferenceId +identifyFileDependents dependencies unisonFile = + Defns + { terms = + Set.union + (foldMap (lookupSet termTermDependents) dependencies.terms) + (foldMap (lookupSet typeTermDependents) dependencies.types), + types = foldMap (lookupSet typeTypeDependents) dependencies.types + } + where + termTermDependents :: Map TermReferenceId (NESet TermReferenceId) + typeTermDependents :: Map TypeReferenceId (NESet TermReferenceId) + (termTermDependents, typeTermDependents) = + termDependenciesByDependent dependencies unisonFile.hashTermsId + + typeTypeDependents :: Map TypeReferenceId (NESet TypeReferenceId) + typeTypeDependents = + Map.union + (typeDependenciesByDependent dependencies unisonFile.dataDeclarationsId') + ( typeDependenciesByDependent + dependencies + ( coerce + @(Map v (TypeReferenceId, EffectDeclaration v a)) + @(Map v (TypeReferenceId, DataDeclaration v a)) + unisonFile.effectDeclarationsId' + ) + ) + + lookupSet :: forall k a. (Ord k) => Map k (NESet a) -> k -> Set a + lookupSet m k = + maybe Set.empty Set.NonEmpty.toSet (Map.lookup k m) + +termDependenciesByDependent :: + (Ord v) => + DefnsF Set TermReferenceId TypeReferenceId -> + Map v (a, TermReferenceId, Maybe WatchKind, Term v a, Type v a) -> + (Map TermReferenceId (NESet TermReferenceId), Map TypeReferenceId (NESet TermReferenceId)) +termDependenciesByDependent dependenciesRefs1 = + Map.foldl' f (Map.empty, Map.empty) + where + f (accTerms, accTypes) (_, x, wk, term, _) + | WatchKind.watchKindShouldBeStoredInDatabase wk = + ( Set.foldl' dependsOnTerm accTerms dependencies.terms, + Set.foldl' dependsOnType accTypes dependencies.types + ) + | otherwise = (accTerms, accTypes) + where + dependencies :: DefnsF Set TermReference TypeReference + dependencies = + Term.dependencies term + + -- If `term x` depends on `term y`, and `term y` is in the set of things we want to report dependents of, + -- then record `term y` => {`term x`} in our term dependents map. + dependsOnTerm acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member y' dependenciesRefs1.terms) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + + -- If `term x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, + -- then record `type y` => {`term x`} in our type dependents map. + dependsOnType acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member y' dependenciesRefs1.types) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + +typeDependenciesByDependent :: + (Ord v) => + DefnsF Set TermReferenceId TypeReferenceId -> + Map v (TypeReferenceId, DataDeclaration v a) -> + Map TypeReferenceId (NESet TypeReferenceId) +typeDependenciesByDependent dependencies = + Map.foldl' f Map.empty + where + f acc (x, dataDecl) = + Set.foldl (g x) acc (DataDeclaration.typeDependencies dataDecl) + + -- If `type x` depends on `type y`, and `type y` is in the set of things we want to report dependents of, + -- either directly or because we want to report dependents of one of its constructors, then record + -- `type y` => {`type x`} in our type dependents map. + g :: + TypeReferenceId -> + Map TypeReferenceId (NESet TypeReferenceId) -> + TypeReference -> + Map TypeReferenceId (NESet TypeReferenceId) + g x acc y = + fromMaybe acc do + y' <- Reference.toId y + guard (Set.member y' dependencies.types) + Just (Map.upsert (maybe (Set.NonEmpty.singleton x) (Set.NonEmpty.insert x)) y' acc) + nameDependencies :: PPE.PrettyPrintEnv -> DefnsF Set Referent TypeReference -> diff --git a/unison-core/src/Unison/Name.hs b/unison-core/src/Unison/Name.hs index 488354770c..c5399f7256 100644 --- a/unison-core/src/Unison/Name.hs +++ b/unison-core/src/Unison/Name.hs @@ -38,16 +38,23 @@ module Unison.Name unqualified, isUnqualified, + -- * Suffix-based searching on collections of names + + -- ** Search + searchBySuffix, + gsearchBySuffix, + searchUnconflictedBySuffix, + searchByRankedSuffix, + + -- ** Filter + filterBySuffix, + filterByRankedSuffix, + -- * To organize later commonPrefix, compareSuffix, - filterByRankedSuffix, - filterBySuffix, filterUnconflictedBySuffix, preferShallowLibDepth, - searchByRankedSuffix, - searchBySuffix, - searchUnconflictedBySuffix, sortByText, sortNamed, sortNames, @@ -337,7 +344,13 @@ lastSegment = List.NonEmpty.head . reverseSegments -- NB: Implementation uses logarithmic time lookups, not a linear scan. searchBySuffix :: (Ord r) => Name -> R.Relation Name r -> Set r searchBySuffix suffix rel = - R.lookupDom suffix rel `orElse` R.searchDom (compareSuffix suffix) rel + gsearchBySuffix (`R.lookupDom` rel) (`R.searchDom` rel) suffix + +-- | Like 'searchBySuffix', but takes a lookup and a search function rather than a relation. This allows searching in +-- similar structures, like BiMultimap or just Map. +gsearchBySuffix :: (Ord r) => (Name -> Set r) -> ((Name -> Ordering) -> Set r) -> Name -> Set r +gsearchBySuffix lookup search name = + lookup name `orElse` search (compareSuffix name) where orElse s1 s2 = if Set.null s1 then s2 else s1