mirror of
https://github.com/unisonweb/unison.git
synced 2024-09-11 10:35:57 +03:00
Bump LSP lib versions (#4262)
* Upgrading to lsp-2.* support * Upgrade imports to lsp 2 * Starting port to 2.0 * More porting to v2 * Lock down version hashes
This commit is contained in:
parent
9303895b03
commit
26944f55fc
@ -59,6 +59,9 @@ extra-deps:
|
||||
- lock-file-0.7.0.0@sha256:3ad84b5e454145e1d928063b56abb96db24a99a21b493989520e58fa0ab37b00,4484
|
||||
- monad-validate-1.2.0.0@sha256:9850f408431098b28806dd464b6825a88a0b56c84f380d7fe0454c1df9d6f881,3505
|
||||
- recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529
|
||||
- lsp-types-2.0.1.1@sha256:fdc9e7569d5b55352ab856510b9727dd859ab6b836f276cb20b288834bca66d6,29317
|
||||
- lsp-2.0.0.0@sha256:80d7e84f79a2c8a8ee17d83ee157ed3c9b25c1716bad31dabd704bb793d32af0,3531
|
||||
- row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071
|
||||
|
||||
ghc-options:
|
||||
# All packages
|
||||
|
@ -61,6 +61,27 @@ packages:
|
||||
size: 2488
|
||||
original:
|
||||
hackage: recover-rtti-0.4.2@sha256:c179a303921126d8d782264e14f386c96e54a270df74be002e4c4ec3c8c7aebd,4529
|
||||
- completed:
|
||||
hackage: lsp-types-2.0.1.1@sha256:fdc9e7569d5b55352ab856510b9727dd859ab6b836f276cb20b288834bca66d6,29317
|
||||
pantry-tree:
|
||||
sha256: 6595878012dbb7d4520ed611d45a59d476d0de7504bbb5977b70e4fe19f3fd75
|
||||
size: 45523
|
||||
original:
|
||||
hackage: lsp-types-2.0.1.1@sha256:fdc9e7569d5b55352ab856510b9727dd859ab6b836f276cb20b288834bca66d6,29317
|
||||
- completed:
|
||||
hackage: lsp-2.0.0.0@sha256:80d7e84f79a2c8a8ee17d83ee157ed3c9b25c1716bad31dabd704bb793d32af0,3531
|
||||
pantry-tree:
|
||||
sha256: 242117f7c11289acb56dcb1779efcc335ef88c0e773dd7087dca1c3a13870bba
|
||||
size: 1043
|
||||
original:
|
||||
hackage: lsp-2.0.0.0@sha256:80d7e84f79a2c8a8ee17d83ee157ed3c9b25c1716bad31dabd704bb793d32af0,3531
|
||||
- completed:
|
||||
hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071
|
||||
pantry-tree:
|
||||
sha256: 6a3617038d3970095100d14d026c396002a115700500cf3004ffb67ae5a75611
|
||||
size: 1060
|
||||
original:
|
||||
hackage: row-types-1.0.1.2@sha256:4d4c7cb95d06a32b28ba977852d52a26b4c1f695ef083a6fd874ab6d79933b64,3071
|
||||
snapshots:
|
||||
- completed:
|
||||
sha256: 5a59b2a405b3aba3c00188453be172b85893cab8ebc352b1ef58b0eae5d248a2
|
||||
|
@ -42,8 +42,8 @@ dependencies:
|
||||
- ki
|
||||
- lens
|
||||
- lock-file
|
||||
- lsp >= 1.5.0.0
|
||||
- lsp-types >= 1.5.0.0
|
||||
- lsp >= 2.0.0.0
|
||||
- lsp-types >= 2.0.0.0
|
||||
- megaparsec
|
||||
- memory
|
||||
- mtl
|
||||
|
@ -14,10 +14,11 @@ import Data.Char (toLower)
|
||||
import GHC.IO.Exception (ioe_errno)
|
||||
import Ki qualified
|
||||
import Language.LSP.Logging qualified as LSP
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Language.LSP.Protocol.Utils.SMethodMap
|
||||
import Language.LSP.Protocol.Utils.SMethodMap qualified as SMM
|
||||
import Language.LSP.Server
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.SMethodMap
|
||||
import Language.LSP.Types.SMethodMap qualified as SMM
|
||||
import Language.LSP.VFS
|
||||
import Network.Simple.TCP qualified as TCP
|
||||
import System.Environment (lookupEnv)
|
||||
@ -127,8 +128,8 @@ lspDoInitialize ::
|
||||
STM (Branch IO) ->
|
||||
STM (Path.Absolute) ->
|
||||
LanguageContextEnv Config ->
|
||||
Message 'Initialize ->
|
||||
IO (Either ResponseError Env)
|
||||
Msg.TMessage 'Msg.Method_Initialize ->
|
||||
IO (Either Msg.ResponseError Env)
|
||||
lspDoInitialize vfsVar codebase runtime scope latestBranch latestPath lspContext _initMsg = do
|
||||
-- TODO: some of these should probably be MVars so that we correctly wait for names and
|
||||
-- things to be generated before serving requests.
|
||||
@ -155,26 +156,26 @@ lspStaticHandlers =
|
||||
}
|
||||
|
||||
-- | LSP request handlers
|
||||
lspRequestHandlers :: SMethodMap (ClientMessageHandler Lsp 'Request)
|
||||
lspRequestHandlers :: SMethodMap (ClientMessageHandler Lsp 'Msg.Request)
|
||||
lspRequestHandlers =
|
||||
mempty
|
||||
& SMM.insert STextDocumentHover (mkHandler hoverHandler)
|
||||
& SMM.insert STextDocumentCodeAction (mkHandler codeActionHandler)
|
||||
& SMM.insert STextDocumentCodeLens (mkHandler codeLensHandler)
|
||||
& SMM.insert SWorkspaceExecuteCommand (mkHandler executeCommandHandler)
|
||||
& SMM.insert STextDocumentFoldingRange (mkHandler foldingRangeRequest)
|
||||
& SMM.insert STextDocumentCompletion (mkHandler completionHandler)
|
||||
& SMM.insert SCompletionItemResolve (mkHandler completionItemResolveHandler)
|
||||
& SMM.insert Msg.SMethod_TextDocumentHover (mkHandler hoverHandler)
|
||||
& SMM.insert Msg.SMethod_TextDocumentCodeAction (mkHandler codeActionHandler)
|
||||
& SMM.insert Msg.SMethod_TextDocumentCodeLens (mkHandler codeLensHandler)
|
||||
& SMM.insert Msg.SMethod_WorkspaceExecuteCommand (mkHandler executeCommandHandler)
|
||||
& SMM.insert Msg.SMethod_TextDocumentFoldingRange (mkHandler foldingRangeRequest)
|
||||
& SMM.insert Msg.SMethod_TextDocumentCompletion (mkHandler completionHandler)
|
||||
& SMM.insert Msg.SMethod_CompletionItemResolve (mkHandler completionItemResolveHandler)
|
||||
where
|
||||
defaultTimeout = 10_000 -- 10s
|
||||
mkHandler ::
|
||||
forall m.
|
||||
(Show (RequestMessage m), Show (ResponseMessage m), Show (ResponseResult m)) =>
|
||||
( ( RequestMessage m ->
|
||||
(Either ResponseError (ResponseResult m) -> Lsp ()) ->
|
||||
(Show (Msg.TRequestMessage m), Show (Msg.TResponseMessage m), Show (Msg.MessageResult m)) =>
|
||||
( ( Msg.TRequestMessage m ->
|
||||
(Either Msg.ResponseError (Msg.MessageResult m) -> Lsp ()) ->
|
||||
Lsp ()
|
||||
) ->
|
||||
ClientMessageHandler Lsp 'Request m
|
||||
ClientMessageHandler Lsp 'Msg.Request m
|
||||
)
|
||||
mkHandler h =
|
||||
h
|
||||
@ -183,15 +184,15 @@ lspRequestHandlers =
|
||||
& ClientMessageHandler
|
||||
|
||||
-- | LSP notification handlers
|
||||
lspNotificationHandlers :: SMethodMap (ClientMessageHandler Lsp 'Notification)
|
||||
lspNotificationHandlers :: SMethodMap (ClientMessageHandler Lsp 'Msg.Notification)
|
||||
lspNotificationHandlers =
|
||||
mempty
|
||||
& SMM.insert STextDocumentDidOpen (ClientMessageHandler VFS.lspOpenFile)
|
||||
& SMM.insert STextDocumentDidClose (ClientMessageHandler VFS.lspCloseFile)
|
||||
& 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)
|
||||
& SMM.insert Msg.SMethod_TextDocumentDidOpen (ClientMessageHandler VFS.lspOpenFile)
|
||||
& SMM.insert Msg.SMethod_TextDocumentDidClose (ClientMessageHandler VFS.lspCloseFile)
|
||||
& SMM.insert Msg.SMethod_TextDocumentDidChange (ClientMessageHandler VFS.lspChangeFile)
|
||||
& SMM.insert Msg.SMethod_Initialized (ClientMessageHandler Notifications.initializedHandler)
|
||||
& SMM.insert Msg.SMethod_CancelRequest (ClientMessageHandler $ Notifications.withDebugging cancelRequestHandler)
|
||||
& SMM.insert Msg.SMethod_WorkspaceDidChangeConfiguration (ClientMessageHandler Config.workspaceConfigurationChanged)
|
||||
|
||||
-- | A natural transformation into IO, required by the LSP lib.
|
||||
lspInterpretHandler :: Env -> Lsp <~> IO
|
||||
@ -205,8 +206,8 @@ lspInterpretHandler env@(Env {lspContext}) =
|
||||
lspOptions :: Options
|
||||
lspOptions =
|
||||
defaultOptions
|
||||
{ textDocumentSync = Just $ textDocSyncOptions,
|
||||
executeCommandCommands = Just supportedCommands
|
||||
{ optTextDocumentSync = Just $ textDocSyncOptions,
|
||||
optExecuteCommandCommands = Just supportedCommands
|
||||
}
|
||||
where
|
||||
textDocSyncOptions =
|
||||
@ -214,7 +215,7 @@ lspOptions =
|
||||
{ -- Clients should send file open/close messages so the VFS can handle them
|
||||
_openClose = Just True,
|
||||
-- Clients should send file change messages so the VFS can handle them
|
||||
_change = Just TdSyncIncremental,
|
||||
_change = Just TextDocumentSyncKind_Incremental,
|
||||
-- Clients should tell us when files are saved
|
||||
_willSave = Just False,
|
||||
-- If we implement a pre-save hook we can enable this.
|
||||
|
@ -7,17 +7,18 @@ module Unison.LSP.CancelRequest where
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader
|
||||
import Data.Map qualified as Map
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens as LSP
|
||||
import Language.LSP.Protocol.Lens as LSP
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.LSP.Types
|
||||
import UnliftIO.STM
|
||||
|
||||
-- | Allows a client to cancel work from a previous request.
|
||||
cancelRequestHandler :: NotificationMessage 'CancelRequest -> Lsp ()
|
||||
cancelRequestHandler :: Msg.TNotificationMessage 'Msg.Method_CancelRequest -> Lsp ()
|
||||
cancelRequestHandler m = do
|
||||
cancelMap <- asks cancellationMapVar >>= readTVarIO
|
||||
let reqId' = case m ^. params of
|
||||
CancelParams id' -> SomeLspId id'
|
||||
CancelParams id' -> id'
|
||||
case Map.lookup reqId' cancelMap of
|
||||
Just cancel -> liftIO cancel
|
||||
Nothing -> pure ()
|
||||
|
@ -6,8 +6,9 @@ module Unison.LSP.CodeAction where
|
||||
|
||||
import Control.Lens hiding (List)
|
||||
import Data.IntervalMap qualified as IM
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Language.LSP.Protocol.Lens
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.LSP.Conversions
|
||||
import Unison.LSP.FileAnalysis
|
||||
@ -15,9 +16,9 @@ import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
|
||||
-- | Computes code actions for a document.
|
||||
codeActionHandler :: RequestMessage 'TextDocumentCodeAction -> (Either ResponseError (ResponseResult 'TextDocumentCodeAction) -> Lsp ()) -> Lsp ()
|
||||
codeActionHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentCodeAction -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentCodeAction) -> Lsp ()) -> Lsp ()
|
||||
codeActionHandler m respond =
|
||||
respond . maybe (Right mempty) (Right . List . fmap InR) =<< runMaybeT do
|
||||
respond . maybe (Right $ InL mempty) (Right . InL . fmap InR) =<< runMaybeT do
|
||||
FileAnalysis {codeActions} <- getFileAnalysis (m ^. params . textDocument . uri)
|
||||
let r = m ^. params . range
|
||||
let relevantActions = IM.intersecting codeActions (rangeToInterval r)
|
||||
|
@ -1,6 +1,7 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Unison.LSP.CodeLens where
|
||||
|
||||
@ -9,8 +10,9 @@ import Control.Monad.Except
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.Map qualified as Map
|
||||
import Data.Text qualified as Text
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Language.LSP.Protocol.Lens hiding (error)
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.LSP.Commands (TextReplacement (TextReplacement), replaceText)
|
||||
import Unison.LSP.FileAnalysis
|
||||
@ -45,9 +47,9 @@ instance Aeson.FromJSON TypeSigInsertion where
|
||||
Aeson..: "fileUri"
|
||||
|
||||
-- | Computes code actions for a document.
|
||||
codeLensHandler :: RequestMessage 'TextDocumentCodeLens -> (Either ResponseError (List CodeLens) -> Lsp ()) -> Lsp ()
|
||||
codeLensHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentCodeLens -> (Either Msg.ResponseError ([CodeLens] |? Null) -> Lsp ()) -> Lsp ()
|
||||
codeLensHandler m respond =
|
||||
respond . maybe (Right mempty) Right =<< runMaybeT do
|
||||
respond . maybe (Right $ InL mempty) Right =<< runMaybeT do
|
||||
let fileUri = m ^. params . textDocument . uri
|
||||
FileAnalysis {typeSignatureHints} <- getFileAnalysis fileUri
|
||||
codeLenses <- ifor typeSignatureHints \_v (TypeSignatureHint name ref range typ) -> do
|
||||
@ -64,4 +66,4 @@ codeLensHandler m respond =
|
||||
range
|
||||
(Just $ replaceText rendered $ TextReplacement insertLocation "Insert type signature" (rendered <> "\n") fileUri)
|
||||
Nothing
|
||||
pure (List (Map.elems codeLenses))
|
||||
pure (InL $ Map.elems codeLenses)
|
||||
|
@ -1,16 +1,18 @@
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE QuasiQuotes #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Unison.LSP.Commands where
|
||||
|
||||
import Control.Lens hiding (List)
|
||||
import Control.Monad.Except
|
||||
import Data.Aeson qualified as Aeson
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
import Data.Map qualified as Map
|
||||
import Language.LSP.Protocol.Lens
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Language.LSP.Server (sendRequest)
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
@ -23,7 +25,7 @@ replaceText ::
|
||||
Text ->
|
||||
TextReplacement ->
|
||||
Command
|
||||
replaceText title tr = Command title "replaceText" (Just (List [Aeson.toJSON tr]))
|
||||
replaceText title tr = Command title "replaceText" (Just [Aeson.toJSON tr])
|
||||
|
||||
data TextReplacement = TextReplacement
|
||||
{ range :: Range,
|
||||
@ -55,24 +57,24 @@ instance Aeson.FromJSON TextReplacement where
|
||||
Aeson..: "fileUri"
|
||||
|
||||
-- | Computes code actions for a document.
|
||||
executeCommandHandler :: RequestMessage 'WorkspaceExecuteCommand -> (Either ResponseError Aeson.Value -> Lsp ()) -> Lsp ()
|
||||
executeCommandHandler :: Msg.TRequestMessage 'Msg.Method_WorkspaceExecuteCommand -> (Either Msg.ResponseError (Aeson.Value |? Null) -> Lsp ()) -> Lsp ()
|
||||
executeCommandHandler m respond =
|
||||
respond =<< runExceptT do
|
||||
let cmd = m ^. params . command
|
||||
let args = m ^. params . arguments
|
||||
let invalidCmdErr = throwError $ ResponseError InvalidParams "Invalid command" Nothing
|
||||
let invalidCmdErr = throwError $ Msg.ResponseError (InR ErrorCodes_InvalidParams) "Invalid command" Nothing
|
||||
case cmd of
|
||||
"replaceText" -> case args of
|
||||
Just (List [Aeson.fromJSON -> Aeson.Success (TextReplacement range description replacementText fileUri)]) -> do
|
||||
Just [Aeson.fromJSON -> Aeson.Success (TextReplacement range description replacementText fileUri)] -> do
|
||||
let params =
|
||||
ApplyWorkspaceEditParams
|
||||
(Just description)
|
||||
(WorkspaceEdit (Just ((HM.singleton fileUri (List [TextEdit range replacementText])))) Nothing Nothing)
|
||||
(WorkspaceEdit (Just ((Map.singleton fileUri [TextEdit range replacementText]))) Nothing Nothing)
|
||||
lift
|
||||
( sendRequest SWorkspaceApplyEdit params $ \case
|
||||
( sendRequest Msg.SMethod_WorkspaceApplyEdit params $ \case
|
||||
Left err -> Debug.debugM Debug.LSP "Error applying workspace edit" err
|
||||
Right _ -> pure ()
|
||||
)
|
||||
_ -> invalidCmdErr
|
||||
_ -> invalidCmdErr
|
||||
pure Aeson.Null
|
||||
pure $ InL Aeson.Null
|
||||
|
@ -15,8 +15,9 @@ import Data.List.NonEmpty (NonEmpty (..))
|
||||
import Data.Map qualified as Map
|
||||
import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Language.LSP.Protocol.Lens
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.Codebase.Path (Path)
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
import Unison.HashQualified qualified as HQ
|
||||
@ -47,9 +48,9 @@ import Unison.Util.Pretty qualified as Pretty
|
||||
import Unison.Util.Relation qualified as Relation
|
||||
import UnliftIO qualified
|
||||
|
||||
completionHandler :: RequestMessage 'TextDocumentCompletion -> (Either ResponseError (ResponseResult 'TextDocumentCompletion) -> Lsp ()) -> Lsp ()
|
||||
completionHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentCompletion -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentCompletion) -> Lsp ()) -> Lsp ()
|
||||
completionHandler m respond =
|
||||
respond . maybe (Right $ InL mempty) (Right . InR) =<< runMaybeT do
|
||||
respond . maybe (Right $ InL mempty) (Right . InR . InL) =<< runMaybeT do
|
||||
let fileUri = (m ^. params . textDocument . uri)
|
||||
(range, prefix) <- VFS.completionPrefix (m ^. params . textDocument . uri) (m ^. params . position)
|
||||
ppe <- PPED.suffixifiedPPE <$> lift globalPPED
|
||||
@ -69,7 +70,8 @@ completionHandler m respond =
|
||||
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
|
||||
pure . CompletionList isIncomplete . List $ defCompletionItems
|
||||
let itemDefaults = Nothing
|
||||
pure . CompletionList isIncomplete itemDefaults $ defCompletionItems
|
||||
where
|
||||
-- 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.
|
||||
@ -82,11 +84,12 @@ mkDefCompletionItem :: Uri -> Range -> Name -> Name -> Text -> Text -> LabeledDe
|
||||
mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixified dep =
|
||||
CompletionItem
|
||||
{ _label = lbl,
|
||||
_labelDetails = Nothing,
|
||||
_kind = case dep of
|
||||
LD.TypeReference _ref -> Just CiClass
|
||||
LD.TypeReference _ref -> Just CompletionItemKind_Class
|
||||
LD.TermReferent ref -> case ref of
|
||||
Referent.Con {} -> Just CiConstructor
|
||||
Referent.Ref {} -> Just CiValue,
|
||||
Referent.Con {} -> Just CompletionItemKind_Constructor
|
||||
Referent.Ref {} -> Just CompletionItemKind_Value,
|
||||
_tags = Nothing,
|
||||
_detail = Just (Name.toText fullyQualifiedName),
|
||||
_documentation = Nothing,
|
||||
@ -97,11 +100,12 @@ mkDefCompletionItem fileUri range relativeName fullyQualifiedName path suffixifi
|
||||
_insertText = Nothing,
|
||||
_insertTextFormat = Nothing,
|
||||
_insertTextMode = Nothing,
|
||||
_textEdit = Just (CompletionEditText $ TextEdit range suffixified),
|
||||
_textEdit = Just (InL $ TextEdit range suffixified),
|
||||
_textEditText = Nothing,
|
||||
_additionalTextEdits = Nothing,
|
||||
_commitCharacters = Nothing,
|
||||
_command = Nothing,
|
||||
_xdata = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri}
|
||||
_data_ = Just $ Aeson.toJSON $ CompletionItemDetails {dep, relativeName, fullyQualifiedName, fileUri}
|
||||
}
|
||||
where
|
||||
-- We should generally show the longer of the path or suffixified name in the label,
|
||||
@ -255,12 +259,12 @@ matchCompletions (CompletionTree tree) txt =
|
||||
currentMatches <> childMatches
|
||||
|
||||
-- | Called to resolve additional details for a completion item that the user is considering.
|
||||
completionItemResolveHandler :: RequestMessage 'CompletionItemResolve -> (Either ResponseError CompletionItem -> Lsp ()) -> Lsp ()
|
||||
completionItemResolveHandler :: Msg.TRequestMessage 'Msg.Method_CompletionItemResolve -> (Either Msg.ResponseError CompletionItem -> Lsp ()) -> Lsp ()
|
||||
completionItemResolveHandler message respond = do
|
||||
let completion :: CompletionItem
|
||||
completion = message ^. params
|
||||
respond . maybe (Right completion) Right =<< runMaybeT do
|
||||
case Aeson.fromJSON <$> (completion ^. xdata) of
|
||||
case Aeson.fromJSON <$> (completion ^. data_) of
|
||||
Just (Aeson.Success (CompletionItemDetails {dep, fullyQualifiedName, relativeName, fileUri})) -> do
|
||||
pped <- lift $ ppedForFile fileUri
|
||||
|
||||
@ -292,22 +296,22 @@ completionItemResolveHandler message respond = do
|
||||
LD.TermReferent ref -> do
|
||||
typ <- LSPQ.getTypeOfReferent fileUri ref
|
||||
let renderedType = ": " <> (Text.pack $ TypePrinter.prettyStr (Just typeWidth) (PPED.suffixifiedPPE pped) typ)
|
||||
let doc = CompletionDocMarkup $ toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
pure $ (completion {_detail = Just renderedType, _documentation = Just doc} :: CompletionItem)
|
||||
LD.TypeReference ref ->
|
||||
case ref of
|
||||
Reference.Builtin {} -> do
|
||||
let renderedBuiltin = ": <builtin>"
|
||||
let doc = CompletionDocMarkup $ toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
pure $ (completion {_detail = Just renderedBuiltin, _documentation = Just doc} :: CompletionItem)
|
||||
Reference.DerivedId refId -> do
|
||||
decl <- LSPQ.getTypeDeclaration fileUri refId
|
||||
let renderedDecl = ": " <> (Text.pack . Pretty.toPlain typeWidth . Pretty.syntaxToColor $ DeclPrinter.prettyDecl pped ref (HQ.NameOnly relativeName) decl)
|
||||
let doc = CompletionDocMarkup $ toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
let doc = toMarkup (Text.unlines $ ["```unison", Name.toText fullyQualifiedName, "```"] ++ renderedDocs)
|
||||
pure $ (completion {_detail = Just renderedDecl, _documentation = Just doc} :: CompletionItem)
|
||||
_ -> empty
|
||||
where
|
||||
toMarkup txt = MarkupContent {_kind = MkMarkdown, _value = txt}
|
||||
toMarkup txt = InR $ MarkupContent {_kind = MarkupKind_Markdown, _value = txt}
|
||||
-- Completion windows can be very small, so this seems like a good default
|
||||
typeWidth = Pretty.Width 20
|
||||
|
||||
|
@ -4,7 +4,7 @@ module Unison.LSP.Configuration where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Text qualified as Text
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
@ -18,6 +18,6 @@ updateConfig _oldConfig newConfig = Debug.debug Debug.LSP "Configuration Change"
|
||||
-- | 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 :: Msg.TNotificationMessage 'Msg.Method_WorkspaceDidChangeConfiguration -> Lsp ()
|
||||
workspaceConfigurationChanged _m = do
|
||||
pure ()
|
||||
|
@ -2,7 +2,7 @@ module Unison.LSP.Conversions where
|
||||
|
||||
import Control.Lens
|
||||
import Data.IntervalMap.Interval qualified as Interval
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.LSP.Orphans ()
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Parser.Ann qualified as Ann
|
||||
@ -24,10 +24,10 @@ uToLspPos uPos =
|
||||
}
|
||||
|
||||
lspToUPos :: Position -> Lex.Pos
|
||||
lspToUPos lspPos =
|
||||
lspToUPos Position {_line = line, _character = char} =
|
||||
Lex.Pos
|
||||
(fromIntegral $ _line lspPos + 1) -- 1 indexed vs 0 indexed
|
||||
(fromIntegral $ _character lspPos + 1)
|
||||
(fromIntegral $ line + 1) -- 1 indexed vs 0 indexed
|
||||
(fromIntegral $ char + 1)
|
||||
|
||||
uToLspRange :: Range.Range -> Range
|
||||
uToLspRange (Range.Range start end) = Range (uToLspPos start) (uToLspPos end)
|
||||
|
@ -8,7 +8,8 @@ module Unison.LSP.Diagnostics
|
||||
)
|
||||
where
|
||||
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.LSP.Types
|
||||
import Unison.Parser.Ann (Ann)
|
||||
import Unison.Parser.Ann qualified as Ann
|
||||
@ -42,8 +43,8 @@ reportDiagnostics ::
|
||||
Lsp ()
|
||||
reportDiagnostics docUri fileVersion diags = do
|
||||
let jsonRPC = "2.0"
|
||||
let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = List . toList $ diags}
|
||||
sendNotification (NotificationMessage jsonRPC STextDocumentPublishDiagnostics params)
|
||||
let params = PublishDiagnosticsParams {_uri = docUri, _version = fromIntegral <$> fileVersion, _diagnostics = toList $ diags}
|
||||
sendNotification (Msg.TNotificationMessage jsonRPC Msg.SMethod_TextDocumentPublishDiagnostics params)
|
||||
|
||||
mkDiagnostic :: Uri -> Range -> DiagnosticSeverity -> Text -> [(Text, Range)] -> Diagnostic
|
||||
mkDiagnostic uri r severity msg references =
|
||||
@ -58,7 +59,10 @@ mkDiagnostic uri r severity msg references =
|
||||
case references of
|
||||
[] -> Nothing
|
||||
refs ->
|
||||
Just . List $
|
||||
Just $
|
||||
refs <&> \(msg, range) ->
|
||||
DiagnosticRelatedInformation (Location uri range) msg
|
||||
DiagnosticRelatedInformation (Location uri range) msg,
|
||||
-- Could put links to the website in here with more info about specific errors.
|
||||
_codeDescription = Nothing,
|
||||
_data_ = Nothing
|
||||
}
|
||||
|
@ -14,15 +14,15 @@ import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Data.These
|
||||
import Data.Zip qualified as Zip
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Lens (HasCodeAction (codeAction), HasIsPreferred (isPreferred), HasRange (range), HasUri (uri))
|
||||
import Language.LSP.Protocol.Lens qualified as LSPTypes
|
||||
import Language.LSP.Protocol.Types
|
||||
( Diagnostic,
|
||||
Position,
|
||||
Range,
|
||||
TextDocumentIdentifier (TextDocumentIdentifier),
|
||||
Uri (getUri),
|
||||
)
|
||||
import Language.LSP.Types.Lens (HasCodeAction (codeAction), HasIsPreferred (isPreferred), HasRange (range), HasUri (uri))
|
||||
import Language.LSP.Types.Lens qualified as LSPTypes
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.Cli.TypeCheck (computeTypecheckingEnvironment)
|
||||
import Unison.Cli.UniqueTypeGuidLookup qualified as Cli
|
||||
@ -287,7 +287,7 @@ computeConflictWarningDiagnostics fileUri fileSummary@FileSummary {fileNames} =
|
||||
in mkDiagnostic
|
||||
fileUri
|
||||
newRange
|
||||
DsInfo
|
||||
DiagnosticSeverity_Information
|
||||
msg
|
||||
mempty
|
||||
pure $ toDiagnostics conflictedTermLocations <> toDiagnostics conflictedTypeLocations
|
||||
@ -373,7 +373,7 @@ analyseNotes fileUri ppe src notes = do
|
||||
(errMsg, ranges) <- PrintError.renderParseErrors src err
|
||||
let txtMsg = Text.pack $ Pretty.toPlain 80 errMsg
|
||||
range <- ranges
|
||||
pure $ mkDiagnostic fileUri (uToLspRange range) DsError txtMsg []
|
||||
pure $ mkDiagnostic fileUri (uToLspRange range) DiagnosticSeverity_Error txtMsg []
|
||||
-- TODO: Some parsing errors likely have reasonable code actions
|
||||
pure (diags, [])
|
||||
Result.UnknownSymbol _ loc ->
|
||||
@ -430,7 +430,7 @@ analyseNotes fileUri ppe src notes = do
|
||||
let msg = Text.pack $ Pretty.toPlain 80 $ PrintError.printNoteWithSource ppe src currentPath note
|
||||
in do
|
||||
(range, references) <- ranges
|
||||
pure $ mkDiagnostic fileUri range DsError msg references
|
||||
pure $ mkDiagnostic fileUri range DiagnosticSeverity_Error msg references
|
||||
-- Suggest name replacements or qualifications when there's ambiguity
|
||||
nameResolutionCodeActions :: [Diagnostic] -> [Context.Suggestion Symbol Ann] -> [RangedCodeAction]
|
||||
nameResolutionCodeActions diags suggestions = do
|
||||
|
@ -3,8 +3,9 @@
|
||||
module Unison.LSP.FoldingRange where
|
||||
|
||||
import Control.Lens hiding (List)
|
||||
import Language.LSP.Types hiding (line)
|
||||
import Language.LSP.Types.Lens hiding (id, to)
|
||||
import Language.LSP.Protocol.Lens hiding (id, to)
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.DataDeclaration qualified as DD
|
||||
import Unison.Debug qualified as Debug
|
||||
@ -14,11 +15,11 @@ import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
import Unison.UnisonFile (UnisonFile (..))
|
||||
|
||||
foldingRangeRequest :: RequestMessage 'TextDocumentFoldingRange -> (Either ResponseError (ResponseResult 'TextDocumentFoldingRange) -> Lsp ()) -> Lsp ()
|
||||
foldingRangeRequest :: Msg.TRequestMessage 'Msg.Method_TextDocumentFoldingRange -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentFoldingRange) -> Lsp ()) -> Lsp ()
|
||||
foldingRangeRequest m respond = do
|
||||
foldRanges <- foldingRangesForFile (m ^. params . textDocument . uri)
|
||||
Debug.debugM Debug.LSP "Folding Ranges" foldRanges
|
||||
respond . Right . List $ foldRanges
|
||||
respond . Right . InL $ foldRanges
|
||||
|
||||
-- | Return a folding range for each top-level definition
|
||||
foldingRangesForFile :: Uri -> Lsp [FoldingRange]
|
||||
@ -32,7 +33,16 @@ foldingRangesForFile fileUri =
|
||||
let termFolds = terms ^.. folded . _3 . to ABT.annotation
|
||||
let folds = dataFolds <> abilityFolds <> termFolds
|
||||
let ranges = mapMaybe annToRange folds
|
||||
pure $ ranges <&> \r -> FoldingRange {_startLine = r ^. start . line, _startCharacter = Just (r ^. start . character), _endLine = r ^. end . line, _endCharacter = Just (r ^. end . character), _kind = Just FoldingRangeRegion}
|
||||
pure $
|
||||
ranges <&> \r ->
|
||||
FoldingRange
|
||||
{ _startLine = r ^. start . line,
|
||||
_startCharacter = Just (r ^. start . character),
|
||||
_endLine = r ^. end . line,
|
||||
_endCharacter = Just (r ^. end . character),
|
||||
_kind = Just FoldingRangeKind_Region,
|
||||
_collapsedText = Nothing
|
||||
}
|
||||
where
|
||||
dataDeclSpan dd =
|
||||
-- We don't have a proper Annotation for data decls so we take the span of all the
|
||||
|
@ -1,12 +1,14 @@
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
|
||||
module Unison.LSP.HandlerUtils where
|
||||
|
||||
import Control.Lens
|
||||
import Control.Monad.Reader
|
||||
import Data.Map qualified as Map
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens as LSP
|
||||
import Language.LSP.Protocol.Lens as LSP
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.LSP.Types
|
||||
import Unison.Prelude
|
||||
@ -18,12 +20,12 @@ import UnliftIO.STM
|
||||
import UnliftIO.Timeout (timeout)
|
||||
|
||||
-- | Cancels an in-flight request
|
||||
cancelRequest :: SomeLspId -> Lsp ()
|
||||
cancelRequest :: (Int32 |? Text) -> Lsp ()
|
||||
cancelRequest lspId = do
|
||||
cancelMapVar <- asks cancellationMapVar
|
||||
cancel <- atomically $ do
|
||||
cancellers <- readTVar cancelMapVar
|
||||
let (mayCancel, newMap) = Map.updateLookupWithKey (\_k _io -> Nothing) (lspId) cancellers
|
||||
let (mayCancel, newMap) = Map.updateLookupWithKey (\_k _io -> Nothing) lspId cancellers
|
||||
case mayCancel of
|
||||
Nothing -> pure (pure ())
|
||||
Just cancel -> do
|
||||
@ -32,10 +34,10 @@ cancelRequest lspId = do
|
||||
liftIO cancel
|
||||
|
||||
withDebugging ::
|
||||
(Show (RequestMessage message), Show (ResponseResult message)) =>
|
||||
(RequestMessage message -> (Either ResponseError (ResponseResult message) -> Lsp ()) -> Lsp ()) ->
|
||||
RequestMessage message ->
|
||||
(Either ResponseError (ResponseResult message) -> Lsp ()) ->
|
||||
(Show (Msg.TRequestMessage message), Show (Msg.MessageResult message)) =>
|
||||
(Msg.TRequestMessage message -> (Either Msg.ResponseError (Msg.MessageResult message) -> Lsp ()) -> Lsp ()) ->
|
||||
Msg.TRequestMessage message ->
|
||||
(Either Msg.ResponseError (Msg.MessageResult message) -> Lsp ()) ->
|
||||
Lsp ()
|
||||
withDebugging handler message respond = do
|
||||
Debug.debugM Debug.LSP "Request" message
|
||||
@ -47,12 +49,14 @@ withDebugging handler message respond = do
|
||||
withCancellation ::
|
||||
forall message.
|
||||
Maybe Int ->
|
||||
(RequestMessage message -> (Either ResponseError (ResponseResult message) -> Lsp ()) -> Lsp ()) ->
|
||||
RequestMessage message ->
|
||||
(Either ResponseError (ResponseResult message) -> Lsp ()) ->
|
||||
(Msg.TRequestMessage message -> (Either Msg.ResponseError (Msg.MessageResult message) -> Lsp ()) -> Lsp ()) ->
|
||||
Msg.TRequestMessage message ->
|
||||
(Either Msg.ResponseError (Msg.MessageResult message) -> Lsp ()) ->
|
||||
Lsp ()
|
||||
withCancellation mayTimeoutMillis handler message respond = do
|
||||
let reqId = SomeLspId $ message ^. LSP.id
|
||||
let reqId = case message ^. LSP.id of
|
||||
Msg.IdInt i -> InL i
|
||||
Msg.IdString s -> InR s
|
||||
-- The server itself seems to be single-threaded, so we need to fork in order to be able to
|
||||
-- process cancellation requests while still computing some other response
|
||||
void . forkIO $ flip finally (removeFromMap reqId) do
|
||||
@ -67,16 +71,18 @@ withCancellation mayTimeoutMillis handler message respond = do
|
||||
Nothing -> action
|
||||
Just t -> do
|
||||
(timeout (t * 1000) action) >>= \case
|
||||
Nothing -> respond $ cancelErr "Timeout"
|
||||
Nothing -> respond $ serverCancelErr "Timeout"
|
||||
Just () -> pure ()
|
||||
cancelErr :: Text -> Either ResponseError b
|
||||
cancelErr msg = Left $ ResponseError RequestCancelled msg Nothing
|
||||
clientCancelErr :: Text -> Either Msg.ResponseError b
|
||||
clientCancelErr msg = Left $ Msg.ResponseError (InL LSPErrorCodes_RequestCancelled) msg Nothing
|
||||
serverCancelErr :: Text -> Either Msg.ResponseError b
|
||||
serverCancelErr msg = Left $ Msg.ResponseError (InL LSPErrorCodes_ServerCancelled) msg Nothing
|
||||
-- I intentionally defer adding the canceller until after we've started the request,
|
||||
-- No matter what it's possible for a message to be cancelled before the
|
||||
-- canceller has been added, but this means we're not blocking the request waiting for
|
||||
-- contention on the cancellation map on every request.
|
||||
-- The the majority of requests should be fast enough to complete "instantly" anyways.
|
||||
waitForCancel :: SomeLspId -> Lsp ()
|
||||
waitForCancel :: (Int32 |? Text) -> Lsp ()
|
||||
waitForCancel reqId = do
|
||||
barrier <- newEmptyMVar
|
||||
let canceller = void $ tryPutMVar barrier ()
|
||||
@ -86,4 +92,4 @@ withCancellation mayTimeoutMillis handler message respond = do
|
||||
readMVar barrier
|
||||
let msg = "Request Cancelled by client"
|
||||
Debug.debugLogM Debug.LSP msg
|
||||
respond (cancelErr "Request cancelled by client")
|
||||
respond (clientCancelErr "Request cancelled by client")
|
||||
|
@ -6,8 +6,9 @@ module Unison.LSP.Hover where
|
||||
import Control.Lens hiding (List)
|
||||
import Control.Monad.Reader
|
||||
import Data.Text qualified as Text
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Language.LSP.Protocol.Lens
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.HashQualified qualified as HQ
|
||||
import Unison.LSP.FileAnalysis (ppedForFile)
|
||||
@ -35,14 +36,14 @@ import UnliftIO qualified
|
||||
-- TODO:
|
||||
-- * Add docs
|
||||
-- * Resolve fqn on hover
|
||||
hoverHandler :: RequestMessage 'TextDocumentHover -> (Either ResponseError (ResponseResult 'TextDocumentHover) -> Lsp ()) -> Lsp ()
|
||||
hoverHandler m respond =
|
||||
respond . Right =<< runMaybeT do
|
||||
hoverHandler :: Msg.TRequestMessage 'Msg.Method_TextDocumentHover -> (Either Msg.ResponseError (Msg.MessageResult 'Msg.Method_TextDocumentHover) -> Lsp ()) -> Lsp ()
|
||||
hoverHandler m respond = do
|
||||
respond . Right . maybe (InR Null) InL =<< runMaybeT do
|
||||
let pos = (m ^. params . position)
|
||||
hoverTxt <- hoverInfo (m ^. params . textDocument . uri) pos
|
||||
pure $
|
||||
Hover
|
||||
{ _contents = HoverContents (MarkupContent MkMarkdown hoverTxt),
|
||||
{ _contents = InL (MarkupContent MarkupKind_Markdown hoverTxt),
|
||||
_range = Nothing -- TODO add range info
|
||||
}
|
||||
|
||||
|
@ -2,11 +2,11 @@
|
||||
|
||||
module Unison.LSP.NotificationHandlers where
|
||||
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Message
|
||||
import Unison.Debug qualified as Debug
|
||||
import Unison.LSP.Types
|
||||
|
||||
initializedHandler :: NotificationMessage 'Initialized -> Lsp ()
|
||||
initializedHandler :: TNotificationMessage 'Method_Initialized -> Lsp ()
|
||||
initializedHandler _ = pure ()
|
||||
|
||||
withDebugging :: (Show m) => (m -> Lsp ()) -> (m -> Lsp ())
|
||||
|
@ -6,12 +6,8 @@
|
||||
module Unison.LSP.Orphans where
|
||||
|
||||
import Control.Lens
|
||||
import Data.Function (on)
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens (HasTextDocument (..), HasUri (..))
|
||||
|
||||
instance Ord TextDocumentIdentifier where
|
||||
compare = compare `on` view uri
|
||||
import Language.LSP.Protocol.Lens (HasTextDocument (..), HasUri (..))
|
||||
import Language.LSP.Protocol.Types
|
||||
|
||||
instance HasTextDocument TextDocumentIdentifier TextDocumentIdentifier where
|
||||
textDocument = Prelude.id
|
||||
|
@ -20,7 +20,7 @@ import Control.Lens
|
||||
import Control.Lens qualified as Lens
|
||||
import Control.Monad.Reader
|
||||
import Data.Generics.Product (field)
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Protocol.Types
|
||||
import Unison.ABT qualified as ABT
|
||||
import Unison.Builtin.Decls qualified as Builtins
|
||||
import Unison.Codebase qualified as Codebase
|
||||
|
@ -2,6 +2,7 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE UndecidableInstances #-}
|
||||
|
||||
module Unison.LSP.Types where
|
||||
@ -16,7 +17,6 @@ import Data.Aeson qualified as Aeson
|
||||
import Data.Aeson.Key qualified as Aeson.Key
|
||||
import Data.Aeson.KeyMap qualified as Aeson.KeyMap
|
||||
import Data.ByteString.Lazy.Char8 qualified as BSC
|
||||
import Data.HashMap.Strict qualified as HM
|
||||
import Data.IntervalMap.Lazy (IntervalMap)
|
||||
import Data.IntervalMap.Lazy qualified as IM
|
||||
import Data.Map qualified as Map
|
||||
@ -24,10 +24,11 @@ import Data.Set qualified as Set
|
||||
import Data.Text qualified as Text
|
||||
import Ki qualified
|
||||
import Language.LSP.Logging qualified as LSP
|
||||
import Language.LSP.Protocol.Lens
|
||||
import Language.LSP.Protocol.Message (MessageDirection (..), MessageKind (..), Method, TMessage, TNotificationMessage, fromServerNot)
|
||||
import Language.LSP.Protocol.Types
|
||||
import Language.LSP.Server
|
||||
import Language.LSP.Server qualified as LSP
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens
|
||||
import Language.LSP.VFS
|
||||
import Unison.Codebase
|
||||
import Unison.Codebase.Path qualified as Path
|
||||
@ -89,7 +90,7 @@ data Env = Env
|
||||
checkedFilesVar :: TVar (Map Uri (TMVar FileAnalysis)),
|
||||
dirtyFilesVar :: TVar (Set Uri),
|
||||
-- A map of request IDs to an action which kills that request.
|
||||
cancellationMapVar :: TVar (Map SomeLspId (IO ())),
|
||||
cancellationMapVar :: TVar (Map (Int32 |? Text) (IO ())),
|
||||
-- A lazily computed map of all valid completion suffixes from the current path.
|
||||
completionsVar :: TVar CompletionTree,
|
||||
scope :: Ki.Scope
|
||||
@ -212,10 +213,10 @@ defaultLSPConfig = Config {..}
|
||||
lspBackend :: Backend.Backend IO a -> Lsp (Either Backend.BackendError a)
|
||||
lspBackend = liftIO . runExceptT . flip runReaderT (Backend.BackendEnv False) . Backend.runBackend
|
||||
|
||||
sendNotification :: forall (m :: Method 'FromServer 'Notification). (Message m ~ NotificationMessage m) => NotificationMessage m -> Lsp ()
|
||||
sendNotification :: forall (m :: Method 'ServerToClient 'Notification). (TMessage m ~ TNotificationMessage m) => TNotificationMessage m -> Lsp ()
|
||||
sendNotification notif = do
|
||||
sendServerMessage <- asks (resSendMessage . lspContext)
|
||||
liftIO $ sendServerMessage $ FromServerMess (notif ^. method) (notif)
|
||||
liftIO $ sendServerMessage $ fromServerNot notif -- (notif ^. method) notif
|
||||
|
||||
data RangedCodeAction = RangedCodeAction
|
||||
{ -- All the ranges the code action applies
|
||||
@ -225,7 +226,7 @@ data RangedCodeAction = RangedCodeAction
|
||||
deriving stock (Eq, Show)
|
||||
|
||||
instance HasCodeAction RangedCodeAction CodeAction where
|
||||
codeAction = lens _codeAction (\rca ca -> rca {_codeAction = ca})
|
||||
codeAction = lens (\RangedCodeAction {_codeAction} -> _codeAction) (\rca ca -> RangedCodeAction {_codeActionRanges = _codeActionRanges rca, _codeAction = ca})
|
||||
|
||||
rangedCodeAction :: Text -> [Diagnostic] -> [Range] -> RangedCodeAction
|
||||
rangedCodeAction title diags ranges =
|
||||
@ -233,12 +234,12 @@ rangedCodeAction title diags ranges =
|
||||
CodeAction
|
||||
{ _title = title,
|
||||
_kind = Nothing,
|
||||
_diagnostics = Just . List $ diags,
|
||||
_diagnostics = Just diags,
|
||||
_isPreferred = Nothing,
|
||||
_disabled = Nothing,
|
||||
_edit = Nothing,
|
||||
_command = Nothing,
|
||||
_xdata = Nothing
|
||||
_data_ = Nothing
|
||||
}
|
||||
|
||||
-- | Provided ranges must not intersect.
|
||||
@ -249,7 +250,7 @@ includeEdits uri replacement ranges rca =
|
||||
pure $ TextEdit r replacement
|
||||
workspaceEdit =
|
||||
WorkspaceEdit
|
||||
{ _changes = Just $ HM.singleton uri (List edits),
|
||||
{ _changes = Just $ Map.singleton uri edits,
|
||||
_documentChanges = Nothing,
|
||||
_changeAnnotations = Nothing
|
||||
}
|
||||
|
@ -16,9 +16,10 @@ import Data.Text qualified as Text
|
||||
import Data.Text.Utf16.Rope qualified as Rope
|
||||
import Data.Tuple (swap)
|
||||
import Language.LSP.Logging qualified as LSP
|
||||
import Language.LSP.Types
|
||||
import Language.LSP.Types.Lens (HasCharacter (character), HasParams (params), HasTextDocument (textDocument), HasUri (uri))
|
||||
import Language.LSP.Types.Lens qualified as LSP
|
||||
import Language.LSP.Protocol.Lens (HasCharacter (character), HasParams (params), HasTextDocument (textDocument), HasUri (uri))
|
||||
import Language.LSP.Protocol.Lens qualified as LSP
|
||||
import Language.LSP.Protocol.Message qualified as Msg
|
||||
import Language.LSP.Protocol.Types
|
||||
import Language.LSP.VFS as VFS hiding (character)
|
||||
import Unison.LSP.Orphans ()
|
||||
import Unison.LSP.Types
|
||||
@ -97,16 +98,16 @@ completionPrefix uri pos = do
|
||||
|
||||
--- Handlers for tracking file changes.
|
||||
|
||||
lspOpenFile :: NotificationMessage 'TextDocumentDidOpen -> Lsp ()
|
||||
lspOpenFile :: Msg.TNotificationMessage 'Msg.Method_TextDocumentDidOpen -> Lsp ()
|
||||
lspOpenFile msg = do
|
||||
usingVFS . openVFS vfsLogger $ msg
|
||||
markFilesDirty [msg ^. params . textDocument]
|
||||
|
||||
lspCloseFile :: NotificationMessage 'TextDocumentDidClose -> Lsp ()
|
||||
lspCloseFile :: Msg.TNotificationMessage 'Msg.Method_TextDocumentDidClose -> Lsp ()
|
||||
lspCloseFile msg =
|
||||
usingVFS . closeVFS vfsLogger $ msg
|
||||
|
||||
lspChangeFile :: NotificationMessage 'TextDocumentDidChange -> Lsp ()
|
||||
lspChangeFile :: Msg.TNotificationMessage 'Msg.Method_TextDocumentDidChange -> Lsp ()
|
||||
lspChangeFile msg = do
|
||||
usingVFS . changeFromClientVFS vfsLogger $ msg
|
||||
markFilesDirty [msg ^. params . textDocument]
|
||||
|
@ -183,8 +183,8 @@ library
|
||||
, ki
|
||||
, lens
|
||||
, lock-file
|
||||
, lsp >=1.5.0.0
|
||||
, lsp-types >=1.5.0.0
|
||||
, lsp >=2.0.0.0
|
||||
, lsp-types >=2.0.0.0
|
||||
, megaparsec
|
||||
, memory
|
||||
, mtl
|
||||
@ -317,8 +317,8 @@ executable cli-integration-tests
|
||||
, ki
|
||||
, lens
|
||||
, lock-file
|
||||
, lsp >=1.5.0.0
|
||||
, lsp-types >=1.5.0.0
|
||||
, lsp >=2.0.0.0
|
||||
, lsp-types >=2.0.0.0
|
||||
, megaparsec
|
||||
, memory
|
||||
, mtl
|
||||
@ -445,8 +445,8 @@ executable transcripts
|
||||
, ki
|
||||
, lens
|
||||
, lock-file
|
||||
, lsp >=1.5.0.0
|
||||
, lsp-types >=1.5.0.0
|
||||
, lsp >=2.0.0.0
|
||||
, lsp-types >=2.0.0.0
|
||||
, megaparsec
|
||||
, memory
|
||||
, mtl
|
||||
@ -579,8 +579,8 @@ executable unison
|
||||
, ki
|
||||
, lens
|
||||
, lock-file
|
||||
, lsp >=1.5.0.0
|
||||
, lsp-types >=1.5.0.0
|
||||
, lsp >=2.0.0.0
|
||||
, lsp-types >=2.0.0.0
|
||||
, megaparsec
|
||||
, memory
|
||||
, mtl
|
||||
@ -720,8 +720,8 @@ test-suite cli-tests
|
||||
, ki
|
||||
, lens
|
||||
, lock-file
|
||||
, lsp >=1.5.0.0
|
||||
, lsp-types >=1.5.0.0
|
||||
, lsp >=2.0.0.0
|
||||
, lsp-types >=2.0.0.0
|
||||
, megaparsec
|
||||
, memory
|
||||
, mtl
|
||||
|
Loading…
Reference in New Issue
Block a user