From deaf355f832c7b0ef43a1a44b2fea486bc8df41a Mon Sep 17 00:00:00 2001 From: Chris Penner Date: Fri, 5 Jul 2024 10:20:49 -0700 Subject: [PATCH] Improve LSP completion sorting --- .../src/Unison/Codebase/Editor/HandleInput.hs | 4 ++ .../Codebase/Editor/HandleInput/LSPDebug.hs | 15 +++++ .../src/Unison/Codebase/Editor/Input.hs | 1 + .../src/Unison/Codebase/Editor/Output.hs | 20 +++--- .../src/Unison/CommandLine/InputPatterns.hs | 17 +++++ .../src/Unison/CommandLine/OutputMessages.hs | 10 +++ unison-cli/src/Unison/LSP/Completion.hs | 62 +++++++++++++++---- unison-cli/unison-cli.cabal | 1 + unison-src/transcripts/lsp-name-completion.md | 35 +++++++++++ .../transcripts/lsp-name-completion.output.md | 38 ++++++++++++ 10 files changed, 181 insertions(+), 22 deletions(-) create mode 100644 unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs create mode 100644 unison-src/transcripts/lsp-name-completion.md create mode 100644 unison-src/transcripts/lsp-name-completion.output.md diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs index 2175ce06a0..09d101923c 100644 --- a/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput.hs @@ -65,6 +65,7 @@ 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.InstallLib (handleInstallLib) +import Unison.Codebase.Editor.HandleInput.LSPDebug qualified as LSPDebug import Unison.Codebase.Editor.HandleInput.Load (EvalMode (Sandboxed), evalUnisonFile, handleLoad, loadUnisonFile) import Unison.Codebase.Editor.HandleInput.Ls (handleLs) import Unison.Codebase.Editor.HandleInput.Merge2 (handleMerge) @@ -809,6 +810,8 @@ loop e = do let completionFunc = Completion.haskelineTabComplete IP.patternMap codebase authHTTPClient currentPath (_, completions) <- liftIO $ completionFunc (reverse (unwords inputs), "") Cli.respond (DisplayDebugCompletions completions) + DebugLSPNameCompletionI prefix -> do + LSPDebug.debugLspNameCompletion prefix DebugFuzzyOptionsI command args -> do Cli.Env {codebase} <- ask currentPath <- Cli.getCurrentPath @@ -1077,6 +1080,7 @@ inputDescription input = DebugNameDiffI {} -> wat DebugNumberedArgsI {} -> wat DebugTabCompletionI _input -> wat + DebugLSPNameCompletionI _prefix -> wat DebugFuzzyOptionsI cmd input -> pure . Text.pack $ "debug.fuzzy-completions " <> unwords (cmd : toList input) DebugFormatI -> pure "debug.format" DebugTypecheckedUnisonFileI {} -> wat diff --git a/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs new file mode 100644 index 0000000000..dc4f0cc14d --- /dev/null +++ b/unison-cli/src/Unison/Codebase/Editor/HandleInput/LSPDebug.hs @@ -0,0 +1,15 @@ +module Unison.Codebase.Editor.HandleInput.LSPDebug (debugLspNameCompletion) where + +import Unison.Cli.Monad (Cli) +import Unison.Cli.Monad qualified as Cli +import Unison.Cli.NamesUtils qualified as Cli +import Unison.Codebase.Editor.Output (Output (DisplayDebugLSPNameCompletions)) +import Unison.LSP.Completion qualified as Completion +import Unison.Prelude + +debugLspNameCompletion :: Text -> Cli () +debugLspNameCompletion prefix = do + names <- Cli.currentNames + let ct = Completion.namesToCompletionTree names + let (_, matches) = Completion.completionsForQuery ct prefix + Cli.respond $ DisplayDebugLSPNameCompletions matches diff --git a/unison-cli/src/Unison/Codebase/Editor/Input.hs b/unison-cli/src/Unison/Codebase/Editor/Input.hs index 86ecb38491..d9278b0588 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Input.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Input.hs @@ -192,6 +192,7 @@ data Input -- no path is provided. NamespaceDependenciesI (Maybe Path') | DebugTabCompletionI [String] -- The raw arguments provided + | DebugLSPNameCompletionI Text -- The raw arguments provided | DebugFuzzyOptionsI String [String] -- cmd and arguments | DebugFormatI | DebugNumberedArgsI diff --git a/unison-cli/src/Unison/Codebase/Editor/Output.hs b/unison-cli/src/Unison/Codebase/Editor/Output.hs index 1534f42d0f..78d2cac1c1 100644 --- a/unison-cli/src/Unison/Codebase/Editor/Output.hs +++ b/unison-cli/src/Unison/Codebase/Editor/Output.hs @@ -56,6 +56,7 @@ import Unison.LabeledDependency (LabeledDependency) import Unison.Name (Name) import Unison.NameSegment (NameSegment) import Unison.Names (Names) +import Unison.Names qualified as Names import Unison.Names.ResolutionResult qualified as Names import Unison.NamesWithHistory qualified as Names import Unison.Parser.Ann (Ann) @@ -82,7 +83,6 @@ import Unison.Util.Defns (DefnsF, defnsAreEmpty) import Unison.Util.Pretty qualified as P import Unison.Util.Relation (Relation) import Unison.WatchKind qualified as WK -import qualified Unison.Names as Names type ListDetailed = Bool @@ -186,15 +186,15 @@ data Output | -- | Function found, but has improper type -- Note: the constructor name is misleading here; we weren't necessarily looking for a "main". BadMainFunction + -- | what we were trying to do (e.g. "run", "io.test") Text - -- ^ what we were trying to do (e.g. "run", "io.test") + -- | name of function (HQ.HashQualified Name) - -- ^ name of function + -- | bad type of function (Type Symbol Ann) - -- ^ bad type of function PPE.PrettyPrintEnv + -- | acceptable type(s) of function [Type Symbol Ann] - -- ^ acceptable type(s) of function | BranchEmpty WhichBranchEmpty | LoadPullRequest (ReadRemoteNamespace Void) (ReadRemoteNamespace Void) Path' Path' Path' Path' | CreatedNewBranch Path.Absolute @@ -231,12 +231,12 @@ data Output -- for terms. This additional info is used to provide an enhanced -- error message. SearchTermsNotFoundDetailed + -- | @True@ if we are searching for a term, @False@ if we are searching for a type Bool - -- ^ @True@ if we are searching for a term, @False@ if we are searching for a type + -- | Misses (search terms that returned no hits for terms or types) [HQ.HashQualified Name] - -- ^ Misses (search terms that returned no hits for terms or types) + -- | Hits for types if we are searching for terms or terms if we are searching for types [HQ.HashQualified Name] - -- ^ Hits for types if we are searching for terms or terms if we are searching for types | -- ask confirmation before deleting the last branch that contains some defns -- `Path` is one of the paths the user has requested to delete, and is paired -- with whatever named definitions would not have any remaining names if @@ -336,6 +336,7 @@ data Output | IntegrityCheck IntegrityResult | DisplayDebugNameDiff NameChanges | DisplayDebugCompletions [Completion.Completion] + | DisplayDebugLSPNameCompletions [(Text, Name, LabeledDependency)] | DebugDisplayFuzzyOptions Text [String {- arg description, options -}] | DebugFuzzyOptionsNoResolver | DebugTerm (Bool {- verbose mode -}) (Either (Text {- A builtin hash -}) (Term Symbol Ann)) @@ -384,8 +385,8 @@ data Output | CalculatingDiff | -- | The `local` in a `clone remote local` is ambiguous AmbiguousCloneLocal + -- | Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) - -- ^ Treating `local` as a project. We may know the branch name, if it was provided in `remote`. (ProjectAndBranch ProjectName ProjectBranchName) | -- | The `remote` in a `clone remote local` is ambiguous AmbiguousCloneRemote ProjectName (ProjectAndBranch ProjectName ProjectBranchName) @@ -594,6 +595,7 @@ isFailure o = case o of ShareError {} -> True ViewOnShare {} -> False DisplayDebugCompletions {} -> False + DisplayDebugLSPNameCompletions {} -> False DebugDisplayFuzzyOptions {} -> False DebugFuzzyOptionsNoResolver {} -> True DebugTerm {} -> False diff --git a/unison-cli/src/Unison/CommandLine/InputPatterns.hs b/unison-cli/src/Unison/CommandLine/InputPatterns.hs index 31fcd41ae6..4af89e8474 100644 --- a/unison-cli/src/Unison/CommandLine/InputPatterns.hs +++ b/unison-cli/src/Unison/CommandLine/InputPatterns.hs @@ -31,6 +31,7 @@ module Unison.CommandLine.InputPatterns debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugTerm, debugTermVerbose, debugType, @@ -1821,6 +1822,21 @@ debugTabCompletion = ) (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "text")) +debugLspNameCompletion :: InputPattern +debugLspNameCompletion = + InputPattern + "debug.lsp-name-completion" + [] + I.Hidden + [("Completion prefix", OnePlus, noCompletionsArg)] + ( P.lines + [ P.wrap $ "This command can be used to test and debug ucm's LSP name-completion within transcripts." + ] + ) + \case + [prefix] -> Input.DebugLSPNameCompletionI . Text.pack <$> unsupportedStructuredArgument "text" prefix + _ -> Left (I.help debugLspNameCompletion) + debugFuzzyOptions :: InputPattern debugFuzzyOptions = InputPattern @@ -3341,6 +3357,7 @@ validInputs = debugNameDiff, debugNumberedArgs, debugTabCompletion, + debugLspNameCompletion, debugFuzzyOptions, debugFormat, delete, diff --git a/unison-cli/src/Unison/CommandLine/OutputMessages.hs b/unison-cli/src/Unison/CommandLine/OutputMessages.hs index f17f483adf..992ed44d24 100644 --- a/unison-cli/src/Unison/CommandLine/OutputMessages.hs +++ b/unison-cli/src/Unison/CommandLine/OutputMessages.hs @@ -1646,6 +1646,16 @@ notifyUser dir = \case else "" in (isCompleteTxt, P.string (Completion.replacement comp)) ) + DisplayDebugLSPNameCompletions completions -> + pure $ + P.columnNHeader + ["Matching Path", "Name", "Hash"] + ( completions <&> \(pathText, fqn, ld) -> + let ldRef = case ld of + LD.TermReferent ref -> prettyReferent 10 ref + LD.TypeReference ref -> prettyReference 10 ref + in [P.text pathText, prettyName fqn, P.syntaxToColor ldRef] + ) DebugDisplayFuzzyOptions argDesc fuzzyOptions -> pure $ P.lines diff --git a/unison-cli/src/Unison/LSP/Completion.hs b/unison-cli/src/Unison/LSP/Completion.hs index 129ba8bc54..89a375eee6 100644 --- a/unison-cli/src/Unison/LSP/Completion.hs +++ b/unison-cli/src/Unison/LSP/Completion.hs @@ -3,7 +3,14 @@ {-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE RecordWildCards #-} -module Unison.LSP.Completion where +module Unison.LSP.Completion + ( completionHandler, + completionItemResolveHandler, + namesToCompletionTree, + -- Exported for transcript tests + completionsForQuery, + ) +where import Control.Comonad.Cofree import Control.Lens hiding (List, (:<)) @@ -11,6 +18,7 @@ import Control.Monad.Reader import Data.Aeson qualified as Aeson import Data.Aeson.Types qualified as Aeson import Data.Foldable qualified as Foldable +import Data.List qualified as List import Data.List.Extra (nubOrdOn) import Data.List.NonEmpty (NonEmpty (..)) import Data.Map qualified as Map @@ -58,26 +66,30 @@ completionHandler m respond = (range, prefix) <- VFS.completionPrefix (m ^. params . textDocument . uri) (m ^. params . position) ppe <- PPED.suffixifiedPPE <$> lift currentPPED codebaseCompletions <- lift getCodebaseCompletions - -- Config {maxCompletions} <- lift getConfig - let defMatches = matchCompletions codebaseCompletions prefix - let (isIncomplete, defCompletions) = - defMatches - & nubOrdOn (\(p, _name, ref) -> (p, ref)) - & fmap (over _1 Path.toText) - & (False,) - -- case maxCompletions of - -- Nothing -> (False,) - -- Just n -> takeCompletions n + let (isIncomplete, matches) = completionsForQuery codebaseCompletions prefix let defCompletionItems = - defCompletions + matches & mapMaybe \(path, fqn, dep) -> let biasedPPE = PPE.biasTo [fqn] ppe hqName = LD.fold (PPE.types biasedPPE) (PPE.terms biasedPPE) dep in hqName <&> \hqName -> mkDefCompletionItem fileUri range (HQ'.toName hqName) fqn path (HQ'.toText hqName) dep + let itemDefaults = Nothing pure . CompletionList isIncomplete itemDefaults $ defCompletionItems where +completionsForQuery :: CompletionTree -> Text -> (Bool, [(Text, Name, LabeledDependency)]) +completionsForQuery codebaseCompletions prefix = + let defMatches = matchCompletions codebaseCompletions prefix + (isIncomplete, defCompletions) = + defMatches + -- sort shorter names first + & sortOn (matchSortCriteria . view _2) + & nubOrdOn (\(p, _name, ref) -> (p, ref)) + & fmap (over _1 Path.toText) + & (False,) + in (isIncomplete, defCompletions) + -- Takes at most the specified number of completions, but also indicates with a boolean -- whether there were more completions remaining so we can pass that along to the client. -- takeCompletions :: Int -> [a] -> (Bool, [a]) @@ -100,7 +112,9 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _documentation = Nothing, _deprecated = Nothing, _preselect = Nothing, - _sortText = Nothing, + _sortText = + let (nls, ns, fn) = matchSortCriteria fullyQualifiedName + in Just $ Text.intercalate "|" [paddedInt nls, paddedInt ns, Name.toText fn], _filterText = Just path, _insertText = Nothing, _insertTextFormat = Nothing, @@ -113,6 +127,13 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi _data_ = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri} } where + -- Pads an integer with zeroes so it sorts lexicographically in the right order + -- + -- >>> paddedInt 1 + -- "00001" + paddedInt :: Int -> Text + paddedInt n = + Text.justifyRight 5 '0' (Text.pack $ show n) -- We should generally show the longer of the path or suffixified name in the label, -- it helps the user understand the difference between options which may otherwise look -- the same. @@ -131,6 +152,21 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi then path else suffixified +-- | LSP clients sort completions using a text field, so we have to convert Unison's sort criteria to text. +matchSortCriteria :: Name -> (Int, Int, Name) +matchSortCriteria fqn = + (numLibSegments, numSegments, fqn) + where + numSegments :: Int + numSegments = + Name.countSegments fqn + numLibSegments :: Int + numLibSegments = + Name.reverseSegments fqn + & Foldable.toList + & List.filter (== NameSegment.libSegment) + & List.length + -- | Generate a completion tree from a set of names. -- A completion tree is a suffix tree over the path segments of each name it contains. -- The goal is to allow fast completion of names by any partial path suffix. diff --git a/unison-cli/unison-cli.cabal b/unison-cli/unison-cli.cabal index a8b8202763..6075a09219 100644 --- a/unison-cli/unison-cli.cabal +++ b/unison-cli/unison-cli.cabal @@ -67,6 +67,7 @@ library Unison.Codebase.Editor.HandleInput.InstallLib Unison.Codebase.Editor.HandleInput.Load Unison.Codebase.Editor.HandleInput.Ls + Unison.Codebase.Editor.HandleInput.LSPDebug Unison.Codebase.Editor.HandleInput.Merge2 Unison.Codebase.Editor.HandleInput.MoveAll Unison.Codebase.Editor.HandleInput.MoveBranch diff --git a/unison-src/transcripts/lsp-name-completion.md b/unison-src/transcripts/lsp-name-completion.md new file mode 100644 index 0000000000..ba879a72e9 --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.md @@ -0,0 +1,35 @@ +```ucm:hide +scratch/main> builtins.merge lib.builtins +``` + +```unison:hide +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +```ucm:hide +scratch/main> add +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +```ucm +scratch/main> debug.lsp-name-completion foldMap +``` + +Should still find the term which has a matching hash to a better name if the better name doesn't match. +```ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap +``` diff --git a/unison-src/transcripts/lsp-name-completion.output.md b/unison-src/transcripts/lsp-name-completion.output.md new file mode 100644 index 0000000000..622d415f4f --- /dev/null +++ b/unison-src/transcripts/lsp-name-completion.output.md @@ -0,0 +1,38 @@ +```unison +foldMap = "top-level" +nested.deeply.foldMap = "nested" +lib.base.foldMap = "lib" +lib.dep.lib.transitive.foldMap = "transitive-lib" +-- A deeply nested definition with the same hash as the top level one. +-- This should not be included in the completion results if a better name with the same hash IS included. +lib.dep.lib.transitive_same_hash.foldMap = "top-level" +foldMapWith = "partial match" + +other = "other" +``` + +Completion should find all the `foldMap` definitions in the codebase, +sorted by number of name segments, shortest first. + +Individual LSP clients may still handle sorting differently, e.g. doing a fuzzy match over returned results, or +prioritizing exact matches over partial matches. We don't have any control over that. + +```ucm +scratch/main> debug.lsp-name-completion foldMap + + Matching Path Name Hash + foldMap foldMap #o38ps8p4q6 + foldMapWith foldMapWith #r9rs4mcb0m + foldMap nested.deeply.foldMap #snrjegr5dk + foldMap lib.base.foldMap #jf4buul17k + foldMap lib.dep.lib.transitive.foldMap #0o01gvr3fi + +``` +Should still find the term which has a matching hash to a better name if the better name doesn't match. +```ucm +scratch/main> debug.lsp-name-completion transitive_same_hash.foldMap + + Matching Path Name Hash + transitive_same_hash.foldMap lib.dep.lib.transitive_same_hash.foldMap #o38ps8p4q6 + +```