From 6072ffa4481ae5c4ad6c56d8a064370e6c32d211 Mon Sep 17 00:00:00 2001 From: Manish Bhasin Date: Tue, 24 Dec 2024 20:27:31 -0500 Subject: [PATCH] feat(cli): names command can search for multiple names * uses a new, more compact 3-column table for names * fixes insufficient indentation of 3rd column in Unison.Util.Pretty.column3Header --- .../src/Unison/Util/Pretty.hs | 4 +- .../src/Unison/Codebase/Editor/HandleInput.hs | 28 +-- .../Codebase/Editor/HandleInput/Names.hs | 70 +++++++ .../src/Unison/Codebase/Editor/Input.hs | 13 +- .../src/Unison/Codebase/Editor/Output.hs | 4 +- .../src/Unison/CommandLine/InputPatterns.hs | 34 +++- .../src/Unison/CommandLine/OutputMessages.hs | 98 +++++---- unison-cli/unison-cli.cabal | 1 + .../ability-order-doesnt-affect-hash.md | 6 +- .../transcripts/idempotent/deep-names.md | 24 +-- unison-src/transcripts/idempotent/help.md | 20 +- unison-src/transcripts/idempotent/names.md | 186 +++++++++++++++--- unison-src/transcripts/idempotent/suffixes.md | 6 +- .../idempotent/unique-type-churn.md | 33 ++-- .../update-ignores-lib-namespace.md | 6 +- unison-src/transcripts/merge.output.md | 18 +- 16 files changed, 391 insertions(+), 160 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Names.hs diff --git a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs index 6f04fc1976..9c5d1f8d08 100644 --- a/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs +++ b/lib/unison-pretty-printer/src/Unison/Util/Pretty.hs @@ -695,8 +695,8 @@ column2UnzippedM bottomPadding left right = column3sep :: (LL.ListLike s Char, IsString s) => Pretty s -> [(Pretty s, Pretty s, Pretty s)] -> Pretty s column3sep sep rows = - let bc = align [(b, sep <> c) | (_, b, c) <- rows] - abc = group <$> align [(a, sep <> bc) | ((a, _, _), bc) <- rows `zip` bc] + let bc = align $ [(b, indent sep c) | (_, b, c) <- rows] + abc = group <$> align [(a, indent sep bc) | ((a, _, _), bc) <- rows `zip` bc] in lines abc -- | Creates an aligned table with an arbitrary number of columns separated by `sep` diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 4967878424..b4abcd4447 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -59,8 +59,8 @@ import Unison.Codebase.Editor.HandleInput.DeleteBranch (handleDeleteBranch) import Unison.Codebase.Editor.HandleInput.DeleteNamespace (getEndangeredDependents, handleDeleteNamespace) 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.EditNamespace (handleEditNamespace) 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 @@ -73,6 +73,7 @@ import Unison.Codebase.Editor.HandleInput.MoveAll (handleMoveAll) import Unison.Codebase.Editor.HandleInput.MoveBranch (doMoveBranch) import Unison.Codebase.Editor.HandleInput.MoveTerm (doMoveTerm) import Unison.Codebase.Editor.HandleInput.MoveType (doMoveType) +import Unison.Codebase.Editor.HandleInput.Names (handleNames) import Unison.Codebase.Editor.HandleInput.NamespaceDependencies (handleNamespaceDependencies) import Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils (diffHelper) import Unison.Codebase.Editor.HandleInput.ProjectClone (handleClone) @@ -497,29 +498,8 @@ loop e = do fixupOutput :: Path.HQSplit -> HQ.HashQualified Name fixupOutput = HQ'.toHQ . Path.nameFromHQSplit - NamesI global query -> do - hqLength <- Cli.runTransaction Codebase.hashLength - let searchNames names = do - let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) - unsuffixifiedPPE = PPED.unsuffixifiedPPE pped - terms = Names.lookupHQTerm Names.IncludeSuffixes query names - types = Names.lookupHQType Names.IncludeSuffixes query names - terms' :: [(Referent, [HQ'.HashQualified Name])] - terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms) - types' :: [(Reference, [HQ'.HashQualified Name])] - types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types) - pure (terms', types') - if global - then do - Global.forAllProjectBranches \(projBranchNames, _ids) branch -> do - let names = Branch.toNames . Branch.head $ branch - (terms, types) <- searchNames names - when (not (null terms) || not (null types)) do - Cli.respond $ GlobalListNames projBranchNames hqLength types terms - else do - names <- Cli.currentNames - (terms, types) <- searchNames names - Cli.respond $ ListNames hqLength types terms + NamesI global queries -> do + mapM_ (handleNames global) queries DocsI srcs -> do for_ srcs docsI CreateAuthorI authorNameSegment authorFullName -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Names.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Names.hs new file mode 100644 index 0000000000..1cd94f31c9 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Names.hs @@ -0,0 +1,70 @@ +module Unison.Codebase.Editor.HandleInput.Names (handleNames) where + +import Control.Monad (when) +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.Codebase qualified as Codebase +import Unison.Codebase.Branch qualified as Branch +import Unison.Codebase.Branch.Names qualified as Branch +import Unison.Codebase.Editor.HandleInput.Global qualified as Global +import Unison.Codebase.Editor.Input (ErrorMessageOrName, RawQuery) +import Unison.Codebase.Editor.Output (Output (..)) +import Unison.HashQualifiedPrime qualified as HQ' +import Unison.Name (Name) +import Unison.NamesWithHistory qualified as Names +import Unison.PrettyPrintEnv qualified as PPE +import Unison.PrettyPrintEnv.Names qualified as PPE +import Unison.PrettyPrintEnvDecl qualified as PPED +import Unison.PrettyPrintEnvDecl.Names qualified as PPED +import Unison.Reference (Reference) +import Unison.Referent (Referent) +import Unison.Util.Pretty qualified as P + +-- | Handles a single @NamesI@ input query returning terms that match a given name. +-- +-- Parameters: +-- +-- * @global :: Bool@ +-- ** If @True@, search all projects and branches. +-- ** If @False@, search only the current branch. +-- +-- * @query :: (RawQuery, ErrorMessageOrName)@ +-- ** The first member is the raw @nameQuery@ being handled. +-- ** The second member is the parsed @nameQuery@ that is either an error message +-- to be printed or a name that can be looked up in the codebase. +handleNames :: + Bool -> + (RawQuery, ErrorMessageOrName) -> + Cli () +handleNames _ (nameQuery, Left errMsg) = do + Cli.respond $ + PrintMessage $ + P.lines [prettyNameQuery, errMsg] + where + prettyNameQuery = + P.red (P.bold $ P.string nameQuery) <> ":" +handleNames global (nameQuery, Right query) = do + hqLength <- Cli.runTransaction Codebase.hashLength + let searchNames names = do + let pped = PPED.makePPED (PPE.hqNamer 10 names) (PPE.suffixifyByHash names) + unsuffixifiedPPE = PPED.unsuffixifiedPPE pped + terms = Names.lookupHQTerm Names.IncludeSuffixes query names + types = Names.lookupHQType Names.IncludeSuffixes query names + terms' :: [(Referent, [HQ'.HashQualified Name])] + terms' = map (\r -> (r, PPE.allTermNames unsuffixifiedPPE r)) (Set.toList terms) + types' :: [(Reference, [HQ'.HashQualified Name])] + types' = map (\r -> (r, PPE.allTypeNames unsuffixifiedPPE r)) (Set.toList types) + pure (terms', types') + if global + then do + Global.forAllProjectBranches \(projBranchNames, _ids) branch -> do + let names = Branch.toNames . Branch.head $ branch + (terms, types) <- searchNames names + when (not (null terms) || not (null types)) do + Cli.respond $ GlobalListNames nameQuery projBranchNames hqLength types terms + else do + names <- Cli.currentNames + (terms, types) <- searchNames names + Cli.respond $ ListNames nameQuery hqLength types terms diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index da06a5fb8e..f1b9f51c3b 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -27,6 +27,10 @@ module Unison.Codebase.Editor.Input IsGlobal, DeleteOutput (..), DeleteTarget (..), + + -- * Type aliases + ErrorMessageOrName, + RawQuery, ) where @@ -61,6 +65,12 @@ type SourceName = Text -- "foo.u" or "buffer 7" type PatchPath = Path.Split' +type ErrorMessageOrValue a = Either (P.Pretty P.ColorText) a + +type ErrorMessageOrName = ErrorMessageOrValue (HQ.HashQualified Name) + +type RawQuery = String + data OptionalPatch = NoPatch | DefaultPatch | UsePatch PatchPath deriving (Eq, Ord, Show) @@ -141,7 +151,8 @@ data Input -- > names .foo.bar -- > names .foo.bar#asdflkjsdf -- > names #sdflkjsdfhsdf - NamesI IsGlobal (HQ.HashQualified Name) + -- > names foo.bar foo.baz #sdflkjsdfhsdf + NamesI IsGlobal [(RawQuery, ErrorMessageOrName)] | AliasTermI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasTypeI !Bool HashOrHQSplit' Path.Split' -- bool = force? | AliasManyI [Path.HQSplit] Path' diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 7ebf9ad299..c51fc501fa 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -264,10 +264,12 @@ data Output | MovedOverExistingBranch Path' | DeletedEverything | ListNames + String -- input namesQuery for which this output is being produced Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names [(Referent, [HQ'.HashQualified Name])] -- term match, term names | GlobalListNames + String -- input namesQuery for which this output is being produced (ProjectAndBranch ProjectName ProjectBranchName) Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names @@ -547,7 +549,7 @@ isFailure o = case o of MoveRootBranchConfirmation -> False MovedOverExistingBranch {} -> False DeletedEverything -> False - ListNames _ tys tms -> null tms && null tys + ListNames _ _ tys tms -> null tms && null tys GlobalListNames {} -> False ListOfDefinitions _ _ _ ds -> null ds GlobalFindBranchResults _ _ _ _ -> False diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 87597a8653..d22f94b566 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -281,9 +281,13 @@ formatStructuredArgument schLength = \case else "." <> s pathArgStr = Text.pack $ show pathArg --- | Converts an arbitrary argument to a `String`. This is for cases where the +-- | Converts an arbitrary argument to a `String`. +-- +-- This is for cases where the -- command /should/ accept a structured argument of some type, but currently -- wants a `String`. +-- +-- This can also be used where the input argument needs to be included in the output. unifyArgument :: I.Argument -> String unifyArgument = either id (Text.unpack . formatStructuredArgument Nothing) @@ -2687,16 +2691,30 @@ names isGlobal = cmdName [] I.Visible - [("name or hash", Required, definitionQueryArg)] - (P.wrap $ makeExample (names isGlobal) ["foo"] <> description) + [("name or hash", OnePlus, definitionQueryArg)] + description $ \case - [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing - args -> wrongArgsLength "exactly one argument" args + [] -> wrongArgsLength "at least one argument" [] + [rawArg] -> do + let arg = handleArg rawArg + case arg of + (_, Left errMsg) -> Left errMsg + (argString, Right name) -> pure $ Input.NamesI isGlobal [(argString, Right name)] + rawArgs -> do + let args = handleArg <$> rawArgs + pure $ Input.NamesI isGlobal args where - description - | isGlobal = "Iteratively search across all projects and branches for names matching `foo`. Note that this is expected to be quite slow and is primarily for debugging issues with your codebase." - | otherwise = "List all known names for `foo` in the current branch." + isGlobalPreamble = "Iteratively search names or hashes across all projects and branches." + isNotGlobalPreamble = "Search names or hashes in the current branch." cmdName = if isGlobal then "debug.names.global" else "names" + description = + P.lines + [ if isGlobal then isGlobalPreamble else isNotGlobalPreamble, + P.wrap $ makeExample (names isGlobal) ["foo"] <> "List all known names for `foo`.", + P.wrap $ makeExample (names isGlobal) ["foo", "#bar"] <> "List all known names for the name `foo` and for the hash `#bar`.", + P.wrap $ makeExample (names isGlobal) [] <> "without arguments invokes a search to select names/hashes to list, which requires that `fzf` can be found within your PATH." + ] + handleArg arg = (unifyArgument arg, handleHashQualifiedNameArg arg) dependents, dependencies :: InputPattern dependents = diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f2d1ab61c0..e554fddc6a 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -14,6 +14,7 @@ import Data.List qualified as List import Data.List.Extra (notNull, nubOrd, nubOrdOn) import Data.List.NonEmpty qualified as NEList import Data.Map qualified as Map +import Data.Ord (comparing) import Data.Sequence qualified as Seq import Data.Set qualified as Set import Data.Set.NonEmpty (NESet) @@ -138,7 +139,6 @@ import Unison.Term (Term) import Unison.Term qualified as Term import Unison.Type (Type) import Unison.UnisonFile qualified as UF -import Unison.Util.ColorText qualified import Unison.Util.Conflicted (Conflicted (..)) import Unison.Util.Defn (Defn (..)) import Unison.Util.Defns (Defns (..)) @@ -863,23 +863,16 @@ notifyUser dir = \case "", output ] - ListNames len types terms -> - listOfNames len types terms - GlobalListNames projectBranchName len types terms -> do - output <- listOfNames len types terms + ListNames namesQuery len types terms -> + listOfNames namesQuery len types terms + GlobalListNames namesQuery projectBranchName len types terms -> do + output <- listOfNames namesQuery len types terms pure $ P.lines [ P.wrap $ "Found results in " <> P.text (into @Text projectBranchName), "", output ] - -- > names foo - -- Terms: - -- Hash: #asdflkjasdflkjasdf - -- Names: .util.frobnicate foo blarg.mcgee - -- - -- Term (with hash #asldfkjsdlfkjsdf): .util.frobnicate, foo, blarg.mcgee - -- Types (with hash #hsdflkjsdfsldkfj): Optional, Maybe, foo ListShallow buildPPE entries -> do let needPPE = entries @@ -2364,7 +2357,7 @@ prettyTransportError = \case Share.UnexpectedResponse resp -> unexpectedServerResponse resp -unexpectedServerResponse :: Servant.ResponseF LazyByteString.ByteString -> P.Pretty Unison.Util.ColorText.ColorText +unexpectedServerResponse :: Servant.ResponseF LazyByteString.ByteString -> Pretty unexpectedServerResponse resp = (P.lines . catMaybes) [ Just @@ -2916,44 +2909,63 @@ listOfDefinitions :: listOfDefinitions fscope ppe detailed results = pure $ listOfDefinitions' fscope ppe detailed results -listOfNames :: Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty -listOfNames len types terms = do +listOfNames :: String -> Int -> [(Reference, [HQ'.HashQualified Name])] -> [(Referent, [HQ'.HashQualified Name])] -> IO Pretty +listOfNames namesQuery len types terms = do if null types && null terms then - pure . P.callout "😶" $ - P.sepNonEmpty "\n\n" $ - [ P.wrap "I couldn't find anything by that name." + pure + . P.sepNonEmpty "\n" + $ [ P.red prettyQuery, + P.string "😶", + P.wrap "I couldn't find anything by that name." ] else - pure . P.sepNonEmpty "\n\n" $ - [ formatTypes types, - formatTerms terms + pure . P.sepNonEmpty "\n" $ + [ P.green prettyQuery, + makeTable prettyRows ] where - formatTerms tms = - P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms) + prettyQuery = P.singleQuoted' (P.string namesQuery) ":" + + makeTable = + P.column3Header "Hash" "Kind" "Names" + + prettyRows = makePrettyRows $ List.sortBy compareRows rows + makePrettyRows = + fmap + ( \(ref, kind, hqs) -> + ( P.syntaxToColor ref, + P.blue kind, + P.group $ + P.commas $ + P.bold . P.syntaxToColor . prettyHashQualified' + <$> hqs + ) + ) + + -- Compare rows by their list of names, first by comparing each name in the list + -- then by the length of the list of they share the same prefix + compareRows :: (a, b, [HQ'.HashQualified Name]) -> (a, b, [HQ'.HashQualified Name]) -> Ordering + compareRows (_, _, hqs1) (_, _, hqs2) = + Name.compareAlphabetical hqs1 hqs2 <> comparing length hqs1 hqs2 + + rows = termRows terms ++ typeRows types + + termRows terms = + makeSortedRow "Term" <$> prettyTerms where - go (ref, hqs) = - P.column2 - [ ("Hash:", P.syntaxToColor (prettyReferent len ref)), - ( "Names: ", - P.group $ - P.spaced $ - P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs - ) - ] - formatTypes types = - P.lines . P.nonEmpty $ P.plural types (P.blue "Type") : List.intersperse "" (go <$> types) + prettyTerms = terms & over (mapped . _1) (prettyReferent len) + + typeRows types = + makeSortedRow "Type" <$> prettyTypes where - go (ref, hqs) = - P.column2 - [ ("Hash:", P.syntaxToColor (prettyReference len ref)), - ( "Names:", - P.group $ - P.spaced $ - P.bold . P.syntaxToColor . prettyHashQualified' <$> List.sortBy Name.compareAlphabetical hqs - ) - ] + prettyTypes = types & over (mapped . _1) (prettyReference len) + + makeSortedRow kind (ref, hqs) = + ( ref, + kind, + List.sortBy Name.compareAlphabetical hqs + ) data ShowNumbers = ShowNumbers | HideNumbers diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index ab8d4ecc07..9685718e25 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -74,6 +74,7 @@ library Unison.Codebase.Editor.HandleInput.MoveBranch Unison.Codebase.Editor.HandleInput.MoveTerm Unison.Codebase.Editor.HandleInput.MoveType + Unison.Codebase.Editor.HandleInput.Names Unison.Codebase.Editor.HandleInput.NamespaceDependencies Unison.Codebase.Editor.HandleInput.NamespaceDiffUtils Unison.Codebase.Editor.HandleInput.ProjectClone diff --git a/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md b/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md index da9c866125..09af223a06 100644 --- a/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md +++ b/unison-src/transcripts/idempotent/ability-order-doesnt-affect-hash.md @@ -26,7 +26,7 @@ scratch/main> add scratch/main> names term1 - Term - Hash: #42m1ui9g56 - Names: term1 term2 + 'term1': + Hash Kind Names + #42m1ui9g56 Term term1, term2 ``` diff --git a/unison-src/transcripts/idempotent/deep-names.md b/unison-src/transcripts/idempotent/deep-names.md index 34d842859d..d82b97409c 100644 --- a/unison-src/transcripts/idempotent/deep-names.md +++ b/unison-src/transcripts/idempotent/deep-names.md @@ -53,15 +53,15 @@ As such, we see two copies of `a` and two copies of `x` via these direct depende ``` ucm scratch/app1> names a - Term - Hash: #gjmq673r1v - Names: lib.text_v1.a lib.text_v2.a + 'a': + Hash Kind Names + #gjmq673r1v Term lib.text_v1.a, lib.text_v2.a scratch/app1> names x - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v3.x lib.http_v4.x + 'x': + Hash Kind Names + #nsmc4p1ra4 Term lib.http_v3.x, lib.http_v4.x ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. @@ -103,13 +103,13 @@ We see neither the second indirect copy of `a` nor the indirect copy of `x` via ``` ucm scratch/app2> names a - Term - Hash: #gjmq673r1v - Names: lib.webutil.lib.text_v1.a + 'a': + Hash Kind Names + #gjmq673r1v Term lib.webutil.lib.text_v1.a scratch/app2> names x - Term - Hash: #nsmc4p1ra4 - Names: lib.http_v1.x lib.http_v2.x + 'x': + Hash Kind Names + #nsmc4p1ra4 Term lib.http_v1.x, lib.http_v2.x ``` diff --git a/unison-src/transcripts/idempotent/help.md b/unison-src/transcripts/idempotent/help.md index 7dc5975ed0..6525ba7459 100644 --- a/unison-src/transcripts/idempotent/help.md +++ b/unison-src/transcripts/idempotent/help.md @@ -152,10 +152,13 @@ scratch/main> help operation. debug.names.global - `debug.names.global foo` Iteratively search across all - projects and branches for names matching `foo`. Note that this - is expected to be quite slow and is primarily for debugging - issues with your codebase. + Iteratively search names or hashes across all projects and branches. + `debug.names.global foo` List all known names for `foo`. + `debug.names.global foo #bar` List all known names for the + name `foo` and for the hash `#bar`. + `debug.names.global` without arguments invokes a search to + select names/hashes to list, which requires that `fzf` can be + found within your PATH. debug.numberedArgs Dump the contents of the numbered args state. @@ -553,8 +556,13 @@ scratch/main> help `move.type foo bar` renames `foo` to `bar`. names - `names foo` List all known names for `foo` in the current - branch. + Search names or hashes in the current branch. + `names foo` List all known names for `foo`. + `names foo #bar` List all known names for the name `foo` and + for the hash `#bar`. + `names` without arguments invokes a search to select + names/hashes to list, which requires that `fzf` can be found + within your PATH. namespace.dependencies List the external dependencies of the specified namespace. diff --git a/unison-src/transcripts/idempotent/names.md b/unison-src/transcripts/idempotent/names.md index ca74561ba8..f88bc4ac98 100644 --- a/unison-src/transcripts/idempotent/names.md +++ b/unison-src/transcripts/idempotent/names.md @@ -16,6 +16,24 @@ some.otherplace.x = 10 somewhere.z = 1 -- Some similar name with a different value somewhere.y = 2 + +another.Boolean = true + +dd.baz = true +aa.baz = true +bb.baz = true +cc.baz = true + +d.baz = 100 +a.baz = 100 +b.baz = 100 +c.baz = 100 + +type a.baz = Boolean +type z.baz = Boolean + + +xyz.baz = 100.1 ``` ``` ucm :added-by-ucm @@ -27,11 +45,23 @@ somewhere.y = 2 ⍟ These new definitions are ok to `add`: + type a.baz + type z.baz + a.baz : Nat + aa.baz : Boolean + another.Boolean : Boolean + b.baz : Nat + bb.baz : Boolean + c.baz : Nat + cc.baz : Boolean + d.baz : Nat + dd.baz : Boolean some.otherplace.x : Nat some.otherplace.y : Nat some.place.x : Nat somewhere.y : Nat somewhere.z : Nat + xyz.baz : Float ``` ``` ucm @@ -39,11 +69,23 @@ scratch/main> add ⍟ I've added these definitions: + type a.baz + type z.baz + a.baz : Nat + aa.baz : Boolean + another.Boolean : Boolean + b.baz : Nat + bb.baz : Boolean + c.baz : Nat + cc.baz : Boolean + d.baz : Nat + dd.baz : Boolean some.otherplace.x : Nat some.otherplace.y : Nat some.place.x : Nat somewhere.y : Nat somewhere.z : Nat + xyz.baz : Float ``` `names` searches relative to the current path. @@ -53,45 +95,76 @@ scratch/main> add scratch/main> names x - Terms - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + 'x': + Hash Kind Names + #pi25gcdv0o Term some.otherplace.x + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z + +-- We can search for multiple names in one command - Hash: #pi25gcdv0o - Names: some.otherplace.x +scratch/main> names x y + + 'x': + Hash Kind Names + #pi25gcdv0o Term some.otherplace.x + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z + + 'y': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z + #dcgdua2lj6 Term somewhere.y -- We can search by hash, and see all aliases of that hash scratch/main> names #gjmq673r1v - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + '#gjmq673r1v': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z -- Works with absolute names too scratch/main> names .some.place.x - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + '.some.place.x': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z ``` `debug.names.global` searches from the root, and absolutely qualifies results ``` ucm --- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. +-- We can search from a different branch and find all names in the codebase named 'x' and those named 'y', and each of their aliases respectively. -scratch/other> debug.names.global x +scratch/other> debug.names.global x y Found results in scratch/main - Terms - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + 'x': + Hash Kind Names + #pi25gcdv0o Term some.otherplace.x + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z + + Found results in scratch/main - Hash: #pi25gcdv0o - Names: some.otherplace.x + 'y': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z + #dcgdua2lj6 Term somewhere.y -- We can search by hash, and see all aliases of that hash in the codebase @@ -99,9 +172,11 @@ scratch/other> debug.names.global #gjmq673r1v Found results in scratch/main - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + '#gjmq673r1v': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z -- We can search using an absolute name @@ -109,7 +184,70 @@ scratch/other> debug.names.global .some.place.x Found results in scratch/main - Term - Hash: #gjmq673r1v - Names: some.otherplace.y some.place.x somewhere.z + '.some.place.x': + Hash Kind Names + #gjmq673r1v Term some.otherplace.y, + some.place.x, + somewhere.z +``` + +``` ucm :error +-- We can handle many name queries, some of which fail and some of which succeed + +-- The names command is considered to have failed because there are 1 or more query failures + +-- We can display hashes that are references to types and to terms + +-- Each list of names in the Names column is sorted alphabetically + +-- Each row is sorted by the Names column, alphabetically by name and then by the length of the list + +scratch/main> names max /invalid1 /invalid2 + Boolean foo baz + + 'max': + Hash Kind Names + ##Float.max Term lib.builtins.Float.max + + /invalid1: + /invalid1 is not a well-formed name, hash, or hash-qualified + name. I expected something like `foo`, `#abc123`, or + `foo#abc123`. + + /invalid2: + /invalid2 is not a well-formed name, hash, or hash-qualified + name. I expected something like `foo`, `#abc123`, or + `foo#abc123`. + + '+': + Hash Kind Names + ##Float.+ Term lib.builtins.Float.+ + ##Int.+ Term lib.builtins.Int.+ + ##Nat.+ Term lib.builtins.Nat.+ + + 'Boolean': + Hash Kind Names + #idl63c82kf#0 Term a.baz.Boolean + #56fi1cmq3u Term aa.baz, + another.Boolean, + bb.baz, + cc.baz, + dd.baz + ##Boolean Type lib.builtins.Boolean + #cmihlkoddu#0 Term z.baz.Boolean + + 'foo': + 😶 + I couldn't find anything by that name. + + 'baz': + Hash Kind Names + #idl63c82kf Type a.baz + #u1qsl3nk5t Term a.baz, b.baz, c.baz, d.baz + #56fi1cmq3u Term aa.baz, + another.Boolean, + bb.baz, + cc.baz, + dd.baz + #00kr10tpqr Term xyz.baz + #cmihlkoddu Type z.baz ``` diff --git a/unison-src/transcripts/idempotent/suffixes.md b/unison-src/transcripts/idempotent/suffixes.md index 762ffe5448..29a46024e9 100644 --- a/unison-src/transcripts/idempotent/suffixes.md +++ b/unison-src/transcripts/idempotent/suffixes.md @@ -161,7 +161,7 @@ scratch/main> view distributed.abra.cadabra scratch/main> names distributed.lib.baz.qux - Term - Hash: #nhup096n2s - Names: lib.distributed.lib.baz.qux + 'distributed.lib.baz.qux': + Hash Kind Names + #nhup096n2s Term lib.distributed.lib.baz.qux ``` diff --git a/unison-src/transcripts/idempotent/unique-type-churn.md b/unison-src/transcripts/idempotent/unique-type-churn.md index 79b8a9684c..8adce63e89 100644 --- a/unison-src/transcripts/idempotent/unique-type-churn.md +++ b/unison-src/transcripts/idempotent/unique-type-churn.md @@ -51,13 +51,10 @@ If the name stays the same, the churn is even prevented if the type is updated a ``` ucm scratch/main> names A - Type - Hash: #j743idicb1 - Names: A - - Term - Hash: #j743idicb1#0 - Names: A.A + 'A': + Hash Kind Names + #j743idicb1 Type A + #j743idicb1#0 Term A.A ``` ``` unison @@ -87,13 +84,10 @@ scratch/main> update scratch/main> names A - Type - Hash: #186m0i6upt - Names: A - - Term - Hash: #186m0i6upt#0 - Names: A.A + 'A': + Hash Kind Names + #186m0i6upt Type A + #186m0i6upt#0 Term A.A ``` ``` unison @@ -125,11 +119,8 @@ scratch/main> update scratch/main> names A - Type - Hash: #j743idicb1 - Names: A - - Term - Hash: #j743idicb1#0 - Names: A.A + 'A': + Hash Kind Names + #j743idicb1 Type A + #j743idicb1#0 Term A.A ``` diff --git a/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md b/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md index 946fe14ceb..f2e029420e 100644 --- a/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md +++ b/unison-src/transcripts/idempotent/update-ignores-lib-namespace.md @@ -61,7 +61,7 @@ scratch/main> update scratch/main> names foo - Term - Hash: #9ntnotdp87 - Names: foo + 'foo': + Hash Kind Names + #9ntnotdp87 Term foo ``` diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index e12726898d..cc8f6aa7d7 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -2206,9 +2206,9 @@ scratch/alice> add ``` ucm scratch/alice> names A - Type - Hash: #65mdg7015r - Names: A A.inner.X + 'A': + Hash Kind Names + #65mdg7015r Type A, A.inner.X ``` Bob's branch: @@ -3364,15 +3364,15 @@ scratch/merge-bob-into-alice> update scratch/merge-bob-into-alice> names Bar - Type - Hash: #h3af39sae7 - Names: Bar + 'Bar': + Hash Kind Names + #h3af39sae7 Type Bar scratch/alice> names Bar - Type - Hash: #h3af39sae7 - Names: Bar + 'Bar': + Hash Kind Names + #h3af39sae7 Type Bar ``` ``` ucm :hide