-
Notifications
You must be signed in to change notification settings - Fork 270
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
move
dependents implementation into its own module
- Loading branch information
1 parent
e2c42ca
commit f068357
Showing
4 changed files
with
115 additions
and
62 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
68 changes: 68 additions & 0 deletions
68
unison-cli/src/Unison/Codebase/Editor/HandleInput/Dependents.hs
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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) |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters