From 536d7b11993e69106d482eecbb7ed10daeb6370b Mon Sep 17 00:00:00 2001 From: fwcd Date: Sat, 27 Jul 2024 03:24:53 +0200 Subject: [PATCH 01/12] Upgrade to LTS 22.30 --- curry-language-server.cabal | 44 ++++++++++++++++++------------------- package.yaml | 14 ++++++------ stack.yaml | 8 +++---- stack.yaml.lock | 36 ++++++++++-------------------- 4 files changed, 43 insertions(+), 59 deletions(-) diff --git a/curry-language-server.cabal b/curry-language-server.cabal index 7c85db6..f5af201 100644 --- a/curry-language-server.cabal +++ b/curry-language-server.cabal @@ -1,6 +1,6 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.35.1. +-- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack @@ -67,9 +67,9 @@ library ghc-options: -Wall build-depends: Glob ==0.10.* - , aeson ==2.0.* + , aeson >=2.0 && <2.2 , async ==2.2.* - , base ==4.16.* + , base >=4.16 && <4.19 , bytestring ==0.11.* , bytestring-trie ==0.2.* , co-log-core ==0.3.* @@ -81,16 +81,16 @@ library , exceptions ==0.10.* , extra ==1.7.* , filepath ==1.4.* - , lens ==5.1.* - , lsp ==1.6.* - , mtl ==2.2.* + , lens >=5.1 && <5.3 + , lsp ==2.3.* + , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* , process >=1.6 && <2 , sorted-list ==0.2.* , stm ==2.5.* - , text ==1.2.* - , transformers ==0.5.* + , text ==2.0.* + , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 @@ -103,9 +103,9 @@ executable curry-language-server ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall build-depends: Glob ==0.10.* - , aeson ==2.0.* + , aeson >=2.0 && <2.2 , async ==2.2.* - , base ==4.16.* + , base >=4.16 && <4.19 , bytestring ==0.11.* , bytestring-trie ==0.2.* , co-log-core ==0.3.* @@ -118,16 +118,16 @@ executable curry-language-server , exceptions ==0.10.* , extra ==1.7.* , filepath ==1.4.* - , lens ==5.1.* - , lsp ==1.6.* - , mtl ==2.2.* + , lens >=5.1 && <5.3 + , lsp ==2.3.* + , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* , process >=1.6 && <2 , sorted-list ==0.2.* , stm ==2.5.* - , text ==1.2.* - , transformers ==0.5.* + , text ==2.0.* + , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 @@ -141,9 +141,9 @@ test-suite curry-language-server-test ghc-options: -threaded -rtsopts -with-rtsopts=-N build-depends: Glob ==0.10.* - , aeson ==2.0.* + , aeson >=2.0 && <2.2 , async ==2.2.* - , base ==4.16.* + , base >=4.16 && <4.19 , bytestring ==0.11.* , bytestring-trie ==0.2.* , co-log-core ==0.3.* @@ -156,15 +156,15 @@ test-suite curry-language-server-test , exceptions ==0.10.* , extra ==1.7.* , filepath ==1.4.* - , lens ==5.1.* - , lsp ==1.6.* - , mtl ==2.2.* + , lens >=5.1 && <5.3 + , lsp ==2.3.* + , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* , process >=1.6 && <2 , sorted-list ==0.2.* , stm ==2.5.* - , text ==1.2.* - , transformers ==0.5.* + , text ==2.0.* + , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 2e2ed91..6704ac9 100644 --- a/package.yaml +++ b/package.yaml @@ -13,25 +13,25 @@ extra-source-files: - README.md dependencies: - - base >= 4.16 && < 4.17 - - aeson >= 2.0 && < 2.1 + - base >= 4.16 && < 4.19 + - aeson >= 2.0 && < 2.2 - async >= 2.2 && < 2.3 - containers >= 0.6 && < 0.7 - data-default >= 0.7 && < 0.8 - extra >= 1.7 && < 1.8 - either >= 5.0 && < 6 - - mtl >= 2.2 && < 2.3 - - transformers >= 0.5 && < 0.6 + - mtl >= 2.2 && < 2.4 + - transformers >= 0.5 && < 0.7 - exceptions >= 0.10 && < 0.11 - stm >= 2.5 && < 2.6 - - text >= 1.2 && < 1.3 - - lens >= 5.1 && < 5.2 + - text >= 2.0 && < 2.1 + - lens >= 5.1 && < 5.3 - co-log-core >= 0.3 && < 0.4 - filepath >= 1.4 && < 1.5 - Glob >= 0.10 && < 0.11 - directory >= 1.3 && < 1.4 - sorted-list >= 0.2 && < 0.3 - - lsp >= 1.6 && < 1.7 + - lsp >= 2.3 && < 2.4 - unliftio-core >= 0.2 && < 0.3 - bytestring >= 0.11 && < 0.12 - bytestring-trie >= 0.2 && < 0.3 diff --git a/stack.yaml b/stack.yaml index 5d00e3d..4230b02 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,7 +7,7 @@ # Resolver to choose a 'specific' stackage snapshot or a compiler version. # A snapshot resolver dictates the compiler version and the set of packages # to be used for project dependencies. -resolver: lts-20.22 +resolver: lts-22.30 # User packages to be built. packages: @@ -16,11 +16,9 @@ packages: # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: extra-deps: - - set-extra-1.4.1@sha256:c58aa620704f609f289953e7c1f9c1653fd1498f0984b0f03a3f8f38f7ed5a84 - - lsp-1.6.0.0 - - co-log-core-0.3.2.0@sha256:9b2699adecee2f072b6c713089e675b592ef23f00a2ff3740bdaf4d87de8d456 + - set-extra-1.4.2 - git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git - commit: ec11193bb41e71f3f0ec7ebdd116b9b04d7a6b10 + commit: dd346c0c8c72979b8d195d241a8a19258745b134 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 25145d1..e2739ac 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -5,40 +5,26 @@ packages: - completed: - hackage: set-extra-1.4.1@sha256:c58aa620704f609f289953e7c1f9c1653fd1498f0984b0f03a3f8f38f7ed5a84,533 + hackage: set-extra-1.4.2@sha256:a1a3899d7ae01cd72dfd4691ae77cf26e8867731dff70e61307f25ddc7fd875d,564 pantry-tree: - sha256: 3b6f94160b9d868f341d841de0e3e9f354ae90b5817b171e2bb68fd67cf2790c + sha256: 439f8bd6732a4d250a9e565c5bbcf393f3374e8e346e634494efd62b388fe810 size: 268 original: - hackage: set-extra-1.4.1@sha256:c58aa620704f609f289953e7c1f9c1653fd1498f0984b0f03a3f8f38f7ed5a84 + hackage: set-extra-1.4.2 - completed: - hackage: lsp-1.6.0.0@sha256:2b95e406cc85ffa95406ae8ad7d16b82283a6ca2fcb7ea5308a4ef3e6d6e68e6,4397 - pantry-tree: - sha256: 43a82c501ec3074d888f2bf4960e4b447028c1537abbca4cf65e74944604bf62 - size: 1044 - original: - hackage: lsp-1.6.0.0 -- completed: - hackage: co-log-core-0.3.2.0@sha256:9b2699adecee2f072b6c713089e675b592ef23f00a2ff3740bdaf4d87de8d456,3850 - pantry-tree: - sha256: af9c807ce50a126706bd99983ec71c060a489ab2b914de8dbccf756adccc2a43 - size: 584 - original: - hackage: co-log-core-0.3.2.0@sha256:9b2699adecee2f072b6c713089e675b592ef23f00a2ff3740bdaf4d87de8d456 -- completed: - commit: ec11193bb41e71f3f0ec7ebdd116b9b04d7a6b10 + commit: dd346c0c8c72979b8d195d241a8a19258745b134 git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git name: curry-frontend pantry-tree: - sha256: 04f6cc0c503b005649d028434ad9c076f24d018dcd8ba8f877c2d7dd75f3f774 + sha256: 3b2f6df898d989bf51fe83ee6bd73383e06fe07d1606dd0c0386ad6375c73109 size: 17097 - version: 2.1.0 + version: 2.1.1 original: - commit: ec11193bb41e71f3f0ec7ebdd116b9b04d7a6b10 + commit: dd346c0c8c72979b8d195d241a8a19258745b134 git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git snapshots: - completed: - sha256: dcf4fc28f12d805480ddbe8eb8c370e11db12f0461d0110a4240af27ac88d725 - size: 650255 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/20/22.yaml - original: lts-20.22 + sha256: 795b7a893148a42f09956611a0fa1139293fe6ef934d053468d8e53e3e013390 + size: 719577 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/22/30.yaml + original: lts-22.30 From f763b9aa25c3d2ce91f1f001a61ee54a49c75d80 Mon Sep 17 00:00:00 2001 From: fwcd Date: Sat, 27 Jul 2024 03:25:07 +0200 Subject: [PATCH 02/12] Update LSP protocol imports --- app/Main.hs | 2 +- src/Curry/LanguageServer/Handlers/Cancel.hs | 2 +- src/Curry/LanguageServer/Handlers/Diagnostics.hs | 2 +- src/Curry/LanguageServer/Handlers/Initialized.hs | 2 +- src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs | 4 ++-- src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs | 4 ++-- src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs | 4 ++-- src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs | 4 ++-- .../LanguageServer/Handlers/TextDocument/DocumentSymbol.hs | 4 ++-- src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs | 4 ++-- .../LanguageServer/Handlers/TextDocument/Notifications.hs | 4 ++-- .../LanguageServer/Handlers/TextDocument/SignatureHelp.hs | 4 ++-- src/Curry/LanguageServer/Handlers/Workspace/Command.hs | 4 ++-- src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs | 2 +- src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs | 4 ++-- src/Curry/LanguageServer/Index/Resolve.hs | 2 +- src/Curry/LanguageServer/Index/Store.hs | 2 +- src/Curry/LanguageServer/Index/Symbol.hs | 4 ++-- src/Curry/LanguageServer/Monad.hs | 2 +- src/Curry/LanguageServer/Utils/Convert.hs | 2 +- src/Curry/LanguageServer/Utils/General.hs | 2 +- src/Curry/LanguageServer/Utils/Lookup.hs | 2 +- src/Curry/LanguageServer/Utils/Syntax.hs | 2 +- src/Curry/LanguageServer/Utils/Uri.hs | 2 +- 24 files changed, 35 insertions(+), 35 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index 0b595fa..daf8540 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,7 @@ import qualified Data.Aeson as A import Data.Default (Default (..)) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import qualified Curry.LanguageServer.Config as CFG import Curry.LanguageServer.Handlers import Curry.LanguageServer.Handlers.Workspace.Command (commands) diff --git a/src/Curry/LanguageServer/Handlers/Cancel.hs b/src/Curry/LanguageServer/Handlers/Cancel.hs index 26e17df..58c1a42 100644 --- a/src/Curry/LanguageServer/Handlers/Cancel.hs +++ b/src/Curry/LanguageServer/Handlers/Cancel.hs @@ -6,7 +6,7 @@ module Curry.LanguageServer.Handlers.Cancel import Curry.LanguageServer.Monad (LSM) import Curry.LanguageServer.Utils.Logging (debugM) import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J cancelHandler :: S.Handlers LSM cancelHandler = S.notificationHandler J.SCancelRequest $ \_nt -> do diff --git a/src/Curry/LanguageServer/Handlers/Diagnostics.hs b/src/Curry/LanguageServer/Handlers/Diagnostics.hs index 7f5abed..ccdfb9f 100644 --- a/src/Curry/LanguageServer/Handlers/Diagnostics.hs +++ b/src/Curry/LanguageServer/Handlers/Diagnostics.hs @@ -15,7 +15,7 @@ import qualified Data.Text as T import qualified Language.LSP.Diagnostics as D import qualified Language.LSP.Server as S import Language.LSP.Server (MonadLsp) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import System.FilePath (takeBaseName) emitDiagnostics :: J.NormalizedUri -> ModuleStoreEntry -> LSM () diff --git a/src/Curry/LanguageServer/Handlers/Initialized.hs b/src/Curry/LanguageServer/Handlers/Initialized.hs index 89e35d0..ebf53c2 100644 --- a/src/Curry/LanguageServer/Handlers/Initialized.hs +++ b/src/Curry/LanguageServer/Handlers/Initialized.hs @@ -9,7 +9,7 @@ import Curry.LanguageServer.Monad (LSM) import Data.Maybe (maybeToList, fromMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J initializedHandler :: S.Handlers LSM initializedHandler = S.notificationHandler J.SInitialized $ \_nt -> do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs index 843a766..8318c54 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs @@ -23,8 +23,8 @@ import Data.Maybe (fromMaybe, maybeToList) import qualified Data.Text as T import qualified Language.LSP.Server as S import Language.LSP.Server (MonadLsp) -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J codeActionHandler :: S.Handlers LSM codeActionHandler = S.requestHandler J.STextDocumentCodeAction $ \req responder -> do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs index 0674a8c..45025ae 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs @@ -21,8 +21,8 @@ import Data.Maybe (fromMaybe, maybeToList) import qualified Data.Text as T import qualified Language.LSP.Server as S import Language.LSP.Server (MonadLsp) -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J codeLensHandler :: S.Handlers LSM codeLensHandler = S.requestHandler J.STextDocumentCodeLens $ \req responder -> do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs index c11a7e6..b7d9814 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs @@ -29,8 +29,8 @@ import qualified Data.Set as S import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.VFS as VFS -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) completionHandler :: S.Handlers LSM diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs index c9350b2..05a6bf6 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs @@ -18,8 +18,8 @@ import qualified Data.Map as M import Data.Maybe (fromMaybe, mapMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) definitionHandler :: S.Handlers LSM diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs index 45ab369..9486044 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs @@ -14,8 +14,8 @@ import Curry.LanguageServer.Monad (LSM) import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) documentSymbolHandler :: S.Handlers LSM diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs index aa44078..b56f698 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs @@ -23,8 +23,8 @@ import Curry.LanguageServer.Monad (LSM, getStore) import Data.Maybe (listToMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) hoverHandler :: S.Handlers LSM diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs index 3d85f4e..48208da 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs @@ -18,8 +18,8 @@ import Curry.LanguageServer.Utils.Logging (debugM) import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J didOpenHandler :: S.Handlers LSM didOpenHandler = S.notificationHandler J.STextDocumentDidOpen $ \nt -> do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs index 8d97fb1..0026c75 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs @@ -32,8 +32,8 @@ import Data.Maybe (fromMaybe, listToMaybe, maybeToList) import qualified Data.List.NonEmpty as N import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import qualified Language.LSP.VFS as VFS import Language.LSP.Server (MonadLsp) diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs index 52ab9b9..964788b 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs @@ -8,8 +8,8 @@ import Curry.LanguageServer.Utils.Logging (debugM, infoM, warnM) import qualified Data.Aeson as A import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J executeCommandHandler :: S.Handlers LSM executeCommandHandler = S.requestHandler J.SWorkspaceExecuteCommand $ \req responder -> do diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs b/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs index 491a421..42f9ede 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs @@ -6,7 +6,7 @@ module Curry.LanguageServer.Handlers.Workspace.Notifications import Curry.LanguageServer.Monad (LSM) import Curry.LanguageServer.Utils.Logging (debugM) import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J didChangeConfigurationHandler :: S.Handlers LSM didChangeConfigurationHandler = S.notificationHandler J.SWorkspaceDidChangeConfiguration $ \_nt -> do diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs index 4f07ea4..3c9d788 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs @@ -11,8 +11,8 @@ import Curry.LanguageServer.Utils.Logging (debugM, infoM) import Data.Maybe (mapMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) workspaceSymbolHandler :: S.Handlers LSM diff --git a/src/Curry/LanguageServer/Index/Resolve.hs b/src/Curry/LanguageServer/Index/Resolve.hs index 126043c..8182f99 100644 --- a/src/Curry/LanguageServer/Index/Resolve.hs +++ b/src/Curry/LanguageServer/Index/Resolve.hs @@ -14,7 +14,7 @@ import qualified Curry.LanguageServer.Index.Symbol as I import Curry.LanguageServer.Utils.Convert (currySpanInfo2Range) import Curry.LanguageServer.Utils.Sema (ModuleAST) import Curry.LanguageServer.Utils.Lookup (findQualIdentAtPos, findModuleIdentAtPos) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J -- | Resolves the identifier at the given position. resolveAtPos :: I.IndexStore -> ModuleAST -> J.Position -> Maybe ([I.Symbol], J.Range) diff --git a/src/Curry/LanguageServer/Index/Store.hs b/src/Curry/LanguageServer/Index/Store.hs index 73a6a61..37f5e06 100644 --- a/src/Curry/LanguageServer/Index/Store.hs +++ b/src/Curry/LanguageServer/Index/Store.hs @@ -61,7 +61,7 @@ import qualified Data.Text as T import qualified Data.Text.IO as TIO import qualified Data.Text.Encoding as TE import qualified Data.Trie as TR -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import System.Directory (doesFileExist, doesDirectoryExist) import System.Exit (ExitCode(ExitSuccess)) import System.FilePath ((<.>), (), takeDirectory, takeExtension, takeFileName) diff --git a/src/Curry/LanguageServer/Index/Symbol.hs b/src/Curry/LanguageServer/Index/Symbol.hs index 4756c6b..f4f3dd4 100644 --- a/src/Curry/LanguageServer/Index/Symbol.hs +++ b/src/Curry/LanguageServer/Index/Symbol.hs @@ -10,8 +10,8 @@ import Control.Lens ((^.)) import Data.Default (Default (..)) import Data.Maybe (fromMaybe) import qualified Data.Text as T -import qualified Language.LSP.Types as J -import qualified Language.LSP.Types.Lens as J +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Lens as J -- | The 'kind' of the symbol in the LSP sense. data SymbolKind = ValueFunction diff --git a/src/Curry/LanguageServer/Monad.hs b/src/Curry/LanguageServer/Monad.hs index 493634e..78d0784 100644 --- a/src/Curry/LanguageServer/Monad.hs +++ b/src/Curry/LanguageServer/Monad.hs @@ -22,7 +22,7 @@ import Data.Default (Default(..)) import Data.Maybe (fromMaybe) import qualified Data.Map as M import Language.LSP.Server (LspT, LanguageContextEnv, runLspT) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J data DirtyModuleHandlers = DirtyModuleHandlers { recompileHandler :: IO () , auxiliaryHandler :: IO () diff --git a/src/Curry/LanguageServer/Utils/Convert.hs b/src/Curry/LanguageServer/Utils/Convert.hs index f7ddb2a..d2e4b9c 100644 --- a/src/Curry/LanguageServer/Utils/Convert.hs +++ b/src/Curry/LanguageServer/Utils/Convert.hs @@ -47,7 +47,7 @@ import Curry.LanguageServer.Utils.General import Curry.LanguageServer.Utils.Uri (filePathToUri, uriToFilePath) import Data.Maybe (fromMaybe, listToMaybe) import qualified Data.Text as T -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J -- Curry Compiler -> Language Server Protocol diff --git a/src/Curry/LanguageServer/Utils/General.hs b/src/Curry/LanguageServer/Utils/General.hs index 273c6d8..29ad54e 100644 --- a/src/Curry/LanguageServer/Utils/General.hs +++ b/src/Curry/LanguageServer/Utils/General.hs @@ -50,7 +50,7 @@ import qualified Data.Text as T import qualified Data.Trie as TR import qualified Data.Map as M import qualified Data.Set as S -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import System.FilePath import System.IO.Unsafe (unsafeInterleaveIO) import System.Directory diff --git a/src/Curry/LanguageServer/Utils/Lookup.hs b/src/Curry/LanguageServer/Utils/Lookup.hs index c69f29a..d575371 100644 --- a/src/Curry/LanguageServer/Utils/Lookup.hs +++ b/src/Curry/LanguageServer/Utils/Lookup.hs @@ -28,7 +28,7 @@ import Curry.LanguageServer.Utils.Syntax import Curry.LanguageServer.Utils.Sema ( HasTypedSpanInfos(typedSpanInfos), TypedSpanInfo ) import qualified Data.Map as M -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J -- | A collectScope of bound identifiers. type Scope a = M.Map CI.Ident (Maybe a) diff --git a/src/Curry/LanguageServer/Utils/Syntax.hs b/src/Curry/LanguageServer/Utils/Syntax.hs index bc9162d..da1a0ed 100644 --- a/src/Curry/LanguageServer/Utils/Syntax.hs +++ b/src/Curry/LanguageServer/Utils/Syntax.hs @@ -28,7 +28,7 @@ import Curry.LanguageServer.Utils.Convert (currySpanInfo2Range) import Curry.LanguageServer.Utils.General (lastSafe, rangeElem) import qualified Data.List.NonEmpty as N import Data.Maybe (maybeToList) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J -- | Fetches the element at the given position. elementAt :: CSPI.HasSpanInfo e => J.Position -> [e] -> Maybe e diff --git a/src/Curry/LanguageServer/Utils/Uri.hs b/src/Curry/LanguageServer/Utils/Uri.hs index bfbe04e..0e322b9 100644 --- a/src/Curry/LanguageServer/Utils/Uri.hs +++ b/src/Curry/LanguageServer/Utils/Uri.hs @@ -8,7 +8,7 @@ module Curry.LanguageServer.Utils.Uri ) where import Control.Monad.IO.Class (MonadIO (..)) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J import System.Directory (canonicalizePath) filePathToUri :: MonadIO m => FilePath -> m J.Uri From 51e089822845889fd42aad43be22a56d7c4f1fe9 Mon Sep 17 00:00:00 2001 From: fwcd Date: Sat, 27 Jul 2024 03:44:18 +0200 Subject: [PATCH 03/12] Fix monad helper imports --- src/Curry/LanguageServer/Index/Store.hs | 1 + src/Curry/LanguageServer/Utils/Lookup.hs | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/Curry/LanguageServer/Index/Store.hs b/src/Curry/LanguageServer/Index/Store.hs index 37f5e06..9b41dae 100644 --- a/src/Curry/LanguageServer/Index/Store.hs +++ b/src/Curry/LanguageServer/Index/Store.hs @@ -34,6 +34,7 @@ import qualified Base.TopEnv as CT import qualified CompilerEnv as CE import Control.Exception (SomeException) +import Control.Monad (forM_, join, void, unless, filterM) import Control.Monad.Catch (MonadCatch (..)) import Control.Monad.Extra (whenM) import Control.Monad.State diff --git a/src/Curry/LanguageServer/Utils/Lookup.hs b/src/Curry/LanguageServer/Utils/Lookup.hs index d575371..3584e73 100644 --- a/src/Curry/LanguageServer/Utils/Lookup.hs +++ b/src/Curry/LanguageServer/Utils/Lookup.hs @@ -14,7 +14,8 @@ import qualified Curry.Base.SpanInfo as CSPI import qualified Curry.Syntax as CS import Control.Applicative (Alternative ((<|>))) -import Control.Monad.State (State, when, execState, gets, modify) +import Control.Monad (when) +import Control.Monad.State (State, execState, gets, modify) import Curry.LanguageServer.Utils.Convert (currySpanInfo2Range) import Curry.LanguageServer.Utils.General (rangeElem, joinFst, (<.$>)) import Curry.LanguageServer.Utils.Syntax From 47b41cae963ff1ebe93998d9cc8cdf90cacc1d2a Mon Sep 17 00:00:00 2001 From: fwcd Date: Sat, 27 Jul 2024 03:25:37 +0200 Subject: [PATCH 04/12] Migrate to new LSP types This includes removing J.List and migrating to the new (slightly more verbose) enum names. --- .../LanguageServer/Handlers/Diagnostics.hs | 4 +- .../LanguageServer/Handlers/Initialized.hs | 5 +- .../Handlers/TextDocument/CodeAction.hs | 4 +- .../Handlers/TextDocument/CodeLens.hs | 4 +- .../Handlers/TextDocument/Completion.hs | 4 +- .../Handlers/TextDocument/Definition.hs | 2 +- .../Handlers/TextDocument/DocumentSymbol.hs | 2 +- .../Handlers/TextDocument/Hover.hs | 15 +++--- .../Handlers/TextDocument/SignatureHelp.hs | 6 +-- .../Handlers/Workspace/Command.hs | 27 +++++----- .../Handlers/Workspace/Symbol.hs | 2 +- src/Curry/LanguageServer/Utils/Convert.hs | 50 ++++++++++--------- 12 files changed, 65 insertions(+), 60 deletions(-) diff --git a/src/Curry/LanguageServer/Handlers/Diagnostics.hs b/src/Curry/LanguageServer/Handlers/Diagnostics.hs index ccdfb9f..6b03490 100644 --- a/src/Curry/LanguageServer/Handlers/Diagnostics.hs +++ b/src/Curry/LanguageServer/Handlers/Diagnostics.hs @@ -30,8 +30,8 @@ emitDiagnostics normUri entry = do fetchDiagnostics :: (MonadIO m, MonadLsp CFG.Config m) => J.NormalizedUri -> ModuleStoreEntry -> m [J.Diagnostic] fetchDiagnostics normUri entry = do - let warnings = map (curryMsg2Diagnostic J.DsWarning) entry.warningMessages - errors = map (curryMsg2Diagnostic J.DsError) entry.errorMessages + let warnings = map (curryMsg2Diagnostic J.DiagnosticSeverity_Warning) entry.warningMessages + errors = map (curryMsg2Diagnostic J.DiagnosticSeverity_Error) entry.errorMessages diags = warnings ++ errors name = maybe "?" takeBaseName $ normalizedUriToFilePath normUri diff --git a/src/Curry/LanguageServer/Handlers/Initialized.hs b/src/Curry/LanguageServer/Handlers/Initialized.hs index ebf53c2..e4a80b1 100644 --- a/src/Curry/LanguageServer/Handlers/Initialized.hs +++ b/src/Curry/LanguageServer/Handlers/Initialized.hs @@ -10,16 +10,17 @@ import Data.Maybe (maybeToList, fromMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J initializedHandler :: S.Handlers LSM -initializedHandler = S.notificationHandler J.SInitialized $ \_nt -> do +initializedHandler = S.notificationHandler J.SMethod_Initialized $ \_nt -> do infoM "Building index store..." workspaceFolders <- fromMaybe [] <$> S.getWorkspaceFolders let folders = maybeToList . folderToPath =<< workspaceFolders mapM_ addDirToIndexStore folders count <- I.getModuleCount infoM $ "Indexed " <> T.pack (show count) <> " files" - where folderToPath (J.WorkspaceFolder uri _) = J.uriToFilePath $ J.Uri uri + where folderToPath (J.WorkspaceFolder uri _) = J.uriToFilePath uri -- | Indexes a workspace folder recursively. addDirToIndexStore :: FilePath -> LSM () diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs index 8318c54..45ac31a 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs @@ -35,7 +35,7 @@ codeActionHandler = S.requestHandler J.STextDocumentCodeAction $ \req responder actions <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchCodeActions range entry - responder $ Right $ J.List $ J.InR <$> fromMaybe [] actions + responder $ Right $ J.InR <$> fromMaybe [] actions fetchCodeActions :: (MonadIO m, MonadLsp CFG.Config m) => J.Range -> I.ModuleStoreEntry -> m [J.CodeAction] fetchCodeActions range entry = do @@ -63,7 +63,7 @@ instance HasCodeActions (CS.Module (Maybe CT.PredType)) where -- central place to avoid repetition. let text = ppToText i <> " :: " <> ppToText t args = [A.toJSON uri, A.toJSON $ range' ^. J.start, A.toJSON text] - command = J.Command text "decl.applyTypeHint" $ Just $ J.List args + command = J.Command text "decl.applyTypeHint" $ Just args caKind = J.CodeActionQuickFix isPreferred = True lens = J.CodeAction ("Add type annotation '" <> text <> "'") (Just caKind) Nothing (Just isPreferred) Nothing Nothing (Just command) Nothing diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs index 45025ae..da3c1d8 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs @@ -36,7 +36,7 @@ codeLensHandler = S.requestHandler J.STextDocumentCodeLens $ \req responder -> d lenses <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchCodeLenses entry - responder $ Right $ J.List $ fromMaybe [] lenses + responder $ Right $ fromMaybe [] lenses fetchCodeLenses :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.CodeLens] fetchCodeLenses entry = do @@ -60,7 +60,7 @@ instance HasCodeLenses (CS.Module (Maybe CT.PredType)) where -- central place to avoid repetition. let text = ppToText i <> " :: " <> ppToText t args = [A.toJSON uri, A.toJSON $ range ^. J.start, A.toJSON text] - command = J.Command text "decl.applyTypeHint" $ Just $ J.List args + command = J.Command text "decl.applyTypeHint" $ Just args lens = J.CodeLens range (Just command) Nothing return lens diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs index b7d9814..18eccf7 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs @@ -58,7 +58,7 @@ completionHandler = S.requestHandler J.STextDocumentCompletion $ \req responder let maxCompletions = 25 items = take maxCompletions completions incomplete = length completions > maxCompletions - result = J.CompletionList incomplete $ J.List items + result = J.CompletionList incomplete items responder $ Right $ J.InR result fetchCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem] @@ -306,7 +306,7 @@ makeCompletion l k d c it itf es = J.CompletionItem label kind tags detail doc d insertTextFormat = itf insertTextMode = Nothing textEdit = Nothing - additionalTextEdits = J.List <$> es + additionalTextEdits = es commitChars = Nothing command = Nothing xdata = Nothing diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs index 05a6bf6..1d92e0d 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs @@ -33,7 +33,7 @@ definitionHandler = S.requestHandler J.STextDocumentDefinition $ \req responder lift $ debugM $ "Looking up " <> J.getUri (J.fromNormalizedUri normUri) <> " in " <> T.pack (show (M.keys store.modules)) entry <- I.getModule normUri lift $ fetchDefinitions store entry pos - responder $ Right $ J.InR $ J.InR $ J.List $ fromMaybe [] defs + responder $ Right $ J.InR $ J.InR $ fromMaybe [] defs fetchDefinitions :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> J.Position -> m [J.LocationLink] fetchDefinitions store entry pos = do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs index 9486044..f94f38e 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs @@ -26,7 +26,7 @@ documentSymbolHandler = S.requestHandler J.STextDocumentDocumentSymbol $ \req re symbols <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchDocumentSymbols entry - responder $ Right $ J.InL $ J.List $ fromMaybe [] symbols + responder $ Right $ J.InL $ fromMaybe [] symbols fetchDocumentSymbols :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.DocumentSymbol] fetchDocumentSymbols entry = do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs index b56f698..ee80d5d 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Hover.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE FlexibleContexts, OverloadedStrings, OverloadedRecordDot, ViewPatterns #-} +{-# LANGUAGE FlexibleContexts, OverloadedStrings, OverloadedRecordDot, TypeOperators, ViewPatterns #-} module Curry.LanguageServer.Handlers.TextDocument.Hover (hoverHandler) where -- Curry Compiler Libraries + Dependencies @@ -25,10 +25,11 @@ import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J import Language.LSP.Server (MonadLsp) hoverHandler :: S.Handlers LSM -hoverHandler = S.requestHandler J.STextDocumentHover $ \req responder -> do +hoverHandler = S.requestHandler J.SMethod_TextDocumentHover $ \req responder -> do debugM "Processing hover request" let pos = req ^. J.params . J.position uri = req ^. J.params . J.textDocument . J.uri @@ -37,7 +38,7 @@ hoverHandler = S.requestHandler J.STextDocumentHover $ \req responder -> do hover <- runMaybeT $ do entry <- I.getModule normUri MaybeT $ fetchHover store entry pos - responder $ Right hover + responder $ Right $ maybe (J.InR J.Null) J.InL hover fetchHover :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> J.Position -> m (Maybe J.Hover) fetchHover store entry pos = runMaybeT $ do @@ -51,7 +52,7 @@ qualIdentHover store ast pos = do (symbols, range) <- resolveAtPos store ast pos s <- listToMaybe symbols - let contents = J.HoverContents $ J.markedUpContent "curry" $ s.qualIdent <> maybe "" (" :: " <>) s.printedType + let contents = J.InL $ J.mkMarkdownCodeBlock "curry" $ s.qualIdent <> maybe "" (" :: " <>) s.printedType return $ J.Hover contents $ Just range @@ -59,14 +60,14 @@ typedSpanInfoHover :: ModuleAST -> J.Position -> Maybe J.Hover typedSpanInfoHover ast@(moduleIdentifier -> mid) pos = do TypedSpanInfo txt t spi <- findTypeAtPos ast pos - let contents = J.HoverContents $ J.markedUpContent "curry" $ txt <> " :: " <> maybe "?" (ppPredTypeToText mid) t + let contents = J.InL $ J.mkMarkdownCodeBlock "curry" $ txt <> " :: " <> maybe "?" (ppPredTypeToText mid) t range = currySpanInfo2Range spi return $ J.Hover contents range previewHover :: J.Hover -> T.Text -previewHover ((^. J.contents) -> J.HoverContents (J.MarkupContent k t)) = case k of J.MkMarkdown -> markdownToPlain t - J.MkPlainText -> t +previewHover ((^. J.contents) -> J.InL (J.MarkupContent k t)) = case k of J.MarkupKind_Markdown -> markdownToPlain t + J.MarkupKind_PlainText -> t previewHover _ = "?" markdownToPlain :: T.Text -> T.Text diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs index 0026c75..dd7da58 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs @@ -49,7 +49,7 @@ signatureHelpHandler = S.requestHandler J.STextDocumentSignatureHelp $ \req resp vfile <- MaybeT $ S.getVirtualFile normUri MaybeT $ fetchSignatureHelp store entry vfile pos responder $ Right $ fromMaybe emptyHelp sigHelp - where emptyHelp = J.SignatureHelp (J.List []) Nothing Nothing + where emptyHelp = J.SignatureHelp [] Nothing Nothing fetchSignatureHelp :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> VFS.VirtualFile -> J.Position -> m (Maybe J.SignatureHelp) fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do @@ -72,9 +72,9 @@ fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do paramOffsets = reverse $ snd $ foldl (\(n, offs) lbl -> let n' = n + T.length lbl in (n' + T.length paramSep, (n, n') : offs)) (T.length labelStart, []) paramLabels params = flip J.ParameterInformation Nothing . uncurry J.ParameterLabelOffset . bimap fromIntegral fromIntegral <$> paramOffsets label = labelStart <> T.intercalate paramSep (paramLabels ++ maybeToList sym.printedResultType) - sig = J.SignatureInformation label Nothing (Just $ J.List params) (Just activeParam) + sig = J.SignatureInformation label Nothing (Just params) (Just activeParam) sigs = [sig] - return $ J.SignatureHelp (J.List sigs) (Just activeSig) (Just activeParam) + return $ J.SignatureHelp sigs (Just activeSig) (Just activeParam) findExpressionApplication :: I.IndexStore -> ModuleAST -> J.Position -> Maybe (I.Symbol, CSPI.SpanInfo, [CSPI.SpanInfo]) findExpressionApplication store ast pos = lastSafe $ do diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs index 964788b..bcdae41 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings, ViewPatterns #-} +{-# LANGUAGE OverloadedStrings, ViewPatterns, TypeOperators #-} module Curry.LanguageServer.Handlers.Workspace.Command (executeCommandHandler, commands) where import Control.Lens ((^.)) @@ -10,38 +10,39 @@ import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J executeCommandHandler :: S.Handlers LSM -executeCommandHandler = S.requestHandler J.SWorkspaceExecuteCommand $ \req responder -> do +executeCommandHandler = S.requestHandler J.SMethod_WorkspaceExecuteCommand $ \req responder -> do debugM "Processing command execution request" let J.ExecuteCommandParams _ name args = req ^. J.params - res <- executeCommand name $ maybe [] (\(J.List as) -> as) args + res <- executeCommand name $ maybe [] id args responder res -executeCommand :: T.Text -> [A.Value] -> LSM (Either J.ResponseError A.Value) +executeCommand :: T.Text -> [A.Value] -> LSM (Either J.ResponseError (A.Value J.|? J.Null)) executeCommand name args = case lookup name commands of Just command -> command args Nothing -> do let msg = "Unknown command '" <> name <> "'" warnM msg - return $ Left $ J.ResponseError J.InvalidParams msg Nothing + return $ Left $ J.ResponseError (J.InR J.ErrorCodes_InvalidParams) msg Nothing -commands :: [(T.Text, [A.Value] -> LSM (Either J.ResponseError A.Value))] +commands :: [(T.Text, [A.Value] -> LSM (Either J.ResponseError (A.Value J.|? J.Null)))] commands = [ ("ping", \_args -> do infoM "Pong!" - return $ Right A.Null) + return $ Right $ J.InR J.Null) , ("decl.applyTypeHint", \args -> do case args of [A.fromJSON -> A.Success uri, A.fromJSON -> A.Success pos, A.fromJSON -> A.Success text] -> do - let doc = J.VersionedTextDocumentIdentifier uri $ Just 0 + let doc = J.OptionalVersionedTextDocumentIdentifier uri $ J.InL 0 range = J.Range pos pos textEdit = J.TextEdit range $ text <> "\n" - docEdit = J.TextDocumentEdit doc $ J.List [J.InL textEdit] + docEdit = J.TextDocumentEdit doc [J.InL textEdit] docEdits = [docEdit] - workspaceEdit = J.WorkspaceEdit Nothing (Just $ J.List $ J.InL <$> docEdits) Nothing + workspaceEdit = J.WorkspaceEdit Nothing (Just $ J.InL <$> docEdits) Nothing params = J.ApplyWorkspaceEditParams (Just "Apply Type Hint") workspaceEdit - void $ S.sendRequest J.SWorkspaceApplyEdit params (const $ pure ()) - return $ Right A.Null - _ -> return $ Left $ J.ResponseError J.InvalidParams "Invalid arguments!" Nothing) + void $ S.sendRequest J.SMethod_WorkspaceApplyEdit params (const $ pure ()) + return $ Right $ J.InR J.Null + _ -> return $ Left $ J.ResponseError (J.InR J.ErrorCodes_InvalidParams) "Invalid arguments!" Nothing) ] diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs index 3c9d788..67d607f 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs @@ -22,7 +22,7 @@ workspaceSymbolHandler = S.requestHandler J.SWorkspaceSymbol $ \req responder -> store <- getStore symbols <- fetchWorkspaceSymbols store query let maxSymbols = 150 - responder $ Right $ J.List $ take maxSymbols symbols + responder $ Right $ take maxSymbols symbols fetchWorkspaceSymbols :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> T.Text -> m [J.SymbolInformation] fetchWorkspaceSymbols store query = do diff --git a/src/Curry/LanguageServer/Utils/Convert.hs b/src/Curry/LanguageServer/Utils/Convert.hs index d2e4b9c..fca6b1b 100644 --- a/src/Curry/LanguageServer/Utils/Convert.hs +++ b/src/Curry/LanguageServer/Utils/Convert.hs @@ -52,16 +52,18 @@ import qualified Language.LSP.Protocol.Types as J -- Curry Compiler -> Language Server Protocol curryMsg2Diagnostic :: J.DiagnosticSeverity -> CM.Message -> J.Diagnostic -curryMsg2Diagnostic s msg = J.Diagnostic range severity code src text tags related +curryMsg2Diagnostic s msg = J.Diagnostic range severity code codeDesc src text tags related dataValue where range = fromMaybe emptyRange $ currySpanInfo2Range $ CM.msgSpanInfo msg severity = Just s code = Nothing + codeDesc = Nothing src = Nothing text = T.pack $ PP.render $ CM.msgTxt msg -- TODO: It would be better to have the frontend expose this as a flag/tag instead. - tags | "Unused" `T.isPrefixOf` text || "Unreferenced" `T.isPrefixOf` text = Just $ J.List [J.DtUnnecessary] - | otherwise = Just $ J.List [] + tags | "Unused" `T.isPrefixOf` text || "Unreferenced" `T.isPrefixOf` text = Just [J.DiagnosticTag_Unnecessary] + | otherwise = Just [] related = Nothing + dataValue = Nothing curryPos2Pos :: CP.Position -> Maybe J.Position curryPos2Pos CP.NoPos = Nothing @@ -187,7 +189,7 @@ ppPatternToName pat = case pat of _ -> "?" makeDocumentSymbol :: T.Text -> J.SymbolKind -> Maybe J.Range -> Maybe [J.DocumentSymbol] -> J.DocumentSymbol -makeDocumentSymbol n k r cs = J.DocumentSymbol n Nothing k Nothing Nothing r' r' $ J.List <$> cs +makeDocumentSymbol n k r cs = J.DocumentSymbol n Nothing k Nothing Nothing r' r' cs where r' = fromMaybe emptyRange r class HasDocumentSymbols s where @@ -196,7 +198,7 @@ class HasDocumentSymbols s where instance HasDocumentSymbols (CS.Module a) where documentSymbols (CS.Module spi _ _ ident _ _ decls) = [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText ident - symKind = J.SkModule + symKind = J.SymbolKind_Module range = currySpanInfo2Range spi childs = documentSymbols =<< decls @@ -204,41 +206,41 @@ instance HasDocumentSymbols (CS.Decl a) where documentSymbols decl = case decl of CS.InfixDecl _ _ _ idents -> [makeDocumentSymbol name symKind range Nothing] where name = maybe "" ppToText $ listToMaybe idents - symKind = J.SkOperator + symKind = J.SymbolKind_Operator CS.DataDecl _ ident _ cs _ -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText ident - symKind = if length cs > 1 then J.SkEnum - else J.SkStruct + symKind = if length cs > 1 then J.SymbolKind_Enum + else J.SymbolKind_Struct childs = documentSymbols =<< cs CS.NewtypeDecl _ ident _ c _ -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText ident - symKind = J.SkStruct + symKind = J.SymbolKind_Struct childs = documentSymbols c CS.ExternalDataDecl _ ident _ -> [makeDocumentSymbol name symKind range Nothing] where name = ppToText ident - symKind = J.SkStruct + symKind = J.SymbolKind_Struct CS.FunctionDecl _ _ ident eqs -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText ident - symKind = if eqsArity eqs > 0 then J.SkFunction - else J.SkConstant + symKind = if eqsArity eqs > 0 then J.SymbolKind_Function + else J.SymbolKind_Constant childs = documentSymbols =<< eqs CS.TypeDecl _ ident _ _ -> [makeDocumentSymbol name symKind range Nothing] where name = ppToText ident - symKind = J.SkInterface + symKind = J.SymbolKind_Interface CS.ExternalDecl _ vars -> documentSymbols =<< vars CS.FreeDecl _ vars -> documentSymbols =<< vars CS.PatternDecl _ pat rhs -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppPatternToName pat - symKind = if patArity pat > 0 then J.SkFunction - else J.SkConstant + symKind = if patArity pat > 0 then J.SymbolKind_Function + else J.SymbolKind_Constant childs = documentSymbols rhs CS.ClassDecl _ _ _ ident _ decls -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText ident - symKind = J.SkInterface + symKind = J.SymbolKind_Interface childs = documentSymbols =<< decls CS.InstanceDecl _ _ _ qident t decls -> [makeDocumentSymbol name symKind range $ Just childs] where name = ppToText qident <> " (" <> (T.pack $ PP.render $ CPP.pPrintPrec 2 t) <> ")" - symKind = J.SkNamespace + symKind = J.SymbolKind_Namespace childs = documentSymbols =<< decls _ -> [] where lhsArity :: CS.Lhs a -> Int @@ -255,14 +257,14 @@ instance HasDocumentSymbols (CS.Decl a) where range = currySpanInfo2Range $ CSPI.getSpanInfo decl instance HasDocumentSymbols (CS.Var a) where - documentSymbols (CS.Var _ ident) = [makeDocumentSymbol (ppToText ident) J.SkVariable range Nothing] + documentSymbols (CS.Var _ ident) = [makeDocumentSymbol (ppToText ident) J.SymbolKind_Variable range Nothing] where range = currySpanInfo2Range $ CSPI.getSpanInfo ident instance HasDocumentSymbols CS.ConstrDecl where documentSymbols decl = case decl of - CS.ConstrDecl _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SkEnumMember range Nothing] - CS.ConOpDecl _ _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SkOperator range Nothing] - CS.RecordDecl _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SkEnumMember range Nothing] + CS.ConstrDecl _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SymbolKind_EnumMember range Nothing] + CS.ConOpDecl _ _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SymbolKind_Operator range Nothing] + CS.RecordDecl _ ident _ -> [makeDocumentSymbol (ppToText ident) J.SymbolKind_EnumMember range Nothing] where range = currySpanInfo2Range $ CSPI.getSpanInfo decl instance HasDocumentSymbols (CS.Equation a) where @@ -314,7 +316,7 @@ instance HasDocumentSymbols CS.NewConstrDecl where documentSymbols decl = case decl of CS.NewConstrDecl spi ident _ -> [makeDocumentSymbol (ppToText ident) symKind (currySpanInfo2Range spi) Nothing] CS.NewRecordDecl spi ident _ -> [makeDocumentSymbol (ppToText ident) symKind (currySpanInfo2Range spi) Nothing] - where symKind = J.SkEnumMember + where symKind = J.SymbolKind_EnumMember class HasWorkspaceSymbols s where workspaceSymbols :: s -> IO [J.SymbolInformation] @@ -323,8 +325,8 @@ instance (HasDocumentSymbols s, CSPI.HasSpanInfo s) => HasWorkspaceSymbols s whe workspaceSymbols s = do loc <- runMaybeT $ currySpanInfo2Location $ CSPI.getSpanInfo s let documentSymbolToInformations :: J.DocumentSymbol -> [J.SymbolInformation] - documentSymbolToInformations (J.DocumentSymbol n _ k ts d _ _ cs) = ((\l -> J.SymbolInformation n k ts d l Nothing) <$> loc) `maybeCons` cis - where cs' = maybe [] (\(J.List cs'') -> cs'') cs + documentSymbolToInformations (J.DocumentSymbol n _ k ts d _ _ cs) = ((\l -> J.SymbolInformation n k ts Nothing d l) <$> loc) `maybeCons` cis + where cs' = maybe [] id cs cis = documentSymbolToInformations =<< cs' return $ documentSymbolToInformations =<< documentSymbols s From 21b2e210a4a189989cd732293517004f633d2ac2 Mon Sep 17 00:00:00 2001 From: fwcd Date: Sat, 27 Jul 2024 04:14:24 +0200 Subject: [PATCH 05/12] Migrate most handlers to the new LSP types --- src/Curry/LanguageServer/Handlers/Cancel.hs | 4 +- .../Handlers/TextDocument/CodeAction.hs | 7 ++- .../Handlers/TextDocument/CodeLens.hs | 5 +- .../Handlers/TextDocument/Completion.hs | 61 ++++++++++--------- .../Handlers/TextDocument/Definition.hs | 11 ++-- .../Handlers/TextDocument/DocumentSymbol.hs | 6 +- .../Handlers/TextDocument/Notifications.hs | 9 +-- .../Handlers/TextDocument/SignatureHelp.hs | 10 +-- .../Handlers/Workspace/Notifications.hs | 4 +- .../Handlers/Workspace/Symbol.hs | 31 +++++----- 10 files changed, 78 insertions(+), 70 deletions(-) diff --git a/src/Curry/LanguageServer/Handlers/Cancel.hs b/src/Curry/LanguageServer/Handlers/Cancel.hs index 58c1a42..1f2902c 100644 --- a/src/Curry/LanguageServer/Handlers/Cancel.hs +++ b/src/Curry/LanguageServer/Handlers/Cancel.hs @@ -6,10 +6,10 @@ module Curry.LanguageServer.Handlers.Cancel import Curry.LanguageServer.Monad (LSM) import Curry.LanguageServer.Utils.Logging (debugM) import qualified Language.LSP.Server as S -import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J cancelHandler :: S.Handlers LSM -cancelHandler = S.notificationHandler J.SCancelRequest $ \_nt -> do +cancelHandler = S.notificationHandler J.SMethod_CancelRequest $ \_nt -> do debugM "Processing cancel request" -- TODO: This is currently just a stub to prevent error messages -- about the unimplemented request from showing up, we might diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs index 45ac31a..e6755bd 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs @@ -25,9 +25,10 @@ import qualified Language.LSP.Server as S import Language.LSP.Server (MonadLsp) import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J codeActionHandler :: S.Handlers LSM -codeActionHandler = S.requestHandler J.STextDocumentCodeAction $ \req responder -> do +codeActionHandler = S.requestHandler J.SMethod_TextDocumentCodeAction $ \req responder -> do debugM "Processing code action request" let J.CodeActionParams _ _ doc range _ = req ^. J.params uri = doc ^. J.uri @@ -35,7 +36,7 @@ codeActionHandler = S.requestHandler J.STextDocumentCodeAction $ \req responder actions <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchCodeActions range entry - responder $ Right $ J.InR <$> fromMaybe [] actions + responder $ Right $ J.InL $ J.InR <$> fromMaybe [] actions fetchCodeActions :: (MonadIO m, MonadLsp CFG.Config m) => J.Range -> I.ModuleStoreEntry -> m [J.CodeAction] fetchCodeActions range entry = do @@ -64,7 +65,7 @@ instance HasCodeActions (CS.Module (Maybe CT.PredType)) where let text = ppToText i <> " :: " <> ppToText t args = [A.toJSON uri, A.toJSON $ range' ^. J.start, A.toJSON text] command = J.Command text "decl.applyTypeHint" $ Just args - caKind = J.CodeActionQuickFix + caKind = J.CodeActionKind_QuickFix isPreferred = True lens = J.CodeAction ("Add type annotation '" <> text <> "'") (Just caKind) Nothing (Just isPreferred) Nothing Nothing (Just command) Nothing return lens diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs index da3c1d8..04961d0 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs @@ -23,9 +23,10 @@ import qualified Language.LSP.Server as S import Language.LSP.Server (MonadLsp) import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J codeLensHandler :: S.Handlers LSM -codeLensHandler = S.requestHandler J.STextDocumentCodeLens $ \req responder -> do +codeLensHandler = S.requestHandler J.SMethod_TextDocumentCodeLens $ \req responder -> do debugM "Processing code lens request" let J.CodeLensParams _ _ doc = req ^. J.params uri = doc ^. J.uri @@ -36,7 +37,7 @@ codeLensHandler = S.requestHandler J.STextDocumentCodeLens $ \req responder -> d lenses <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchCodeLenses entry - responder $ Right $ fromMaybe [] lenses + responder $ Right $ J.InL $ fromMaybe [] lenses fetchCodeLenses :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.CodeLens] fetchCodeLenses entry = do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs index 18eccf7..1f9402f 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs @@ -31,10 +31,11 @@ import qualified Language.LSP.Server as S import qualified Language.LSP.VFS as VFS import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J import Language.LSP.Server (MonadLsp) completionHandler :: S.Handlers LSM -completionHandler = S.requestHandler J.STextDocumentCompletion $ \req responder -> do +completionHandler = S.requestHandler J.SMethod_TextDocumentCompletion $ \req responder -> do debugM "Processing completion request" let uri = req ^. J.params . J.textDocument . J.uri pos = req ^. J.params . J.position @@ -58,8 +59,8 @@ completionHandler = S.requestHandler J.STextDocumentCompletion $ \req responder let maxCompletions = 25 items = take maxCompletions completions incomplete = length completions > maxCompletions - result = J.CompletionList incomplete items - responder $ Right $ J.InR result + result = J.CompletionList incomplete Nothing items + responder $ Right $ J.InR $ J.InL result fetchCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem] fetchCompletions opts entry store query @@ -83,7 +84,7 @@ pragmaCompletions opts query optionPragmas = makeToolOptionKeyword <$> knownTools makeToolOptionKeyword tool = Tagged tags $ Keyword $ optionPragmaPrefix <> T.pack (show tool) where tags = case tool of - CS.CYMAKE -> [J.CitDeprecated] + CS.CYMAKE -> [J.CompletionItemTag_Deprecated] _ -> [] isLanguagePragma = languagePragmaName `T.isInfixOf` line isOptionPragma = optionPragmaPrefix `T.isInfixOf` line @@ -223,22 +224,22 @@ instance ToCompletionItems CompletionSymbol where edits = cms.importEdits name = fromMaybe (fullName cms) $ T.stripPrefix (VFS.prefixModule query <> ".") $ fullName cms ciKind = case s.kind of - I.ValueFunction | s.arrowArity == Just 0 -> J.CiConstant - | otherwise -> J.CiFunction - I.ValueConstructor | s.arrowArity == Just 0 -> J.CiEnumMember - | otherwise -> J.CiConstructor - I.Module -> J.CiModule - I.TypeData | length s.constructors == 1 -> J.CiStruct - | otherwise -> J.CiEnum - I.TypeNew -> J.CiStruct - I.TypeAlias -> J.CiInterface - I.TypeClass -> J.CiInterface - I.TypeVar -> J.CiVariable - I.Other -> J.CiText + I.ValueFunction | s.arrowArity == Just 0 -> J.CompletionItemKind_Constant + | otherwise -> J.CompletionItemKind_Function + I.ValueConstructor | s.arrowArity == Just 0 -> J.CompletionItemKind_EnumMember + | otherwise -> J.CompletionItemKind_Constructor + I.Module -> J.CompletionItemKind_Module + I.TypeData | length s.constructors == 1 -> J.CompletionItemKind_Struct + | otherwise -> J.CompletionItemKind_Enum + I.TypeNew -> J.CompletionItemKind_Struct + I.TypeAlias -> J.CompletionItemKind_Interface + I.TypeClass -> J.CompletionItemKind_Interface + I.TypeVar -> J.CompletionItemKind_Variable + I.Other -> J.CompletionItemKind_Text insertText | opts.useSnippets = Just $ makeSnippet name s.printedArgumentTypes | otherwise = Just name - insertTextFormat | opts.useSnippets = Just J.Snippet - | otherwise = Just J.PlainText + insertTextFormat | opts.useSnippets = Just J.InsertTextFormat_Snippet + | otherwise = Just J.InsertTextFormat_PlainText detail = s.printedType doc = Just $ T.intercalate "\n\n" $ filter (not . T.null) [ if isNothing edits then "" else "_requires import_" @@ -249,39 +250,39 @@ instance ToCompletionItems Keyword where -- | Creates a completion item from a keyword. toCompletionItems _ _ (Keyword kw) = [makeCompletion label ciKind detail doc insertText insertTextFormat edits] where label = kw - ciKind = J.CiKeyword + ciKind = J.CompletionItemKind_Keyword detail = Nothing doc = Just "Keyword" insertText = Just kw - insertTextFormat = Just J.PlainText + insertTextFormat = Just J.InsertTextFormat_PlainText edits = Nothing instance ToCompletionItems Local where -- | Creates a completion item from a local variable. toCompletionItems opts _ (Local i t) = [makeCompletion label ciKind detail doc insertText insertTextFormat edits] where label = i - ciKind = J.CiVariable + ciKind = J.CompletionItemKind_Variable detail = ppToText <$> t doc = Just "Local" argTypes = (ppToText <$>) $ CT.arrowArgs . CT.unpredType =<< maybeToList t insertText | opts.useSnippets = Just $ makeSnippet i argTypes | otherwise = Just i - insertTextFormat | opts.useSnippets = Just J.Snippet - | otherwise = Just J.PlainText + insertTextFormat | opts.useSnippets = Just J.InsertTextFormat_Snippet + | otherwise = Just J.InsertTextFormat_PlainText edits = Nothing instance ToCompletionItems T.Text where toCompletionItems _ _ txt = [makeCompletion label ciKind detail doc insertText insertTextFormat edits] where label = txt - ciKind = J.CiText + ciKind = J.CompletionItemKind_Text detail = Nothing doc = Nothing insertText = Just txt - insertTextFormat = Just J.PlainText + insertTextFormat = Just J.InsertTextFormat_PlainText edits = Nothing instance ToCompletionItems a => ToCompletionItems (Tagged a) where - toCompletionItems opts query (Tagged tags x) = (J.tags ?~ J.List tags) <$> toCompletionItems opts query x + toCompletionItems opts query (Tagged tags x) = (J.tags ?~ tags) <$> toCompletionItems opts query x -- | Creates a snippet with VSCode-style syntax. makeSnippet :: T.Text -> [T.Text] -> T.Text @@ -289,15 +290,16 @@ makeSnippet name ts = T.intercalate " " $ name : ((\(i, t) -> "${" <> T.pack (sh -- | Creates a completion item using the given label, kind, a detail and doc. makeCompletion :: T.Text -> J.CompletionItemKind -> Maybe T.Text -> Maybe T.Text -> Maybe T.Text -> Maybe J.InsertTextFormat -> Maybe [J.TextEdit] -> J.CompletionItem -makeCompletion l k d c it itf es = J.CompletionItem label kind tags detail doc deprecated +makeCompletion l k d c it itf es = J.CompletionItem label labelDetails kind tags detail doc deprecated preselect sortText filterText insertText - insertTextFormat insertTextMode textEdit + insertTextFormat insertTextMode textEdit textEditText additionalTextEdits commitChars command xdata where label = l + labelDetails = Nothing kind = Just k tags = Nothing detail = d - doc = J.CompletionDocMarkup . J.MarkupContent J.MkMarkdown <$> c + doc = J.InR . J.MarkupContent J.MarkupKind_Markdown <$> c deprecated = Just False preselect = Nothing sortText = Nothing @@ -306,6 +308,7 @@ makeCompletion l k d c it itf es = J.CompletionItem label kind tags detail doc d insertTextFormat = itf insertTextMode = Nothing textEdit = Nothing + textEditText = Nothing additionalTextEdits = es commitChars = Nothing command = Nothing diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs index 1d92e0d..13d78af 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Definition.hs @@ -21,9 +21,10 @@ import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) +import qualified Language.LSP.Protocol.Message as J definitionHandler :: S.Handlers LSM -definitionHandler = S.requestHandler J.STextDocumentDefinition $ \req responder -> do +definitionHandler = S.requestHandler J.SMethod_TextDocumentDefinition $ \req responder -> do debugM "Processing definition request" let pos = req ^. J.params . J.position uri = req ^. J.params . J.textDocument . J.uri @@ -33,9 +34,9 @@ definitionHandler = S.requestHandler J.STextDocumentDefinition $ \req responder lift $ debugM $ "Looking up " <> J.getUri (J.fromNormalizedUri normUri) <> " in " <> T.pack (show (M.keys store.modules)) entry <- I.getModule normUri lift $ fetchDefinitions store entry pos - responder $ Right $ J.InR $ J.InR $ fromMaybe [] defs + responder $ Right $ J.InR $ maybe (J.InR J.Null) J.InL defs -fetchDefinitions :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> J.Position -> m [J.LocationLink] +fetchDefinitions :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> J.Position -> m [J.DefinitionLink] fetchDefinitions store entry pos = do defs <- (fromMaybe [] <$>) $ runMaybeT $ do ast <- liftMaybe entry.moduleAST @@ -43,9 +44,9 @@ fetchDefinitions store entry pos = do infoM $ "Found " <> T.pack (show (length defs)) <> " definition(s)" return defs -definitions :: MonadIO m => I.IndexStore -> ModuleAST -> J.Position -> MaybeT m [J.LocationLink] +definitions :: MonadIO m => I.IndexStore -> ModuleAST -> J.Position -> MaybeT m [J.DefinitionLink] definitions store ast pos = do -- Look up identifier under cursor (symbols, srcRange) <- liftMaybe $ resolveAtPos store ast pos let locations = mapMaybe (.location) symbols - return [J.LocationLink (Just srcRange) destUri destRange destRange | J.Location destUri destRange <- locations] + return [J.DefinitionLink $ J.LocationLink (Just srcRange) destUri destRange destRange | J.Location destUri destRange <- locations] diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs index f94f38e..b9cf251 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/DocumentSymbol.hs @@ -11,22 +11,22 @@ import Curry.LanguageServer.Utils.Logging (debugM) import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath) import Curry.LanguageServer.Utils.Convert (HasDocumentSymbols(..)) import Curry.LanguageServer.Monad (LSM) -import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import Language.LSP.Server (MonadLsp) +import qualified Language.LSP.Protocol.Message as J documentSymbolHandler :: S.Handlers LSM -documentSymbolHandler = S.requestHandler J.STextDocumentDocumentSymbol $ \req responder -> do +documentSymbolHandler = S.requestHandler J.SMethod_TextDocumentDocumentSymbol $ \req responder -> do debugM "Processing document symbols request" let uri = req ^. J.params . J.textDocument . J.uri normUri <- normalizeUriWithPath uri symbols <- runMaybeT $ do entry <- I.getModule normUri lift $ fetchDocumentSymbols entry - responder $ Right $ J.InL $ fromMaybe [] symbols + responder $ Right $ J.InR $ maybe (J.InR J.Null) J.InL symbols fetchDocumentSymbols :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.DocumentSymbol] fetchDocumentSymbols entry = do diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs index 48208da..9977ab3 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Notifications.hs @@ -20,27 +20,28 @@ import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J didOpenHandler :: S.Handlers LSM -didOpenHandler = S.notificationHandler J.STextDocumentDidOpen $ \nt -> do +didOpenHandler = S.notificationHandler J.SMethod_TextDocumentDidOpen $ \nt -> do debugM "Processing open notification" let uri = nt ^. J.params . J.textDocument . J.uri updateIndexStoreDebounced uri didChangeHandler :: S.Handlers LSM -didChangeHandler = S.notificationHandler J.STextDocumentDidChange $ \nt -> do +didChangeHandler = S.notificationHandler J.SMethod_TextDocumentDidChange $ \nt -> do debugM "Processing change notification" let uri = nt ^. J.params . J.textDocument . J.uri updateIndexStoreDebounced uri didSaveHandler :: S.Handlers LSM -didSaveHandler = S.notificationHandler J.STextDocumentDidSave $ \nt -> do +didSaveHandler = S.notificationHandler J.SMethod_TextDocumentDidSave $ \nt -> do debugM "Processing save notification" let uri = nt ^. J.params . J.textDocument . J.uri updateIndexStoreDebounced uri didCloseHandler :: S.Handlers LSM -didCloseHandler = S.notificationHandler J.STextDocumentDidClose $ \_nt -> do +didCloseHandler = S.notificationHandler J.SMethod_TextDocumentDidClose $ \_nt -> do debugM "Processing close notification" -- TODO: Remove file from LSM state? diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs index dd7da58..f0ba551 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs @@ -28,7 +28,7 @@ import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath) import Curry.LanguageServer.Utils.Logging (infoM, debugM) import Data.Bifunctor (bimap) import Data.Foldable (find) -import Data.Maybe (fromMaybe, listToMaybe, maybeToList) +import Data.Maybe (listToMaybe, maybeToList) import qualified Data.List.NonEmpty as N import qualified Data.Text as T import qualified Language.LSP.Server as S @@ -36,9 +36,10 @@ import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import qualified Language.LSP.VFS as VFS import Language.LSP.Server (MonadLsp) +import qualified Language.LSP.Protocol.Message as J signatureHelpHandler :: S.Handlers LSM -signatureHelpHandler = S.requestHandler J.STextDocumentSignatureHelp $ \req responder -> do +signatureHelpHandler = S.requestHandler J.SMethod_TextDocumentSignatureHelp $ \req responder -> do debugM "Processing signature help request" let J.SignatureHelpParams doc pos _ _ = req ^. J.params uri = doc ^. J.uri @@ -48,8 +49,7 @@ signatureHelpHandler = S.requestHandler J.STextDocumentSignatureHelp $ \req resp entry <- I.getModule normUri vfile <- MaybeT $ S.getVirtualFile normUri MaybeT $ fetchSignatureHelp store entry vfile pos - responder $ Right $ fromMaybe emptyHelp sigHelp - where emptyHelp = J.SignatureHelp [] Nothing Nothing + responder $ Right $ maybe (J.InR J.Null) J.InL sigHelp fetchSignatureHelp :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> I.ModuleStoreEntry -> VFS.VirtualFile -> J.Position -> m (Maybe J.SignatureHelp) fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do @@ -70,7 +70,7 @@ fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do paramSep = " -> " paramLabels = sym.printedArgumentTypes paramOffsets = reverse $ snd $ foldl (\(n, offs) lbl -> let n' = n + T.length lbl in (n' + T.length paramSep, (n, n') : offs)) (T.length labelStart, []) paramLabels - params = flip J.ParameterInformation Nothing . uncurry J.ParameterLabelOffset . bimap fromIntegral fromIntegral <$> paramOffsets + params = flip J.ParameterInformation Nothing . J.InR . bimap fromIntegral fromIntegral <$> paramOffsets label = labelStart <> T.intercalate paramSep (paramLabels ++ maybeToList sym.printedResultType) sig = J.SignatureInformation label Nothing (Just params) (Just activeParam) sigs = [sig] diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs b/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs index 42f9ede..6dcda59 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Notifications.hs @@ -6,10 +6,10 @@ module Curry.LanguageServer.Handlers.Workspace.Notifications import Curry.LanguageServer.Monad (LSM) import Curry.LanguageServer.Utils.Logging (debugM) import qualified Language.LSP.Server as S -import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.Protocol.Message as J didChangeConfigurationHandler :: S.Handlers LSM -didChangeConfigurationHandler = S.notificationHandler J.SWorkspaceDidChangeConfiguration $ \_nt -> do +didChangeConfigurationHandler = S.notificationHandler J.SMethod_WorkspaceDidChangeConfiguration $ \_nt -> do debugM "Processing configuration change notification" -- TODO diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs index 67d607f..c1407e2 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Symbol.hs @@ -13,16 +13,17 @@ import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J +import qualified Language.LSP.Protocol.Message as J import Language.LSP.Server (MonadLsp) workspaceSymbolHandler :: S.Handlers LSM -workspaceSymbolHandler = S.requestHandler J.SWorkspaceSymbol $ \req responder -> do +workspaceSymbolHandler = S.requestHandler J.SMethod_WorkspaceSymbol $ \req responder -> do debugM "Processing workspace symbols request" let query = req ^. J.params . J.query store <- getStore symbols <- fetchWorkspaceSymbols store query let maxSymbols = 150 - responder $ Right $ take maxSymbols symbols + responder $ Right $ J.InL $ take maxSymbols symbols fetchWorkspaceSymbols :: (MonadIO m, MonadLsp CFG.Config m) => I.IndexStore -> T.Text -> m [J.SymbolInformation] fetchWorkspaceSymbols store query = do @@ -32,21 +33,21 @@ fetchWorkspaceSymbols store query = do return symbols toWorkspaceSymbol :: I.Symbol -> Maybe J.SymbolInformation -toWorkspaceSymbol s = (\loc -> J.SymbolInformation name kind tags deprecated loc containerName) <$> s.location +toWorkspaceSymbol s = J.SymbolInformation name kind tags containerName deprecated <$> s.location where name = s.ident kind = case s.kind of - I.ValueFunction | s.arrowArity == Just 0 -> J.SkConstant - | otherwise -> J.SkFunction - I.ValueConstructor | s.arrowArity == Just 0 -> J.SkEnumMember - | otherwise -> J.SkConstructor - I.Module -> J.SkModule - I.TypeData | length s.constructors == 1 -> J.SkStruct - | otherwise -> J.SkEnum - I.TypeNew -> J.SkStruct - I.TypeAlias -> J.SkInterface - I.TypeClass -> J.SkInterface - I.TypeVar -> J.SkVariable - I.Other -> J.SkNamespace + I.ValueFunction | s.arrowArity == Just 0 -> J.SymbolKind_Constant + | otherwise -> J.SymbolKind_Function + I.ValueConstructor | s.arrowArity == Just 0 -> J.SymbolKind_EnumMember + | otherwise -> J.SymbolKind_Constructor + I.Module -> J.SymbolKind_Module + I.TypeData | length s.constructors == 1 -> J.SymbolKind_Struct + | otherwise -> J.SymbolKind_Enum + I.TypeNew -> J.SymbolKind_Struct + I.TypeAlias -> J.SymbolKind_Interface + I.TypeClass -> J.SymbolKind_Interface + I.TypeVar -> J.SymbolKind_Variable + I.Other -> J.SymbolKind_Namespace tags = Nothing deprecated = Nothing containerName = Just $ I.symbolParentIdent s From aaf6a1018ddb07827ea8e0f9b1d545053172ace2 Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:06:46 +0200 Subject: [PATCH 06/12] Update to lsp 2.7 and lsp-types 2.3 --- curry-language-server.cabal | 6 +++--- package.yaml | 2 +- stack.yaml | 2 ++ stack.yaml.lock | 14 ++++++++++++++ 4 files changed, 20 insertions(+), 4 deletions(-) diff --git a/curry-language-server.cabal b/curry-language-server.cabal index f5af201..e378928 100644 --- a/curry-language-server.cabal +++ b/curry-language-server.cabal @@ -82,7 +82,7 @@ library , extra ==1.7.* , filepath ==1.4.* , lens >=5.1 && <5.3 - , lsp ==2.3.* + , lsp ==2.7.* , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* @@ -119,7 +119,7 @@ executable curry-language-server , extra ==1.7.* , filepath ==1.4.* , lens >=5.1 && <5.3 - , lsp ==2.3.* + , lsp ==2.7.* , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* @@ -157,7 +157,7 @@ test-suite curry-language-server-test , extra ==1.7.* , filepath ==1.4.* , lens >=5.1 && <5.3 - , lsp ==2.3.* + , lsp ==2.7.* , mtl >=2.2 && <2.4 , parsec >=3.1 && <4 , pretty ==1.1.* diff --git a/package.yaml b/package.yaml index 6704ac9..8439655 100644 --- a/package.yaml +++ b/package.yaml @@ -31,7 +31,7 @@ dependencies: - Glob >= 0.10 && < 0.11 - directory >= 1.3 && < 1.4 - sorted-list >= 0.2 && < 0.3 - - lsp >= 2.3 && < 2.4 + - lsp >= 2.7 && < 2.8 - unliftio-core >= 0.2 && < 0.3 - bytestring >= 0.11 && < 0.12 - bytestring-trie >= 0.2 && < 0.3 diff --git a/stack.yaml b/stack.yaml index 4230b02..49b1e7e 100644 --- a/stack.yaml +++ b/stack.yaml @@ -16,6 +16,8 @@ packages: # These entries can reference officially published versions as well as # forks / in-progress versions pinned to a git hash. For example: extra-deps: + - lsp-2.7.0.0 + - lsp-types-2.3.0.0 - set-extra-1.4.2 - git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git commit: dd346c0c8c72979b8d195d241a8a19258745b134 diff --git a/stack.yaml.lock b/stack.yaml.lock index e2739ac..2f2de89 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -4,6 +4,20 @@ # https://docs.haskellstack.org/en/stable/lock_files packages: +- completed: + hackage: lsp-2.7.0.0@sha256:2a64b40a69fd9638056ca552d5660203019473061cff1d09dccc0c94e40a275c,3834 + pantry-tree: + sha256: 630a5e18d7783c35a296268959c8d9348ee6dc94540047ea58146b310d8de941 + size: 1120 + original: + hackage: lsp-2.7.0.0 +- completed: + hackage: lsp-types-2.3.0.0@sha256:ca17a686bda5dc7ff04105ca7081dce5a90bcd050c8800a13efd68b7f0901f1c,34215 + pantry-tree: + sha256: 0bf22e394dc804c8cee74d19a7f38021cfd48a15082b39a14753c037f2a64288 + size: 51996 + original: + hackage: lsp-types-2.3.0.0 - completed: hackage: set-extra-1.4.2@sha256:a1a3899d7ae01cd72dfd4691ae77cf26e8867731dff70e61307f25ddc7fd875d,564 pantry-tree: From 8b5c88fa328bd4ba9874348a2348394a4f84289c Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:24:00 +0200 Subject: [PATCH 07/12] Vendor removed VFS/completion utilities These were removed upstream in https://github.com/haskell/lsp/pull/552 --- curry-language-server.cabal | 4 ++ package.yaml | 1 + src/Curry/LanguageServer/Utils/VFS.hs | 66 +++++++++++++++++++++++++++ 3 files changed, 71 insertions(+) create mode 100644 src/Curry/LanguageServer/Utils/VFS.hs diff --git a/curry-language-server.cabal b/curry-language-server.cabal index e378928..88729bc 100644 --- a/curry-language-server.cabal +++ b/curry-language-server.cabal @@ -60,6 +60,7 @@ library Curry.LanguageServer.Utils.Sema Curry.LanguageServer.Utils.Syntax Curry.LanguageServer.Utils.Uri + Curry.LanguageServer.Utils.VFS other-modules: Paths_curry_language_server hs-source-dirs: @@ -90,6 +91,7 @@ library , sorted-list ==0.2.* , stm ==2.5.* , text ==2.0.* + , text-rope ==0.2.* , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 @@ -127,6 +129,7 @@ executable curry-language-server , sorted-list ==0.2.* , stm ==2.5.* , text ==2.0.* + , text-rope ==0.2.* , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 @@ -165,6 +168,7 @@ test-suite curry-language-server-test , sorted-list ==0.2.* , stm ==2.5.* , text ==2.0.* + , text-rope ==0.2.* , transformers >=0.5 && <0.7 , unliftio-core ==0.2.* default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 8439655..bab785f 100644 --- a/package.yaml +++ b/package.yaml @@ -25,6 +25,7 @@ dependencies: - exceptions >= 0.10 && < 0.11 - stm >= 2.5 && < 2.6 - text >= 2.0 && < 2.1 + - text-rope >= 0.2 && < 0.3 - lens >= 5.1 && < 5.3 - co-log-core >= 0.3 && < 0.4 - filepath >= 1.4 && < 1.5 diff --git a/src/Curry/LanguageServer/Utils/VFS.hs b/src/Curry/LanguageServer/Utils/VFS.hs new file mode 100644 index 0000000..4deda0e --- /dev/null +++ b/src/Curry/LanguageServer/Utils/VFS.hs @@ -0,0 +1,66 @@ +{-# LANGUAGE OverloadedStrings, MultiWayIf #-} +module Curry.LanguageServer.Utils.VFS + ( PosPrefixInfo (..) + , getCompletionPrefix + ) where + +import Data.Maybe (listToMaybe, fromMaybe) +import qualified Data.Text as T +import qualified Data.Text.Utf16.Rope.Mixed as Rope +import qualified Language.LSP.Protocol.Types as J +import qualified Language.LSP.VFS as VFS +import Data.Char (isAlphaNum) + +-- Source: https://github.com/haskell/haskell-language-server/blob/a4bcaa31/ghcide/src/Development/IDE/Plugin/Completions/Types.hs#L134-L152 +-- License: Apache 2.0 + +-- | Describes the line at the current cursor position +data PosPrefixInfo = PosPrefixInfo + { fullLine :: !T.Text + -- ^ The full contents of the line the cursor is at + + , prefixScope :: !T.Text + -- ^ If any, the module name that was typed right before the cursor position. + -- For example, if the user has typed "Data.Maybe.from", then this property + -- will be "Data.Maybe" + -- If OverloadedRecordDot is enabled, "Shape.rect.width" will be + -- "Shape.rect" + + , prefixText :: !T.Text + -- ^ The word right before the cursor position, after removing the module part. + -- For example if the user has typed "Data.Maybe.from", + -- then this property will be "from" + , cursorPos :: !J.Position + -- ^ The cursor position + } deriving (Show,Eq) + +-- Source: https://github.com/haskell/haskell-language-server/blob/a4bcaa31/ghcide/src/Development/IDE/Plugin/Completions/Logic.hs#L889-L916 +-- License: Apache 2.0 + +getCompletionPrefix :: J.Position -> VFS.VirtualFile -> PosPrefixInfo +getCompletionPrefix pos (VFS.VirtualFile _ _ ropetext) = getCompletionPrefixFromRope pos ropetext + +getCompletionPrefixFromRope :: J.Position -> Rope.Rope -> PosPrefixInfo +getCompletionPrefixFromRope pos@(J.Position l c) ropetext = + fromMaybe (PosPrefixInfo "" "" "" pos) $ do -- Maybe monad + let headMaybe = listToMaybe + lastMaybe = headMaybe . reverse + + -- grab the entire line the cursor is at + curLine <- headMaybe $ Rope.lines + $ fst $ Rope.splitAtLine 1 $ snd $ Rope.splitAtLine (fromIntegral l) ropetext + let beforePos = T.take (fromIntegral c) curLine + -- the word getting typed, after previous space and before cursor + curWord <- + if | T.null beforePos -> Just "" + | T.last beforePos == ' ' -> Just "" -- don't count abc as the curword in 'abc ' + | otherwise -> lastMaybe (T.words beforePos) + + let parts = T.split (=='.') + $ T.takeWhileEnd (\x -> isAlphaNum x || x `elem` ("._'"::String)) curWord + case reverse parts of + [] -> Nothing + (x:xs) -> do + let modParts = reverse $ filter (not .T.null) xs + modName = T.intercalate "." modParts + return $ PosPrefixInfo { fullLine = curLine, prefixScope = modName, prefixText = x, cursorPos = pos } From 632af987c673c272f6e19722bd4793b58e257cdc Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:29:36 +0200 Subject: [PATCH 08/12] Use vendored VFS utilities in completion handler --- .../Handlers/TextDocument/Completion.hs | 42 +++++++++---------- 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs index 1f9402f..b64aafc 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/Completion.hs @@ -20,6 +20,7 @@ import Curry.LanguageServer.Utils.Logging (debugM, infoM) import Curry.LanguageServer.Utils.Syntax (HasIdentifiers (..)) import Curry.LanguageServer.Utils.Lookup (findScopeAtPos) import Curry.LanguageServer.Utils.Uri (normalizeUriWithPath) +import Curry.LanguageServer.Utils.VFS (PosPrefixInfo (..), getCompletionPrefix) import Curry.LanguageServer.Monad (LSM) import Data.Bifunctor (first) import Data.List.Extra (nubOrdOn) @@ -28,7 +29,6 @@ import Data.Maybe (maybeToList, fromMaybe, isNothing) import qualified Data.Set as S import qualified Data.Text as T import qualified Language.LSP.Server as S -import qualified Language.LSP.VFS as VFS import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Protocol.Lens as J import qualified Language.LSP.Protocol.Message as J @@ -46,9 +46,9 @@ completionHandler = S.requestHandler J.SMethod_TextDocumentCompletion $ \req res store <- get entry <- I.getModule normUri vfile <- MaybeT $ S.getVirtualFile normUri - query <- MaybeT $ VFS.getCompletionPrefix pos vfile - let opts = CompletionOptions + let query = getCompletionPrefix pos vfile + opts = CompletionOptions { useSnippets = cfg.useSnippetCompletions && fromMaybe False (do docCapabilities <- capabilities ^. J.textDocument cmCapabilities <- docCapabilities ^. J.completion @@ -62,21 +62,21 @@ completionHandler = S.requestHandler J.SMethod_TextDocumentCompletion $ \req res result = J.CompletionList incomplete Nothing items responder $ Right $ J.InR $ J.InL result -fetchCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem] +fetchCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> PosPrefixInfo -> m [J.CompletionItem] fetchCompletions opts entry store query | isPragma = pragmaCompletions opts query | isImport = importCompletions opts store query | otherwise = generalCompletions opts entry store query - where line = VFS.fullLine query + where line = query.fullLine isPragma = "{-#" `T.isPrefixOf` line isImport = "import " `T.isPrefixOf` line -pragmaCompletions :: MonadIO m => CompletionOptions -> VFS.PosPrefixInfo -> m [J.CompletionItem] +pragmaCompletions :: MonadIO m => CompletionOptions -> PosPrefixInfo -> m [J.CompletionItem] pragmaCompletions opts query | isLanguagePragma = return $ toMatchingCompletions opts query knownExtensions | isOptionPragma = return [] | otherwise = return $ toMatchingCompletions opts query pragmaKeywords - where line = VFS.fullLine query + where line = query.fullLine languagePragmaName = "LANGUAGE" optionPragmaPrefix = "OPTIONS_" languagePragma = Tagged [] $ Keyword languagePragmaName @@ -91,7 +91,7 @@ pragmaCompletions opts query pragmaKeywords = languagePragma : optionPragmas knownExtensions = Keyword . T.pack . show <$> ([minBound..maxBound] :: [CS.KnownExtension]) -importCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem] +importCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.IndexStore -> PosPrefixInfo -> m [J.CompletionItem] importCompletions opts store query = do let modules = nubOrdOn (.qualIdent) $ I.storedModuleSymbolsWithPrefix (fullPrefix query) store moduleCompletions = toMatchingCompletions opts query $ (\s -> CompletionSymbol s Nothing Nothing) <$> modules @@ -100,22 +100,22 @@ importCompletions opts store query = do infoM $ "Found " <> T.pack (show (length completions)) <> " import completion(s)" return completions -generalCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> VFS.PosPrefixInfo -> m [J.CompletionItem] +generalCompletions :: (MonadIO m, MonadLsp CFG.Config m) => CompletionOptions -> I.ModuleStoreEntry -> I.IndexStore -> PosPrefixInfo -> m [J.CompletionItem] generalCompletions opts entry store query = do - let localIdentifiers = join <$> maybe M.empty (`findScopeAtPos` VFS.cursorPos query) entry.moduleAST + let localIdentifiers = join <$> maybe M.empty (`findScopeAtPos` query.cursorPos) entry.moduleAST localIdentifiers' = M.fromList $ map (first ppToText) $ M.toList localIdentifiers localCompletions = toMatchingCompletions opts query $ uncurry Local <$> M.toList localIdentifiers' symbols = filter (flip M.notMember localIdentifiers' . (.ident)) $ nubOrdOn (.qualIdent) - $ I.storedSymbolsWithPrefix (VFS.prefixText query) store + $ I.storedSymbolsWithPrefix query.prefixText store symbolCompletions = toMatchingCompletions opts query $ toCompletionSymbols entry =<< symbols keywordCompletions = toMatchingCompletions opts query keywords completions = localCompletions ++ symbolCompletions ++ keywordCompletions infoM $ "Local identifiers in scope: " <> T.pack (show (M.keys localIdentifiers')) - infoM $ "Found " <> T.pack (show (length completions)) <> " completion(s) with prefix '" <> T.pack (show (VFS.prefixText query)) <> "'" + infoM $ "Found " <> T.pack (show (length completions)) <> " completion(s) with prefix '" <> T.pack (show query.prefixText) <> "'" return completions where keywords = Keyword <$> ["case", "class", "data", "default", "deriving", "do", "else", "external", "fcase", "free", "if", "import", "in", "infix", "infixl", "infixr", "instance", "let", "module", "newtype", "of", "then", "type", "where", "as", "ccall", "forall", "hiding", "interface", "primitive", "qualified"] -toMatchingCompletions :: (ToCompletionItems a, CompletionQueryFilter a, Foldable t) => CompletionOptions -> VFS.PosPrefixInfo -> t a -> [J.CompletionItem] +toMatchingCompletions :: (ToCompletionItems a, CompletionQueryFilter a, Foldable t) => CompletionOptions -> PosPrefixInfo -> t a -> [J.CompletionItem] toMatchingCompletions opts query = (toCompletionItems opts query =<<) . filterF (matchesCompletionQuery query) newtype Keyword = Keyword T.Text @@ -192,21 +192,21 @@ fullName cms | s.kind == I.Module = s.qualIdent moduleName = cms.moduleName -- | The fully qualified prefix of the completion query. -fullPrefix :: VFS.PosPrefixInfo -> T.Text -fullPrefix query | T.null (VFS.prefixModule query) = VFS.prefixText query - | otherwise = VFS.prefixModule query <> "." <> VFS.prefixText query +fullPrefix :: PosPrefixInfo -> T.Text +fullPrefix query | T.null query.prefixScope = query.prefixText + | otherwise = query.prefixScope <> "." <> query.prefixText class CompletionQueryFilter a where - matchesCompletionQuery :: VFS.PosPrefixInfo -> a -> Bool + matchesCompletionQuery :: PosPrefixInfo -> a -> Bool instance CompletionQueryFilter T.Text where - matchesCompletionQuery query txt = VFS.prefixText query `T.isPrefixOf` txt && T.null (VFS.prefixModule query) + matchesCompletionQuery query txt = query.prefixText `T.isPrefixOf` txt && T.null query.prefixScope instance CompletionQueryFilter Keyword where matchesCompletionQuery query (Keyword txt) = matchesCompletionQuery query txt instance CompletionQueryFilter Local where - matchesCompletionQuery query (Local i _) = VFS.prefixText query `T.isPrefixOf` i + matchesCompletionQuery query (Local i _) = query.prefixText `T.isPrefixOf` i instance CompletionQueryFilter a => CompletionQueryFilter (Tagged a) where matchesCompletionQuery query (Tagged _ x) = matchesCompletionQuery query x @@ -215,14 +215,14 @@ instance CompletionQueryFilter CompletionSymbol where matchesCompletionQuery query cms = fullPrefix query `T.isPrefixOf` fullName cms class ToCompletionItems a where - toCompletionItems :: CompletionOptions -> VFS.PosPrefixInfo -> a -> [J.CompletionItem] + toCompletionItems :: CompletionOptions -> PosPrefixInfo -> a -> [J.CompletionItem] instance ToCompletionItems CompletionSymbol where -- | Converts a Curry value binding to a completion item. toCompletionItems opts query cms = [makeCompletion name ciKind detail doc insertText insertTextFormat edits] where s = cms.symbol edits = cms.importEdits - name = fromMaybe (fullName cms) $ T.stripPrefix (VFS.prefixModule query <> ".") $ fullName cms + name = fromMaybe (fullName cms) $ T.stripPrefix (query.prefixScope <> ".") $ fullName cms ciKind = case s.kind of I.ValueFunction | s.arrowArity == Just 0 -> J.CompletionItemKind_Constant | otherwise -> J.CompletionItemKind_Function From fd1a77d5bc5af80fa1f082f9c6ee6c162871f5e4 Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:39:33 +0200 Subject: [PATCH 09/12] Migrate workspace command handler --- .../LanguageServer/Handlers/Workspace/Command.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs index bcdae41..8be7090 100644 --- a/src/Curry/LanguageServer/Handlers/Workspace/Command.hs +++ b/src/Curry/LanguageServer/Handlers/Workspace/Command.hs @@ -1,11 +1,12 @@ -{-# LANGUAGE OverloadedStrings, ViewPatterns, TypeOperators #-} +{-# LANGUAGE DataKinds, OverloadedStrings, ViewPatterns, TypeOperators #-} module Curry.LanguageServer.Handlers.Workspace.Command (executeCommandHandler, commands) where import Control.Lens ((^.)) import Control.Monad (void) import Curry.LanguageServer.Monad (LSM) -import Curry.LanguageServer.Utils.Logging (debugM, infoM, warnM) +import Curry.LanguageServer.Utils.Logging (debugM, infoM) import qualified Data.Aeson as A +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Language.LSP.Server as S import qualified Language.LSP.Protocol.Types as J @@ -16,18 +17,17 @@ executeCommandHandler :: S.Handlers LSM executeCommandHandler = S.requestHandler J.SMethod_WorkspaceExecuteCommand $ \req responder -> do debugM "Processing command execution request" let J.ExecuteCommandParams _ name args = req ^. J.params - res <- executeCommand name $ maybe [] id args + res <- executeCommand name $ fromMaybe [] args responder res -executeCommand :: T.Text -> [A.Value] -> LSM (Either J.ResponseError (A.Value J.|? J.Null)) +executeCommand :: T.Text -> [A.Value] -> LSM (Either (J.TResponseError J.Method_WorkspaceExecuteCommand) (A.Value J.|? J.Null)) executeCommand name args = case lookup name commands of Just command -> command args Nothing -> do let msg = "Unknown command '" <> name <> "'" - warnM msg - return $ Left $ J.ResponseError (J.InR J.ErrorCodes_InvalidParams) msg Nothing + return $ Left $ J.TResponseError (J.InR J.ErrorCodes_InvalidParams) msg Nothing -commands :: [(T.Text, [A.Value] -> LSM (Either J.ResponseError (A.Value J.|? J.Null)))] +commands :: [(T.Text, [A.Value] -> LSM (Either (J.TResponseError J.Method_WorkspaceExecuteCommand) (A.Value J.|? J.Null)))] commands = [ ("ping", \_args -> do infoM "Pong!" @@ -44,5 +44,5 @@ commands = params = J.ApplyWorkspaceEditParams (Just "Apply Type Hint") workspaceEdit void $ S.sendRequest J.SMethod_WorkspaceApplyEdit params (const $ pure ()) return $ Right $ J.InR J.Null - _ -> return $ Left $ J.ResponseError (J.InR J.ErrorCodes_InvalidParams) "Invalid arguments!" Nothing) + _ -> return $ Left $ J.TResponseError (J.InR J.ErrorCodes_InvalidParams) "Invalid arguments!" Nothing) ] From 8d4529f94cef482987833c39dac95eb50b1c9eaa Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:40:56 +0200 Subject: [PATCH 10/12] Migrate signature help handler --- .../LanguageServer/Handlers/TextDocument/SignatureHelp.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs index f0ba551..dbf2709 100644 --- a/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs +++ b/src/Curry/LanguageServer/Handlers/TextDocument/SignatureHelp.hs @@ -72,9 +72,9 @@ fetchSignatureHelp store entry vfile pos@(J.Position l c) = runMaybeT $ do paramOffsets = reverse $ snd $ foldl (\(n, offs) lbl -> let n' = n + T.length lbl in (n' + T.length paramSep, (n, n') : offs)) (T.length labelStart, []) paramLabels params = flip J.ParameterInformation Nothing . J.InR . bimap fromIntegral fromIntegral <$> paramOffsets label = labelStart <> T.intercalate paramSep (paramLabels ++ maybeToList sym.printedResultType) - sig = J.SignatureInformation label Nothing (Just params) (Just activeParam) + sig = J.SignatureInformation label Nothing (Just params) (Just (J.InL activeParam)) sigs = [sig] - return $ J.SignatureHelp sigs (Just activeSig) (Just activeParam) + return $ J.SignatureHelp sigs (Just activeSig) (Just (J.InL activeParam)) findExpressionApplication :: I.IndexStore -> ModuleAST -> J.Position -> Maybe (I.Symbol, CSPI.SpanInfo, [CSPI.SpanInfo]) findExpressionApplication store ast pos = lastSafe $ do From 84936ab03830f340f826acb3a771f7de9084d31f Mon Sep 17 00:00:00 2001 From: fwcd Date: Tue, 30 Jul 2024 00:50:40 +0200 Subject: [PATCH 11/12] Migrate language server initialization --- app/Main.hs | 18 +++++++++++------- src/Curry/LanguageServer/Handlers.hs | 5 +++-- 2 files changed, 14 insertions(+), 9 deletions(-) diff --git a/app/Main.hs b/app/Main.hs index daf8540..ddcf6bc 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -25,18 +25,22 @@ runLanguageServer = do state <- newLSStateVar S.runServerWithHandles logger logger stdin stdout $ S.ServerDefinition { S.defaultConfig = def - , S.onConfigurationChange = \_old v -> case A.fromJSON v of + , S.parseConfig = \_old v -> case A.fromJSON v of A.Error e -> Left $ T.pack e A.Success cfg -> Right (cfg :: CFG.Config) + , S.configSection = "curry" + -- TODO: Handle configuration changes (ideally from here, not in the didChangeConfiguration handler) + -- See https://hackage.haskell.org/package/lsp-2.7.0.0/docs/Language-LSP-Server.html#t:ServerDefinition + , S.onConfigChange = const $ pure () , S.doInitialize = const . pure . Right , S.staticHandlers = handlers , S.interpretHandler = \env -> S.Iso (\lsm -> runLSM lsm state env) liftIO , S.options = S.defaultOptions - { S.textDocumentSync = Just syncOptions - , S.completionTriggerCharacters = Just ['.'] - , S.signatureHelpTriggerCharacters = Just [' ', '(', ')'] - , S.executeCommandCommands = Just $ fst <$> commands - , S.serverInfo = Just $ J.ServerInfo "Curry Language Server" Nothing + { S.optTextDocumentSync = Just syncOptions + , S.optCompletionTriggerCharacters = Just ['.'] + , S.optSignatureHelpTriggerCharacters = Just [' ', '(', ')'] + , S.optExecuteCommandCommands = Just $ fst <$> commands + , S.optServerInfo = Just $ J.ServerInfo "Curry Language Server" Nothing } } where @@ -50,7 +54,7 @@ runLanguageServer = do logger = LogAction $ const $ return () syncOptions = J.TextDocumentSyncOptions (Just True) -- open/close notifications - (Just J.TdSyncIncremental) -- changes + (Just J.TextDocumentSyncKind_Incremental) -- changes (Just False) -- will save (Just False) -- will save (wait until requests are sent to server) (Just $ J.InR $ J.SaveOptions $ Just False) -- save diff --git a/src/Curry/LanguageServer/Handlers.hs b/src/Curry/LanguageServer/Handlers.hs index c9ab43e..51b6f95 100644 --- a/src/Curry/LanguageServer/Handlers.hs +++ b/src/Curry/LanguageServer/Handlers.hs @@ -14,10 +14,11 @@ import Curry.LanguageServer.Handlers.Workspace.Command (executeCommandHandler) import Curry.LanguageServer.Handlers.Workspace.Notifications (didChangeConfigurationHandler) import Curry.LanguageServer.Handlers.Workspace.Symbol (workspaceSymbolHandler) import Curry.LanguageServer.Monad (LSM) +import qualified Language.LSP.Protocol.Types as J import qualified Language.LSP.Server as S -handlers :: S.Handlers LSM -handlers = mconcat +handlers :: J.ClientCapabilities -> S.Handlers LSM +handlers _caps = mconcat [ -- Request handlers completionHandler , executeCommandHandler From 91737602da49bd8412a99b828996fa16eb7b1170 Mon Sep 17 00:00:00 2001 From: fwcd Date: Thu, 10 Oct 2024 18:18:46 +0200 Subject: [PATCH 12/12] Bump curry-frontend to current master --- stack.yaml | 2 +- stack.yaml.lock | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/stack.yaml b/stack.yaml index 49b1e7e..fc66beb 100644 --- a/stack.yaml +++ b/stack.yaml @@ -20,7 +20,7 @@ extra-deps: - lsp-types-2.3.0.0 - set-extra-1.4.2 - git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git - commit: dd346c0c8c72979b8d195d241a8a19258745b134 + commit: bd1750a68e011e56c176491a558885b5268173b5 # Override default flag values for local packages and extra-deps # flags: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 2f2de89..aa46eef 100644 --- a/stack.yaml.lock +++ b/stack.yaml.lock @@ -26,15 +26,15 @@ packages: original: hackage: set-extra-1.4.2 - completed: - commit: dd346c0c8c72979b8d195d241a8a19258745b134 + commit: bd1750a68e011e56c176491a558885b5268173b5 git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git name: curry-frontend pantry-tree: - sha256: 3b2f6df898d989bf51fe83ee6bd73383e06fe07d1606dd0c0386ad6375c73109 + sha256: 911cb32d609278b24516b1412aede02daa88f933dc2935399821d418b881ab46 size: 17097 version: 2.1.1 original: - commit: dd346c0c8c72979b8d195d241a8a19258745b134 + commit: bd1750a68e011e56c176491a558885b5268173b5 git: https://git.ps.informatik.uni-kiel.de/curry/curry-frontend.git snapshots: - completed: