LSP Auto-completion (#3488)

Add auto-completion to LSP
2024-09-11 10:35:57 +03:00 · 2022-10-19 15:48:02 -06:00 · 2022-10-19 15:48:02 -06:00 · b7be8ded03
commit b7be8ded03
parent 3035766325
9 changed files with 350 additions and 110 deletions
--- a/docs/language-server.markdown
+++ b/docs/language-server.markdown
@ -6,9 +6,9 @@

 Supported features:

-* Show type on hover
+* Autocompletion
 * Inline type and parser error messages
-* NO autocomplete yet, but soon.
+* Show type on hover

 Notes:

@ -30,7 +30,8 @@ Configuration for [coc-nvim](https://github.com/neoclide/coc.nvim), enter the fo
    "unison": {
      "filetypes": ["unison"],
      "host": "127.0.0.1",
-      "port": 5757
+      "port": 5757,
+      "settings": {}
    }
  }
 ```
@ -39,5 +40,25 @@ Note that you'll need to start UCM _before_ you try connecting to it in your edi

 ### VSCode

-VSCode doesn't allow customizing LSP implementations without an extension,
-Hang tight, one will be available soon!
+Simply install the [Unison Language VSCode extension](https://marketplace.visualstudio.com/items?itemName=unison-lang.unison).
+
+
+### Other Editors
+
+If your editor provides a mechanism for connecting to a host and port, provide a host of `127.0.0.1` and port `5757`.
+
+If your editor requires a command to run, you can provide the command `nc localhost 5757` on Mac, or `netcat localhost 5757` on linux.
+Note that some editors require passing the command and arguments as separate parameters.
+
+## Configuration
+
+Supported settings and their defaults. See information for your language server client about where to provide these.
+
+```json
+{
+  // The number of completions the server should collect and send based on a single query.
+  // Increasing this limit will provide more completion results, but at the cost of being slower to respond.
+  // If explicitly set to `null` the server will return ALL completions available.
+  "maxCompletions": 100
+}
+```
--- a/unison-cli/package.yaml
+++ b/unison-cli/package.yaml
@ -28,6 +28,7 @@ dependencies:
  - exceptions
  - extra
  - filepath
+  - free
  - fuzzyfind
  - friendly-time
  - generic-lens
--- a/unison-cli/src/Unison/LSP.hs
+++ b/unison-cli/src/Unison/LSP.hs
@ -8,7 +8,6 @@ module Unison.LSP where
 import Colog.Core (LogAction (LogAction))
 import qualified Colog.Core as Colog
 import Control.Monad.Reader
-import Data.Aeson hiding (Options, defaultOptions)
 import GHC.IO.Exception (ioe_errno)
 import qualified Ki
 import qualified Language.LSP.Logging as LSP
@ -27,6 +26,8 @@ import Unison.Codebase.Runtime (Runtime)
 import qualified Unison.Debug as Debug
 import Unison.LSP.CancelRequest (cancelRequestHandler)
 import Unison.LSP.CodeAction (codeActionHandler)
+import Unison.LSP.Completion (completionHandler)
+import qualified Unison.LSP.Configuration as Config
 import qualified Unison.LSP.FileAnalysis as Analysis
 import Unison.LSP.FoldingRange (foldingRangeRequest)
 import qualified Unison.LSP.HandlerUtils as Handlers
@ -65,7 +66,7 @@ spawnLsp codebase runtime latestBranch latestPath = TCP.withSocketsDo do
      case Errno <$> ioe_errno ioerr of
        Just errNo
          | errNo == eADDRINUSE -> do
-            putStrLn $ "Note: Port " <> lspPort <> " is already bound by another process or another UCM. The LSP server will not be started."
+              putStrLn $ "Note: Port " <> lspPort <> " is already bound by another process or another UCM. The LSP server will not be started."
        _ -> do
          Debug.debugM Debug.LSP "LSP Exception" ioerr
          Debug.debugM Debug.LSP "LSP Errno" (ioe_errno ioerr)
@ -85,21 +86,14 @@ serverDefinition ::
  ServerDefinition Config
 serverDefinition vfsVar codebase runtime scope latestBranch latestPath =
  ServerDefinition
-    { defaultConfig = lspDefaultConfig,
-      onConfigurationChange = lspOnConfigurationChange,
+    { defaultConfig = defaultLSPConfig,
+      onConfigurationChange = Config.updateConfig,
      doInitialize = lspDoInitialize vfsVar codebase runtime scope latestBranch latestPath,
      staticHandlers = lspStaticHandlers,
      interpretHandler = lspInterpretHandler,
      options = lspOptions
    }

-- | Detect user LSP configuration changes.
-lspOnConfigurationChange :: Config -> Value -> Either Text Config
-lspOnConfigurationChange _ _ = pure Config
-
-lspDefaultConfig :: Config
-lspDefaultConfig = Config
-
 -- | Initialize any context needed by the LSP server
 lspDoInitialize ::
  MVar VFS ->
@ -120,6 +114,7 @@ lspDoInitialize vfsVar codebase runtime scope latestBranch latestPath lspContext
  parseNamesCacheVar <- newTVarIO mempty
  currentPathCacheVar <- newTVarIO Path.absoluteEmpty
  cancellationMapVar <- newTVarIO mempty
+  completionsVar <- newTVarIO mempty
  let env = Env {ppeCache = readTVarIO ppeCacheVar, parseNamesCache = readTVarIO parseNamesCacheVar, currentPathCache = readTVarIO currentPathCacheVar, ..}
  let lspToIO = flip runReaderT lspContext . unLspT . flip runReaderT env . runLspM
  Ki.fork scope (lspToIO Analysis.fileAnalysisWorker)
@ -141,6 +136,7 @@ lspRequestHandlers =
    & SMM.insert STextDocumentHover (mkHandler hoverHandler)
    & SMM.insert STextDocumentCodeAction (mkHandler codeActionHandler)
    & SMM.insert STextDocumentFoldingRange (mkHandler foldingRangeRequest)
+    & SMM.insert STextDocumentCompletion (mkHandler completionHandler)
  where
    defaultTimeout = 10_000 -- 10s
    mkHandler ::
@ -167,6 +163,7 @@ lspNotificationHandlers =
    & SMM.insert STextDocumentDidChange (ClientMessageHandler VFS.lspChangeFile)
    & SMM.insert SInitialized (ClientMessageHandler Notifications.initializedHandler)
    & SMM.insert SCancelRequest (ClientMessageHandler $ Notifications.withDebugging cancelRequestHandler)
+    & SMM.insert SWorkspaceDidChangeConfiguration (ClientMessageHandler Config.workspaceConfigurationChanged)

 -- | A natural transformation into IO, required by the LSP lib.
 lspInterpretHandler :: Env -> Lsp <~> IO
--- a/unison-cli/src/Unison/LSP/Completion.hs
+++ b/unison-cli/src/Unison/LSP/Completion.hs
@ -4,122 +4,238 @@

 module Unison.LSP.Completion where

-import Control.Lens hiding (List)
+import Control.Comonad.Cofree
+import Control.Lens hiding (List, (:<))
 import Control.Monad.Reader
-import Data.String.Here.Uninterpolated (here)
+import Data.Bifunctor (second)
+import Data.List.Extra (nubOrdOn)
+import Data.List.NonEmpty (NonEmpty (..))
+import qualified Data.Map as Map
+import qualified Data.Set as Set
 import qualified Data.Text as Text
 import Language.LSP.Types
 import Language.LSP.Types.Lens
-import qualified Text.FuzzyFind as Fuzzy
+import Unison.Codebase.Path (Path)
+import qualified Unison.Codebase.Path as Path
 import qualified Unison.HashQualified' as HQ'
 import Unison.LSP.Types
 import qualified Unison.LSP.VFS as VFS
+import Unison.LabeledDependency (LabeledDependency)
+import qualified Unison.LabeledDependency as LD
+import Unison.Name (Name)
+import qualified Unison.Name as Name
+import Unison.NameSegment (NameSegment (..))
+import qualified Unison.NameSegment as NameSegment
+import Unison.Names (Names (..))
 import Unison.Prelude
-import qualified Unison.Server.Endpoints.FuzzyFind as FZF
-import qualified Unison.Server.Syntax as Server
-import qualified Unison.Server.Types as Backend
+import qualified Unison.PrettyPrintEnv as PPE
+import qualified Unison.PrettyPrintEnvDecl as PPED
+import qualified Unison.Referent as Referent
+import qualified Unison.Util.Monoid as Monoid
+import qualified Unison.Util.Relation as Relation

-- | Rudimentary auto-completion handler
--
-- TODO:
-- * Rewrite this to use an index rather than fuzzy searching ALL names
-- * Respect ucm's current path
-- * Provide namespaces as auto-complete targets
-- * Auto-complete minimally suffixed names
-- * Include docs in completion details?
 completionHandler :: RequestMessage 'TextDocumentCompletion -> (Either ResponseError (ResponseResult 'TextDocumentCompletion) -> Lsp ()) -> Lsp ()
 completionHandler m respond =
-  respond =<< do
-    mayPrefix <- VFS.completionPrefix (m ^. params)
-    case mayPrefix of
-      Nothing -> pure . Right . InL . List $ []
-      Just (range, prefix) -> do
-        matches <- expand range prefix
-        let isIncomplete = True -- TODO: be smarter about this
-        pure . Right . InR . CompletionList isIncomplete . List $ snippetCompletions prefix range <> matches
+  respond . maybe (Right $ InL mempty) (Right . InR) =<< runMaybeT do
+    (range, prefix) <- MaybeT $ VFS.completionPrefix (m ^. params)
+    ppe <- PPED.suffixifiedPPE <$> lift globalPPE
+    completions <- lift getCompletions
+    Config {maxCompletions} <- lift getConfig
+    let defMatches = matchCompletions completions prefix
+    let (isIncomplete, defCompletions) =
+          defMatches
+            & nubOrdOn (\(p, _name, ref) -> (p, ref))
+            & fmap (over _1 Path.toText)
+            & case maxCompletions of
+              Nothing -> (False,)
+              Just n -> takeCompletions n
+    let defCompletionItems =
+          defCompletions
+            & mapMaybe \(path, fqn, dep) ->
+              let biasedPPE = PPE.biasTo [fqn] ppe
+                  hqName = LD.fold (PPE.types biasedPPE) (PPE.terms biasedPPE) dep
+               in hqName <&> \hqName -> mkDefCompletionItem range (Name.toText fqn) path (HQ'.toText hqName) dep
+    pure . CompletionList isIncomplete . List $ defCompletionItems
  where
-    resultToCompletion :: Range -> Text -> FZF.FoundResult -> CompletionItem
-    resultToCompletion range prefix = \case
-      FZF.FoundTermResult (FZF.FoundTerm {namedTerm = Backend.NamedTerm {termName, termType}}) -> do
-        (mkCompletionItem (HQ'.toText termName))
-          { _detail = (": " <>) . Text.pack . Server.toPlain <$> termType,
-            _kind = Just CiVariable,
-            _insertText = Text.stripPrefix prefix (HQ'.toText termName),
-            _textEdit = Just $ CompletionEditText (TextEdit range (HQ'.toText termName))
-          }
-      FZF.FoundTypeResult (FZF.FoundType {namedType = Backend.NamedType {typeName, typeTag}}) ->
-        let (detail, kind) = case typeTag of
-              Backend.Ability -> ("Ability", CiInterface)
-              Backend.Data -> ("Data", CiClass)
-         in (mkCompletionItem (HQ'.toText typeName))
-              { _detail = Just detail,
-                _kind = Just kind
-              }
-    expand :: Range -> Text -> Lsp [CompletionItem]
-    expand range prefix = do
-      -- We should probably write a different fzf specifically for completion, but for now, it
-      -- expects the unique pieces of the query to be different "words".
-      let query = Text.unwords . Text.splitOn "." $ prefix
-      cb <- asks codebase
-      lspBackend (FZF.serveFuzzyFind cb Nothing Nothing Nothing Nothing (Just $ Text.unpack query)) >>= \case
-        Left _be -> pure []
-        Right results ->
-          pure . fmap (resultToCompletion range prefix . snd) . take 15 . sortOn (Fuzzy.score . fst) $ results
+    -- 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])
+    takeCompletions 0 xs = (not $ null xs, [])
+    takeCompletions _ [] = (False, [])
+    takeCompletions n (x : xs) = second (x :) $ takeCompletions (pred n) xs

-snippetCompletions :: Text -> Range -> [CompletionItem]
-snippetCompletions prefix range =
-  [ ("handler", handlerTemplate),
-    ("cases", casesTemplate),
-    ("match-with", matchWithTemplate)
-  ]
-    & filter (Text.isPrefixOf prefix . fst)
-    & fmap toCompletion
-  where
-    toCompletion :: (Text, Text) -> CompletionItem
-    toCompletion (pat, snippet) =
-      (mkCompletionItem pat)
-        { _insertTextFormat = Just Snippet,
-          _insertTextMode = Just AdjustIndentation,
-          _textEdit = Just $ CompletionEditText (TextEdit range snippet)
-        }
-    handlerTemplate =
-      [here|
-handle${1:Ability} : Request (${1:Ability} ${2}) a -> a
-handle${1:Ability} = cases
-  {${3} -> continue} -> do
-    ${4}
-    |]
-    casesTemplate =
-      [here|
-cases
-  ${1} -> do
-    ${2}
-    |]
-    matchWithTemplate =
-      [here|
-match ${1} with
-  ${2} -> do
-    ${3}
-    |]
-
-mkCompletionItem :: Text -> CompletionItem
-mkCompletionItem lbl =
+mkDefCompletionItem :: Range -> Text -> Text -> Text -> LabeledDependency -> CompletionItem
+mkDefCompletionItem range fqn path suffixified dep =
  CompletionItem
    { _label = lbl,
-      _kind = Nothing,
+      _kind = case dep of
+        LD.TypeReference _ref -> Just CiClass
+        LD.TermReferent ref -> case ref of
+          Referent.Con {} -> Just CiConstructor
+          Referent.Ref {} -> Just CiValue,
      _tags = Nothing,
-      _detail = Nothing,
+      _detail = Just fqn,
      _documentation = Nothing,
      _deprecated = Nothing,
      _preselect = Nothing,
      _sortText = Nothing,
-      _filterText = Nothing,
+      _filterText = Just path,
      _insertText = Nothing,
      _insertTextFormat = Nothing,
      _insertTextMode = Nothing,
-      _textEdit = Nothing,
+      _textEdit = Just (CompletionEditText $ TextEdit range suffixified),
      _additionalTextEdits = Nothing,
      _commitCharacters = Nothing,
      _command = Nothing,
      _xdata = Nothing
    }
+  where
+    -- 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.
+    --
+    -- E.g. if I type "ma" then the suffixied options might be: List.map, Bag.map, but the
+    -- path matches are just "map" and "map" since the query starts at that segment, so we
+    -- show the suffixified version to disambiguate.
+    --
+    -- However, if the user types "base.List.ma" then the matching path is "base.List.map" and
+    -- the suffixification is just "List.map", so we use the path in this case because it more
+    -- closely matches what the user actually typed.
+    --
+    -- This is what's felt best to me, anecdotally.
+    lbl =
+      if Text.length path > Text.length suffixified
+        then path
+        else suffixified
+
+-- | 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.
+--
+-- The tree is generated by building a trie where all possible suffixes of a name are
+-- reachable from the root of the trie, with sharing over subtrees to improve memory
+-- residency.
+--
+-- Currently we don't "summarize" all of the children of a node in the node itself, and
+-- instead you have to crawl all the children to get the actual completions.
+--
+-- TODO: Would it be worthwhile to perform compression or include child summaries on the suffix tree?
+-- I suspect most namespace trees won't actually compress very well since each node is likely
+-- to have terms/types at it.
+--
+-- E.g. From the names:
+-- * alpha.beta.Nat
+-- * alpha.Text
+-- * foxtrot.Text
+--
+-- It will generate a tree like the following, where each bullet is a possible completion:
+--
+-- .
+-- ├── foxtrot
+-- │   └── Text
+-- │       └── * foxtrot.Text (##Text)
+-- ├── beta
+-- │   └── Nat
+-- │       └── * alpha.beta.Nat (##Nat)
+-- ├── alpha
+-- │   ├── beta
+-- │   │   └── Nat
+-- │   │       └── * alpha.beta.Nat (##Nat)
+-- │   └── Text
+-- │       └── * alpha.Text (##Text)
+-- ├── Text
+-- │   ├── * foxtrot.Text (##Text)
+-- │   └── * alpha.Text (##Text)
+-- └── Nat
+--     └── * alpha.beta.Nat (##Nat)
+namesToCompletionTree :: Names -> CompletionTree
+namesToCompletionTree Names {terms, types} =
+  let typeCompls =
+        Relation.domain types
+          & ifoldMap
+            ( \name refs ->
+                refs
+                  & Monoid.whenM (not . isDefinitionDoc $ name)
+                  & Set.map \ref -> (name, LD.typeRef ref)
+            )
+      termCompls =
+        Relation.domain terms
+          & ifoldMap
+            ( \name refs ->
+                refs
+                  & Monoid.whenM (not . isDefinitionDoc $ name)
+                  & Set.map \ref -> (name, LD.referent ref)
+            )
+   in foldMap (uncurry nameToCompletionTree) (typeCompls <> termCompls)
+  where
+    -- It's  annoying to see _all_ the definition docs in autocomplete so we filter them out.
+    -- Special docs like "README" will still appear since they're not named 'doc'
+    isDefinitionDoc name =
+      case Name.reverseSegments name of
+        ("doc" :| _) -> True
+        _ -> False
+
+nameToCompletionTree :: Name -> LabeledDependency -> CompletionTree
+nameToCompletionTree name ref =
+  let (lastSegment :| prefix) = Name.reverseSegments name
+      complMap = helper (Map.singleton lastSegment (Set.singleton (name, ref) :< mempty)) prefix
+   in CompletionTree (mempty :< complMap)
+  where
+    -- We build the tree bottom-up rather than top-down so we can take 'share' submaps for
+    -- improved memory residency, each  call is passed the submap that we built under the
+    -- current reversed path prefix.
+    helper ::
+      Map
+        NameSegment
+        (Cofree (Map NameSegment) (Set (Name, LabeledDependency))) ->
+      [NameSegment] ->
+      Map
+        NameSegment
+        (Cofree (Map NameSegment) (Set (Name, LabeledDependency)))
+    helper subMap revPrefix = case revPrefix of
+      [] -> subMap
+      (ns : rest) ->
+        mergeSubmaps (helper (Map.singleton ns (mempty :< subMap)) rest) subMap
+      where
+        mergeSubmaps = Map.unionWith (\a b -> unCompletionTree $ CompletionTree a <> CompletionTree b)
+
+-- | Crawl the completion tree and return all valid prefix-based completions alongside their
+-- Path from the provided prefix, and their full name.
+--
+-- E.g. if the term "alpha.beta.gamma.map (#abc)" exists in the completion map, and the query is "beta" the result would
+-- be:
+--
+-- @@
+-- [(["beta", "gamma", "map"], "alpha.beta.gamma.map", TermReferent #abc)]
+-- @@
+matchCompletions :: CompletionTree -> Text -> [(Path, Name, LabeledDependency)]
+matchCompletions (CompletionTree tree) txt =
+  matchSegments segments (Set.toList <$> tree)
+  where
+    segments :: [Text]
+    segments =
+      Text.splitOn "." txt
+        & filter (not . Text.null)
+    matchSegments :: [Text] -> Cofree (Map NameSegment) [(Name, LabeledDependency)] -> [(Path, Name, LabeledDependency)]
+    matchSegments xs (currentMatches :< subtreeMap) =
+      case xs of
+        [] ->
+          let current = currentMatches <&> (\(name, def) -> (Path.empty, name, def))
+           in (current <> mkDefMatches subtreeMap)
+        [prefix] ->
+          Map.dropWhileAntitone ((< prefix) . NameSegment.toText) subtreeMap
+            & Map.takeWhileAntitone (Text.isPrefixOf prefix . NameSegment.toText)
+            & \matchingSubtrees ->
+              let subMatches = ifoldMap (\ns subTree -> matchSegments [] subTree & consPathPrefix ns) matchingSubtrees
+               in subMatches
+        (ns : rest) ->
+          foldMap (matchSegments rest) (Map.lookup (NameSegment ns) subtreeMap)
+            & consPathPrefix (NameSegment ns)
+    consPathPrefix :: NameSegment -> ([(Path, Name, LabeledDependency)]) -> [(Path, Name, LabeledDependency)]
+    consPathPrefix ns = over (mapped . _1) (Path.cons ns)
+    mkDefMatches :: Map NameSegment (Cofree (Map NameSegment) [(Name, LabeledDependency)]) -> [(Path, Name, LabeledDependency)]
+    mkDefMatches xs = do
+      (ns, (matches :< rest)) <- Map.toList xs
+      let childMatches = mkDefMatches rest <&> over _1 (Path.cons ns)
+      let currentMatches = matches <&> \(name, dep) -> (Path.singleton ns, name, dep)
+      currentMatches <> childMatches
--- a/unison-cli/src/Unison/LSP/Configuration.hs
+++ b/unison-cli/src/Unison/LSP/Configuration.hs
@ -0,0 +1,23 @@
+{-# LANGUAGE DataKinds #-}
+
+module Unison.LSP.Configuration where
+
+import Data.Aeson
+import qualified Data.Text as Text
+import Language.LSP.Types
+import qualified Unison.Debug as Debug
+import Unison.LSP.Types
+import Unison.Prelude
+
+-- | Handle configuration changes
+updateConfig :: Config -> Value -> Either Text Config
+updateConfig _oldConfig newConfig = Debug.debug Debug.LSP "Configuration Change" $ case fromJSON newConfig of
+  Error err -> Left $ Text.pack err
+  Success a -> Right a
+
+-- | We could use this notification to cancel/update work-in-progress,
+-- but we don't actually need to update the config here, that's handled by the lsp library
+-- automatically.
+workspaceConfigurationChanged :: NotificationMessage 'WorkspaceDidChangeConfiguration -> Lsp ()
+workspaceConfigurationChanged _m = do
+  pure ()
--- a/unison-cli/src/Unison/LSP/Diagnostics.hs
+++ b/unison-cli/src/Unison/LSP/Diagnostics.hs
@ -33,7 +33,7 @@ reportDiagnostics ::
  f Diagnostic ->
  Lsp ()
 reportDiagnostics docUri fileVersion diags = do
-  let jsonRPC = "" -- TODO: what's this for?
+  let jsonRPC = "2.0"
  let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = List . toList $ diags}
  sendNotification (NotificationMessage jsonRPC STextDocumentPublishDiagnostics params)

--- a/unison-cli/src/Unison/LSP/Types.hs
+++ b/unison-cli/src/Unison/LSP/Types.hs
@ -1,19 +1,28 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE UndecidableInstances #-}

 module Unison.LSP.Types where

 import Colog.Core hiding (Lens')
-import Control.Lens hiding (List)
+import Control.Comonad.Cofree (Cofree)
+import qualified Control.Comonad.Cofree as Cofree
+import Control.Lens hiding (List, (:<))
 import Control.Monad.Except
 import Control.Monad.Reader
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Lazy.Char8 as BSC
 import qualified Data.HashMap.Strict as HM
 import Data.IntervalMap.Lazy (IntervalMap)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Data.Text as Text
 import qualified Ki
 import qualified Language.LSP.Logging as LSP
 import Language.LSP.Server
+import qualified Language.LSP.Server as LSP
 import Language.LSP.Types
 import Language.LSP.Types.Lens
 import Language.LSP.VFS
@ -21,6 +30,9 @@ import Unison.Codebase
 import qualified Unison.Codebase.Path as Path
 import Unison.Codebase.Runtime (Runtime)
 import Unison.LSP.Orphans ()
+import Unison.LabeledDependency (LabeledDependency)
+import Unison.Name (Name)
+import Unison.NameSegment (NameSegment)
 import Unison.NamesWithHistory (NamesWithHistory)
 import Unison.Parser.Ann
 import Unison.Prelude
@ -65,9 +77,25 @@ data Env = Env
    dirtyFilesVar :: TVar (Set Uri),
    -- A map  of request IDs to an action which kills that request.
    cancellationMapVar :: TVar (Map SomeLspId (IO ())),
+    -- A lazily computed map of all valid completion suffixes from the current path.
+    completionsVar :: TVar CompletionTree,
    scope :: Ki.Scope
  }

+-- | A suffix tree over path segments of name completions.
+-- see 'namesToCompletionTree' for more on how this is built and the invariants it should have.
+newtype CompletionTree = CompletionTree
+  { unCompletionTree :: Cofree (Map NameSegment) (Set (Name, LabeledDependency))
+  }
+  deriving (Show)
+
+instance Semigroup CompletionTree where
+  CompletionTree (a Cofree.:< subtreeA) <> CompletionTree (b Cofree.:< subtreeB) =
+    CompletionTree (a <> b Cofree.:< Map.unionWith (\a b -> unCompletionTree $ CompletionTree a <> CompletionTree b) subtreeA subtreeB)
+
+instance Monoid CompletionTree where
+  mempty = CompletionTree $ mempty Cofree.:< mempty
+
 -- | A monotonically increasing file version tracked by the lsp client.
 type FileVersion = Int32

@ -88,6 +116,9 @@ data FileAnalysis = FileAnalysis
 getCurrentPath :: Lsp Path.Absolute
 getCurrentPath = asks currentPathCache >>= liftIO

+getCompletions :: Lsp CompletionTree
+getCompletions = asks completionsVar >>= readTVarIO
+
 globalPPE :: Lsp PrettyPrintEnvDecl
 globalPPE = asks ppeCache >>= liftIO

@ -95,6 +126,41 @@ getParseNames :: Lsp NamesWithHistory
 getParseNames = asks parseNamesCache >>= liftIO

 data Config = Config
+  { -- 'Nothing' will load ALL available completions, which is slower, but may provide a better
+    -- solution for some users.
+    --
+    -- 'Just n' will only fetch the first 'n' completions and will prompt the client to ask for
+    -- more completions after more typing.
+    maxCompletions :: Maybe Int
+  }
+  deriving stock (Show)
+
+instance Aeson.FromJSON Config where
+  parseJSON = Aeson.withObject "Config" \obj -> do
+    maxCompletions <- obj Aeson..:! "maxCompletions" Aeson..!= maxCompletions defaultLSPConfig
+    let invalidKeys = Set.fromList (HM.keys obj) `Set.difference` validKeys
+    when (not . null $ invalidKeys) do
+      fail . Text.unpack $
+        "Unrecognized configuration key(s): "
+          <> Text.intercalate ", " (Set.toList invalidKeys)
+          <> ".\nThe default configuration is:\n"
+          <> Text.pack defaultConfigExample
+    pure Config {..}
+    where
+      validKeys = Set.fromList ["maxCompletions"]
+      defaultConfigExample =
+        BSC.unpack $ Aeson.encode defaultLSPConfig
+
+instance Aeson.ToJSON Config where
+  toJSON (Config maxCompletions) =
+    Aeson.object
+      [ "maxCompletions" Aeson..= maxCompletions
+      ]
+
+defaultLSPConfig :: Config
+defaultLSPConfig = Config {..}
+  where
+    maxCompletions = Just 100

 -- | Lift a backend computation into the Lsp monad.
 lspBackend :: Backend.Backend IO a -> Lsp (Either Backend.BackendError a)
@ -142,3 +208,9 @@ includeEdits uri replacement ranges rca =
            _changeAnnotations = Nothing
          }
   in rca & codeAction . edit ?~ workspaceEdit
+
+getConfig :: Lsp Config
+getConfig = LSP.getConfig
+
+setConfig :: Config -> Lsp ()
+setConfig = LSP.setConfig
--- a/unison-cli/src/Unison/LSP/UCMWorker.hs
+++ b/unison-cli/src/Unison/LSP/UCMWorker.hs
@ -5,9 +5,11 @@ import qualified Unison.Codebase as Codebase
 import Unison.Codebase.Branch (Branch)
 import qualified Unison.Codebase.Path as Path
 import qualified Unison.Debug as Debug
+import Unison.LSP.Completion
 import Unison.LSP.Types
 import qualified Unison.LSP.VFS as VFS
 import Unison.NamesWithHistory (NamesWithHistory)
+import qualified Unison.NamesWithHistory as NamesWithHistory
 import Unison.PrettyPrintEnvDecl
 import qualified Unison.PrettyPrintEnvDecl.Names as PPE
 import qualified Unison.Server.Backend as Backend
@ -21,7 +23,7 @@ ucmWorker ::
  STM Path.Absolute ->
  Lsp ()
 ucmWorker ppeVar parseNamesVar getLatestRoot getLatestPath = do
-  Env {codebase} <- ask
+  Env {codebase, completionsVar} <- ask
  let loop :: (Branch IO, Path.Absolute) -> Lsp a
      loop (currentRoot, currentPath) = do
        Debug.debugM Debug.LSP "LSP path: " currentPath
@ -33,6 +35,8 @@ ucmWorker ppeVar parseNamesVar getLatestRoot getLatestPath = do
          writeTVar ppeVar ppe
        -- Re-check everything with the new names and ppe
        VFS.markAllFilesDirty
+        atomically do
+          writeTVar completionsVar (namesToCompletionTree $ NamesWithHistory.currentNames parseNames)
        latest <- atomically $ do
          latestRoot <- getLatestRoot
          latestPath <- getLatestPath
--- a/unison-cli/unison-cli.cabal
+++ b/unison-cli/unison-cli.cabal
@ -72,6 +72,7 @@ library
      Unison.LSP.CancelRequest
      Unison.LSP.CodeAction
      Unison.LSP.Completion
+      Unison.LSP.Configuration
      Unison.LSP.Conversions
      Unison.LSP.Diagnostics
      Unison.LSP.FileAnalysis
@ -140,6 +141,7 @@ library
    , exceptions
    , extra
    , filepath
+    , free
    , friendly-time
    , fuzzyfind
    , generic-lens
@ -261,6 +263,7 @@ executable cli-integration-tests
    , exceptions
    , extra
    , filepath
+    , free
    , friendly-time
    , fuzzyfind
    , generic-lens
@ -377,6 +380,7 @@ executable transcripts
    , exceptions
    , extra
    , filepath
+    , free
    , friendly-time
    , fuzzyfind
    , generic-lens
@ -497,6 +501,7 @@ executable unison
    , exceptions
    , extra
    , filepath
+    , free
    , friendly-time
    , fuzzyfind
    , generic-lens
@ -624,6 +629,7 @@ test-suite cli-tests
    , exceptions
    , extra
    , filepath
+    , free
    , friendly-time
    , fuzzyfind
    , generic-lens