From 03b225ccd18a3edcc418127ef1f8c0fe98741393 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 1/5] Add ability to find over EVERY branch. --- .../src/Unison/Codebase/Editor/HandleInput.hs | 124 ++++++++++-------- .../Codebase/Editor/HandleInput/Global.hs | 22 ++++ .../src/Unison/Codebase/Editor/Input.hs | 4 +- .../src/Unison/Codebase/Editor/Output.hs | 3 +- .../src/Unison/CommandLine/InputPatterns.hs | 6 +- unison-cli/unison-cli.cabal | 1 + 6 files changed, 96 insertions(+), 64 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index e85879cc4a..65b2fb781d 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -63,6 +63,7 @@ import Unison.Codebase.Editor.HandleInput.DeleteProject (handleDeleteProject) import Unison.Codebase.Editor.HandleInput.EditNamespace (handleEditNamespace) import Unison.Codebase.Editor.HandleInput.FindAndReplace (handleStructuredFindI, handleStructuredFindReplaceI) import Unison.Codebase.Editor.HandleInput.FormatFile qualified as Format +import Unison.Codebase.Editor.HandleInput.Global qualified as Global import Unison.Codebase.Editor.HandleInput.InstallLib (handleInstallLib) import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile) @@ -1089,7 +1090,7 @@ handleFindI :: Cli () handleFindI isVerbose fscope ws input = do Cli.Env {codebase} <- ask - (pped, names, searchRoot, branch0) <- case fscope of + case fscope of FindLocal p -> do searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0FromProjectPath searchRoot @@ -1097,7 +1098,21 @@ handleFindI isVerbose fscope ws input = do -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. pped <- Cli.currentPrettyPrintEnvDecl - pure (pped, names, Just p, branch0) + let suffixifiedPPE = PPED.suffixifiedPPE pped + results <- searchBranch0 codebase branch0 names + if (null results) + then do + Cli.respond FindNoLocalMatches + -- We've already searched everything else, so now we search JUST the + -- names in lib. + let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs + case mayOnlyLibBranch of + Nothing -> respondResults codebase suffixifiedPPE (Just p) [] + Just onlyLibBranch -> do + let onlyLibNames = Branch.toNames onlyLibBranch + results <- searchBranch0 codebase branch0 onlyLibNames + respondResults codebase suffixifiedPPE (Just p) results + else respondResults codebase suffixifiedPPE (Just p) results FindLocalAndDeps p -> do searchRoot <- Cli.resolvePath' p branch0 <- Cli.getBranch0FromProjectPath searchRoot @@ -1105,64 +1120,57 @@ handleFindI isVerbose fscope ws input = do -- Don't exclude anything from the pretty printer, since the type signatures we print for -- results may contain things in lib. pped <- Cli.currentPrettyPrintEnvDecl - pure (pped, names, Just p, branch0) + let suffixifiedPPE = PPED.suffixifiedPPE pped + results <- searchBranch0 codebase branch0 names + respondResults codebase suffixifiedPPE (Just p) results FindGlobal -> do - -- TODO: Rewrite to be properly global again - projectRootNames <- Names.makeAbsolute . Branch.toNames <$> Cli.getCurrentProjectRoot0 - pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames - currentBranch0 <- Cli.getCurrentBranch0 - pure (pped, projectRootNames, Nothing, currentBranch0) - let suffixifiedPPE = PPED.suffixifiedPPE pped - let getResults :: Names -> Cli [SearchResult] - getResults names = - case ws of - [] -> pure (List.sortBy SR.compareByName (SR.fromNames names)) - -- type query - ":" : ws -> do - typ <- parseSearchType (show input) (unwords ws) - let keepNamed = Set.intersection (Branch.deepReferents branch0) - (noExactTypeMatches, matches) <- do - Cli.runTransaction do - matches <- keepNamed <$> Codebase.termsOfType codebase typ - if null matches - then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ - else pure (False, matches) - when noExactTypeMatches (Cli.respond NoExactTypeMatches) - pure $ - -- in verbose mode, aliases are shown, so we collapse all - -- aliases to a single search result; in non-verbose mode, - -- a separate result may be shown for each alias - (if isVerbose then uniqueBy SR.toReferent else id) $ - searchResultsFor names (Set.toList matches) [] + Global.forAllProjectBranches \(projAndBranchNames, _ids) branch -> do + let branch0 = Branch.head branch + let projectRootNames = Names.makeAbsolute . Branch.toNames $ branch0 + pped <- Cli.prettyPrintEnvDeclFromNames projectRootNames + results <- searchBranch0 codebase branch0 projectRootNames + when (not $ null results) do + Cli.setNumberedArgs $ fmap (SA.SearchResult Nothing) results + results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) + Cli.respond $ GlobalFindBranchResults projAndBranchNames (PPED.suffixifiedPPE pped) isVerbose results' + where + searchBranch0 :: Codebase.Codebase m Symbol Ann -> Branch0 IO -> Names -> Cli [SearchResult] + searchBranch0 codebase branch0 names = + case ws of + [] -> pure (List.sortBy SR.compareByName (SR.fromNames names)) + -- type query + ":" : ws -> do + typ <- parseSearchType (show input) (unwords ws) + let keepNamed = Set.intersection (Branch.deepReferents branch0) + (noExactTypeMatches, matches) <- do + Cli.runTransaction do + matches <- keepNamed <$> Codebase.termsOfType codebase typ + if null matches + then (True,) . keepNamed <$> Codebase.termsMentioningType codebase typ + else pure (False, matches) + when noExactTypeMatches (Cli.respond NoExactTypeMatches) + pure $ + -- in verbose mode, aliases are shown, so we collapse all + -- aliases to a single search result; in non-verbose mode, + -- a separate result may be shown for each alias + (if isVerbose then uniqueBy SR.toReferent else id) $ + searchResultsFor names (Set.toList matches) [] - -- name query - qs -> do - let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text - anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#') - let srs = - searchBranchScored - names - Find.simpleFuzzyScore - (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) - pure $ uniqueBy SR.toReferent srs - let respondResults results = do - Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results - results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) - Cli.respond $ ListOfDefinitions fscope suffixifiedPPE isVerbose results' - results <- getResults names - case (results, fscope) of - ([], FindLocal {}) -> do - Cli.respond FindNoLocalMatches - -- We've already searched everything else, so now we search JUST the - -- names in lib. - let mayOnlyLibBranch = branch0 & Branch.children %%~ \cs -> Map.singleton NameSegment.libSegment <$> Map.lookup NameSegment.libSegment cs - case mayOnlyLibBranch of - Nothing -> respondResults [] - Just onlyLibBranch -> do - let onlyLibNames = Branch.toNames onlyLibBranch - results <- getResults onlyLibNames - respondResults results - _ -> respondResults results + -- name query + qs -> do + let anythingBeforeHash :: Megaparsec.Parsec (Lexer.Token Text) [Char] Text + anythingBeforeHash = Text.pack <$> Megaparsec.takeWhileP Nothing (/= '#') + let srs = + searchBranchScored + names + Find.simpleFuzzyScore + (mapMaybe (HQ.parseTextWith anythingBeforeHash . Text.pack) qs) + pure $ uniqueBy SR.toReferent srs + respondResults :: Codebase.Codebase m Symbol Ann -> PPE.PrettyPrintEnv -> Maybe Path' -> [SearchResult] -> Cli () + respondResults codebase ppe searchRoot results = do + Cli.setNumberedArgs $ fmap (SA.SearchResult searchRoot) results + results' <- Cli.runTransaction (Backend.loadSearchResults codebase results) + Cli.respond $ ListOfDefinitions fscope ppe isVerbose results' handleDependencies :: HQ.HashQualified Name -> Cli () handleDependencies hq = do diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs new file mode 100644 index 0000000000..1306497b61 --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/Global.hs @@ -0,0 +1,22 @@ +module Unison.Codebase.Editor.HandleInput.Global (forAllProjectBranches) where + +import Control.Monad.Reader +import U.Codebase.Sqlite.DbId (ProjectBranchId, ProjectId) +import U.Codebase.Sqlite.Queries qualified as Q +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Codebase qualified as Codebase +import Unison.Codebase.Branch (Branch) +import Unison.Core.Project +import Unison.Prelude +import Unison.Util.Monoid (foldMapM) + +-- | Map over ALL project branches in the codebase. +-- This is a _very_ big hammer, that you should basically never use, except for things like debugging or migrations. +forAllProjectBranches :: (Monoid r) => ((ProjectAndBranch ProjectName ProjectBranchName, ProjectAndBranch ProjectId ProjectBranchId) -> Branch IO -> Cli r) -> Cli r +forAllProjectBranches f = do + Cli.Env {codebase} <- ask + projectBranches <- Cli.runTransaction Q.loadAllProjectBranchNamePairs + projectBranches & foldMapM \(names, ids@(ProjectAndBranch projId branchId)) -> do + b <- liftIO $ Codebase.expectProjectBranchRoot codebase projId branchId + f (names, ids) b diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index d0bc3ae9d2..e736c618bd 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -127,8 +127,8 @@ data Input | PushRemoteBranchI PushRemoteBranchInput | ResetI (BranchId2 {- namespace to reset it to -}) (Maybe UnresolvedProjectBranch {- ProjectBranch to reset -}) -- todo: Q: Does it make sense to publish to not-the-root of a Github repo? - -- Does it make sense to fork from not-the-root of a Github repo? - | -- used in Welcome module to give directions to user + | -- Does it make sense to fork from not-the-root of a Github repo? + -- used in Welcome module to give directions to user CreateMessage (P.Pretty P.ColorText) | -- Change directory. SwitchBranchI Path' diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 6ae0b23616..b8c13900a6 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -261,7 +261,6 @@ data Output | MovedOverExistingBranch Path' | DeletedEverything | ListNames - IsGlobal Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names [(Referent, [HQ'.HashQualified Name])] -- term match, term names @@ -269,6 +268,7 @@ data Output | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann] | ListStructuredFind [HQ.HashQualified Name] + | GlobalFindBranchResults (ProjectAndBranch ProjectName ProjectBranchName) PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | -- ListStructuredFind patternMatchingUsages termBodyUsages -- show the result of add/update SlurpOutput Input PPE.PrettyPrintEnv SlurpResult @@ -545,6 +545,7 @@ isFailure o = case o of DeletedEverything -> False ListNames _ _ tys tms -> null tms && null tys ListOfDefinitions _ _ _ ds -> null ds + GlobalFindBranchResults _ _ _ _ -> False ListStructuredFind tms -> null tms SlurpOutput _ _ sr -> not $ SR.isOk sr ParseErrors {} -> True diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 671265a960..f9a9effcb7 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -1149,7 +1149,7 @@ findAll :: InputPattern findAll = find' "find.all" (Input.FindLocalAndDeps Path.relativeEmpty') findGlobal :: InputPattern -findGlobal = find' "find.global" Input.FindGlobal +findGlobal = find' "debug.find.global" Input.FindGlobal findIn, findInAll :: InputPattern findIn = findIn' "find-in" Input.FindLocal @@ -1197,8 +1197,8 @@ findHelp = "lists all definitions with a name similar to 'foo' or 'bar' in the " <> "specified subnamespace (including one level of its 'lib')." ), - ( "find.global foo", - "lists all definitions with a name similar to 'foo' in any namespace" + ( "debug.find.global foo", + "Iteratively searches all projects and branches and lists all definitions with a name similar to 'foo'. Note that this is a very slow operation." ) ] ) diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index 77030bfdf6..2bdd255a12 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -64,6 +64,7 @@ library Unison.Codebase.Editor.HandleInput.EditNamespace Unison.Codebase.Editor.HandleInput.FindAndReplace Unison.Codebase.Editor.HandleInput.FormatFile + Unison.Codebase.Editor.HandleInput.Global Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load Unison.Codebase.Editor.HandleInput.Ls From d4a04b73492bdfa013108921ef5d8e33e04df163 Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 2/5] re-add names.global --- .../src/Unison/Codebase/Editor/HandleInput.hs | 36 ++++--- .../src/Unison/Codebase/Editor/Output.hs | 8 +- .../src/Unison/CommandLine/InputPatterns.hs | 9 +- .../src/Unison/CommandLine/OutputMessages.hs | 101 ++++++++++-------- 4 files changed, 90 insertions(+), 64 deletions(-) diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 65b2fb781d..ae03247421 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -498,23 +498,27 @@ loop e = do fixupOutput = HQ'.toHQ . Path.nameFromHQSplit NamesI global query -> do hqLength <- Cli.runTransaction Codebase.hashLength - (names, pped) <- - if global - then do - error "TODO: Implement names.global." - else do - names <- Cli.currentNames + let searchNames names = do pped <- Cli.prettyPrintEnvDeclFromNames names - pure (names, pped) - - let 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) - Cli.respond $ ListNames global hqLength types' terms' + let 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 DocsI srcs -> do for_ srcs docsI CreateAuthorI authorNameSegment authorFullName -> do diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index b8c13900a6..7a59f4ac96 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -264,6 +264,11 @@ data Output Int -- hq length to print References [(Reference, [HQ'.HashQualified Name])] -- type match, type names [(Referent, [HQ'.HashQualified Name])] -- term match, term names + | GlobalListNames + (ProjectAndBranch ProjectName ProjectBranchName) + Int -- hq length to print References + [(Reference, [HQ'.HashQualified Name])] -- type match, type names + [(Referent, [HQ'.HashQualified Name])] -- term match, term names -- list of all the definitions within this branch | ListOfDefinitions FindScope PPE.PrettyPrintEnv ListDetailed [SearchResult' Symbol Ann] | ListShallow (IO PPE.PrettyPrintEnv) [ShallowListEntry Symbol Ann] @@ -543,7 +548,8 @@ 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 ListStructuredFind tms -> null tms diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index f9a9effcb7..38d24809de 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -2611,12 +2611,15 @@ names isGlobal = [] I.Visible [("name or hash", Required, definitionQueryArg)] - (P.wrap $ makeExample (names isGlobal) ["foo"] <> " shows the hash and all known names for `foo`.") + (P.wrap $ makeExample (names isGlobal) ["foo"] <> description) $ \case [thing] -> Input.NamesI isGlobal <$> handleHashQualifiedNameArg thing args -> wrongArgsLength "exactly one argument" args where - cmdName = if isGlobal then "names.global" else "names" + 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." + cmdName = if isGlobal then "debug.names.global" else "names" dependents, dependencies :: InputPattern dependents = @@ -3456,7 +3459,7 @@ validInputs = mergeInputPattern, mergeCommitInputPattern, names False, -- names - names True, -- names.global + names True, -- debug.names.global namespaceDependencies, previewAdd, previewUpdate, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index d061f37f54..62ed7ea70e 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -855,49 +855,24 @@ notifyUser dir = \case ] ListOfDefinitions fscope ppe detailed results -> listOfDefinitions fscope ppe detailed results - ListNames global len types terms -> - if null types && null terms - then - pure . P.callout "😶" $ - P.sepNonEmpty "\n\n" $ - [ P.wrap "I couldn't find anything by that name.", - globalTip - ] - else - pure . P.sepNonEmpty "\n\n" $ - [ formatTypes types, - formatTerms terms, - globalTip - ] - where - globalTip = - if global - then mempty - else (tip $ "Use " <> IP.makeExample (IP.names True) [] <> " to see more results.") - formatTerms tms = - P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms) - 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) - 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 - ) - ] + GlobalFindBranchResults projBranchName ppe detailed results -> do + output <- listOfDefinitions Input.FindGlobal ppe detailed results + pure $ + P.lines + [ P.wrap $ "Found results in " <> P.text (into @Text projBranchName), + "", + output + ] + ListNames len types terms -> + listOfNames len types terms + GlobalListNames projectBranchName len types terms -> do + output <- listOfNames len types terms + pure $ + P.lines + [ P.wrap $ "Found results in " <> P.text (into @Text projectBranchName), + "", + output + ] -- > names foo -- Terms: -- Hash: #asdflkjasdflkjasdf @@ -997,7 +972,6 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. - let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:" @@ -2816,6 +2790,45 @@ 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 + if null types && null terms + then + pure . P.callout "😶" $ + P.sepNonEmpty "\n\n" $ + [ P.wrap "I couldn't find anything by that name." + ] + else + pure . P.sepNonEmpty "\n\n" $ + [ formatTypes types, + formatTerms terms + ] + where + formatTerms tms = + P.lines . P.nonEmpty $ P.plural tms (P.blue "Term") : List.intersperse "" (go <$> tms) + 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) + 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 + ) + ] + data ShowNumbers = ShowNumbers | HideNumbers -- | `ppe` is just for rendering type signatures From e545e0b1a7c0614aa364602ae0b19f45bf498b0e Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 15:58:28 -0700 Subject: [PATCH 3/5] Rerun transcripts --- ...ability-order-doesnt-affect-hash.output.md | 2 - unison-src/transcripts/deep-names.output.md | 8 -- .../transcripts/empty-namespaces.output.md | 4 +- unison-src/transcripts/find-command.output.md | 9 +- unison-src/transcripts/help.output.md | 122 ++++++++++-------- unison-src/transcripts/merge.output.md | 2 - unison-src/transcripts/names.output.md | 6 - unison-src/transcripts/suffixes.output.md | 2 - .../transcripts/unique-type-churn.output.md | 6 - .../update-ignores-lib-namespace.output.md | 2 - 10 files changed, 75 insertions(+), 88 deletions(-) diff --git a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md index a61dd00459..d897322a99 100644 --- a/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md +++ b/unison-src/transcripts/ability-order-doesnt-affect-hash.output.md @@ -45,7 +45,5 @@ scratch/main> names term1 Term Hash: #8hum58rlih Names: term1 term2 - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/deep-names.output.md b/unison-src/transcripts/deep-names.output.md index 114133d786..9756abc509 100644 --- a/unison-src/transcripts/deep-names.output.md +++ b/unison-src/transcripts/deep-names.output.md @@ -48,16 +48,12 @@ scratch/app1> names a Term Hash: #gjmq673r1v Names: lib.text_v1.a lib.text_v2.a - - Tip: Use `names.global` to see more results. scratch/app1> names x Term Hash: #nsmc4p1ra4 Names: lib.http_v3.x lib.http_v4.x - - Tip: Use `names.global` to see more results. ``` Our `app2` project includes the `http` library twice as direct dependencies, and once as an indirect dependency via `webutil`. @@ -102,15 +98,11 @@ scratch/app2> names a Term Hash: #gjmq673r1v Names: lib.webutil.lib.text_v1.a - - Tip: Use `names.global` to see more results. scratch/app2> names x Term Hash: #nsmc4p1ra4 Names: lib.http_v1.x lib.http_v2.x - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/empty-namespaces.output.md b/unison-src/transcripts/empty-namespaces.output.md index 1b598b6dd4..b1b647ecda 100644 --- a/unison-src/transcripts/empty-namespaces.output.md +++ b/unison-src/transcripts/empty-namespaces.output.md @@ -25,7 +25,7 @@ scratch/main> find.verbose No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` @@ -42,7 +42,7 @@ scratch/main> find mynamespace No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index 7abbe26f0d..fde54abfd1 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -86,17 +86,14 @@ scratch/main> find baz No results. Check your spelling, or try using tab completion to supply command arguments. - `find.global` can be used to search outside the current + `debug.find.global` can be used to search outside the current namespace. ``` ``` ucm scratch/main> find.global notHere - 😶 - - No results. Check your spelling, or try using tab completion - to supply command arguments. - +⚠️ +I don't know how to find.global. Type `help` or `?` to get help. ``` diff --git a/unison-src/transcripts/help.output.md b/unison-src/transcripts/help.output.md index 248fb6b4fc..13f3c63820 100644 --- a/unison-src/transcripts/help.output.md +++ b/unison-src/transcripts/help.output.md @@ -113,6 +113,50 @@ scratch/main> help debug.file View details about the most recent successfully typechecked file. + debug.find.global + `find` lists all definitions in the + current namespace. + `find foo` lists all definitions with a + name similar to 'foo' in the + current namespace (excluding + those under 'lib'). + `find foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the current + namespace (excluding those + under 'lib'). + `find-in namespace` lists all definitions in the + specified subnamespace. + `find-in namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace. + find.all foo lists all definitions with a + name similar to 'foo' in the + current namespace (including + one level of 'lib'). + `find-in.all namespace` lists all definitions in the + specified subnamespace + (including one level of its + 'lib'). + `find-in.all namespace foo bar` lists all definitions with a + name similar to 'foo' or + 'bar' in the specified + subnamespace (including one + level of its 'lib'). + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + 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. + debug.numberedArgs Dump the contents of the numbered args state. @@ -269,9 +313,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find-in `find` lists all definitions in the @@ -304,9 +351,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find-in.all `find` lists all definitions in the @@ -339,9 +389,12 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find.all `find` lists all definitions in the @@ -374,48 +427,16 @@ scratch/main> help 'bar' in the specified subnamespace (including one level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace + debug.find.global foo Iteratively searches all + projects and branches and + lists all definitions with a + name similar to 'foo'. Note + that this is a very slow + operation. find.all.verbose `find.all.verbose` searches for definitions like `find.all`, but includes hashes and aliases in the results. - find.global - `find` lists all definitions in the - current namespace. - `find foo` lists all definitions with a - name similar to 'foo' in the - current namespace (excluding - those under 'lib'). - `find foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the current - namespace (excluding those - under 'lib'). - `find-in namespace` lists all definitions in the - specified subnamespace. - `find-in namespace foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the specified - subnamespace. - find.all foo lists all definitions with a - name similar to 'foo' in the - current namespace (including - one level of 'lib'). - `find-in.all namespace` lists all definitions in the - specified subnamespace - (including one level of its - 'lib'). - `find-in.all namespace foo bar` lists all definitions with a - name similar to 'foo' or - 'bar' in the specified - subnamespace (including one - level of its 'lib'). - find.global foo lists all definitions with a - name similar to 'foo' in any - namespace - find.verbose `find.verbose` searches for definitions like `find`, but includes hashes and aliases in the results. @@ -526,11 +547,8 @@ scratch/main> help `move.type foo bar` renames `foo` to `bar`. names - `names foo` shows the hash and all known names for `foo`. - - names.global - `names.global foo` shows the hash and all known names for - `foo`. + `names foo` List all known names for `foo` in the current + branch. namespace.dependencies List the external dependencies of the specified namespace. diff --git a/unison-src/transcripts/merge.output.md b/unison-src/transcripts/merge.output.md index 77350b1130..7675b0f748 100644 --- a/unison-src/transcripts/merge.output.md +++ b/unison-src/transcripts/merge.output.md @@ -1435,8 +1435,6 @@ project/alice> names A Type Hash: #65mdg7015r Names: A A.inner.X - - Tip: Use `names.global` to see more results. ``` Bob's branch: diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 27b986afb0..78d1f5c9f1 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -59,8 +59,6 @@ scratch/main> names x Hash: #pi25gcdv0o Names: some.otherplace.x - - Tip: Use `names.global` to see more results. -- We can search by hash, and see all aliases of that hash scratch/main> names #gjmq673r1v @@ -68,8 +66,6 @@ scratch/main> names #gjmq673r1v Term Hash: #gjmq673r1v Names: some.otherplace.y some.place.x somewhere.z - - Tip: Use `names.global` to see more results. -- Works with absolute names too scratch/main> names .some.place.x @@ -77,8 +73,6 @@ scratch/main> names .some.place.x Term Hash: #gjmq673r1v Names: some.otherplace.y some.place.x somewhere.z - - Tip: Use `names.global` to see more results. ``` `names.global` searches from the root, and absolutely qualifies results diff --git a/unison-src/transcripts/suffixes.output.md b/unison-src/transcripts/suffixes.output.md index 43aa678efd..a4cd5e3b02 100644 --- a/unison-src/transcripts/suffixes.output.md +++ b/unison-src/transcripts/suffixes.output.md @@ -165,8 +165,6 @@ scratch/main> names distributed.lib.baz.qux Term Hash: #nhup096n2s Names: lib.distributed.lib.baz.qux - - Tip: Use `names.global` to see more results. ``` ## Corner cases diff --git a/unison-src/transcripts/unique-type-churn.output.md b/unison-src/transcripts/unique-type-churn.output.md index ea00586436..661b0b65dd 100644 --- a/unison-src/transcripts/unique-type-churn.output.md +++ b/unison-src/transcripts/unique-type-churn.output.md @@ -60,8 +60,6 @@ scratch/main> names A Term Hash: #uj8oalgadr#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` ``` unison @@ -99,8 +97,6 @@ scratch/main> names A Term Hash: #ufo5tuc7ho#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` ``` unison @@ -140,7 +136,5 @@ scratch/main> names A Term Hash: #uj8oalgadr#0 Names: A.A - - Tip: Use `names.global` to see more results. ``` diff --git a/unison-src/transcripts/update-ignores-lib-namespace.output.md b/unison-src/transcripts/update-ignores-lib-namespace.output.md index dc03596d08..a91ca27840 100644 --- a/unison-src/transcripts/update-ignores-lib-namespace.output.md +++ b/unison-src/transcripts/update-ignores-lib-namespace.output.md @@ -62,7 +62,5 @@ scratch/main> names foo Term Hash: #9ntnotdp87 Names: foo - - Tip: Use `names.global` to see more results. ``` From f9db384df181ebfee974d9d2f574a417767189fc Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Wed, 31 Jul 2024 16:54:10 -0700 Subject: [PATCH 4/5] Fix transcripts --- unison-src/transcripts/find-command.md | 7 +--- unison-src/transcripts/find-command.output.md | 18 ++++----- unison-src/transcripts/names.md | 13 +++---- unison-src/transcripts/names.output.md | 37 +++++++++++++++---- 4 files changed, 44 insertions(+), 31 deletions(-) diff --git a/unison-src/transcripts/find-command.md b/unison-src/transcripts/find-command.md index 019903556a..56958476a5 100644 --- a/unison-src/transcripts/find-command.md +++ b/unison-src/transcripts/find-command.md @@ -34,15 +34,10 @@ Finding within a namespace ```ucm scratch/main> find bar --- Shows UUIDs --- scratch/main> find.global bar +scratch/other> debug.find.global bar scratch/main> find-in somewhere bar ``` ```ucm:error scratch/main> find baz ``` - -```ucm:error -scratch/main> find.global notHere -``` diff --git a/unison-src/transcripts/find-command.output.md b/unison-src/transcripts/find-command.output.md index fde54abfd1..4d3af86ad6 100644 --- a/unison-src/transcripts/find-command.output.md +++ b/unison-src/transcripts/find-command.output.md @@ -65,8 +65,15 @@ scratch/main> find bar 1. somewhere.bar : Nat --- Shows UUIDs --- scratch/main> find.global bar +scratch/other> debug.find.global bar + + Found results in scratch/main + + 1. .cat.lib.bar : Nat + 2. .lib.bar : Nat + 3. .somewhere.bar : Nat + + scratch/main> find-in somewhere bar 1. bar : Nat @@ -90,10 +97,3 @@ scratch/main> find baz namespace. ``` -``` ucm -scratch/main> find.global notHere - -⚠️ -I don't know how to find.global. Type `help` or `?` to get help. - -``` diff --git a/unison-src/transcripts/names.md b/unison-src/transcripts/names.md index 7780292f42..486ff35ec1 100644 --- a/unison-src/transcripts/names.md +++ b/unison-src/transcripts/names.md @@ -32,16 +32,13 @@ scratch/main> names #gjmq673r1v scratch/main> names .some.place.x ``` -`names.global` searches from the root, and absolutely qualifies results +`debug.names.global` searches from the root, and absolutely qualifies results - -TODO: swap this back to a 'ucm' block when names.global is re-implemented - -``` +```ucm -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> names.global x +scratch/other> debug.names.global x -- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> names.global #gjmq673r1v +scratch/other> debug.names.global #gjmq673r1v -- We can search using an absolute name -scratch/other> names.global .some.place.x +scratch/other> debug.names.global .some.place.x ``` diff --git a/unison-src/transcripts/names.output.md b/unison-src/transcripts/names.output.md index 78d1f5c9f1..06db804432 100644 --- a/unison-src/transcripts/names.output.md +++ b/unison-src/transcripts/names.output.md @@ -75,16 +75,37 @@ scratch/main> names .some.place.x Names: some.otherplace.y some.place.x somewhere.z ``` -`names.global` searches from the root, and absolutely qualifies results +`debug.names.global` searches from the root, and absolutely qualifies results -TODO: swap this back to a 'ucm' block when names.global is re-implemented - -``` +``` ucm -- We can search from a different branch and find all names in the codebase named 'x', and each of their aliases respectively. -scratch/other> names.global x +scratch/other> debug.names.global x + + Found results in scratch/main + + Terms + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + + Hash: #pi25gcdv0o + Names: some.otherplace.x + -- We can search by hash, and see all aliases of that hash in the codebase -scratch/other> names.global #gjmq673r1v +scratch/other> debug.names.global #gjmq673r1v + + Found results in scratch/main + + Term + Hash: #gjmq673r1v + Names: some.otherplace.y some.place.x somewhere.z + -- We can search using an absolute name -scratch/other> names.global .some.place.x -``` +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 + +``` From 8c9c3baad81d75ae68eecc4bde32de0309ac3a6c Mon Sep 17 00:00:00 2001 From: ChrisPenner Date: Thu, 1 Aug 2024 00:17:33 +0000 Subject: [PATCH 5/5] automatically run ormolu --- unison-cli/src/Unison/CommandLine/OutputMessages.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index 62ed7ea70e..0bd733b88a 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -972,6 +972,7 @@ notifyUser dir = \case -- defs in the codebase. In some cases it's fine for bindings to -- shadow codebase names, but you don't want it to capture them in -- the decompiled output. + let prettyBindings = P.bracket . P.lines $ P.wrap "The watch expression(s) reference these definitions:"