Merge pull request #5182 from unisonweb/cp/improve-lsp-completion

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

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

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

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

unison-cli/src/Unison/CommandLine/InputPatterns.hs

@@ -28,6 +28,7 @@ module Unison.CommandLine.InputPatterns
     debugNameDiff,
     debugNumberedArgs,
     debugTabCompletion,
+    debugLspNameCompletion,
     debugTerm,
     debugTermVerbose,
     debugType,
@@ -1824,6 +1825,21 @@ debugTabCompletion =
     )
     (fmap Input.DebugTabCompletionI . traverse (unsupportedStructuredArgument "debug.tab-complete" "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
@@ -3345,6 +3361,7 @@ validInputs =
       debugNameDiff,
       debugNumberedArgs,
       debugTabCompletion,
+      debugLspNameCompletion,
       debugFuzzyOptions,
       debugFormat,
       delete,

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

unison-cli/src/Unison/LSP/Completion.hs

@@ -3,14 +3,22 @@
 {-# 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, (:<))
 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.

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

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
+```

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
+
+```