Merge pull request #70 from fwcd/lts-22.30

Migrate to LTS 22.30 (GHC 9.6) and `lsp` 2.7

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)
@@ -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

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
 
@@ -60,16 +60,17 @@ 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:
       src
   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 +82,17 @@ 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.7.*
+    , 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.*
+    , text-rope ==0.2.*
+    , transformers >=0.5 && <0.7
     , unliftio-core ==0.2.*
   default-language: Haskell2010
 
@@ -103,9 +105,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 +120,17 @@ 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.7.*
+    , 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.*
+    , text-rope ==0.2.*
+    , transformers >=0.5 && <0.7
     , unliftio-core ==0.2.*
   default-language: Haskell2010
 
@@ -141,9 +144,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 +159,16 @@ 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.7.*
+    , 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.*
+    , text-rope ==0.2.*
+    , transformers >=0.5 && <0.7
     , unliftio-core ==0.2.*
   default-language: Haskell2010

package.yaml

@@ -13,25 +13,26 @@ 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
+  - text-rope       >= 0.2  && < 0.3
+  - 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.7  && < 2.8
   - unliftio-core   >= 0.2  && < 0.3
   - bytestring      >= 0.11 && < 0.12
   - bytestring-trie >= 0.2  && < 0.3

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

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.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

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 ()
@@ -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
 

src/Curry/LanguageServer/Handlers/Initialized.hs

@@ -9,17 +9,18 @@ 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
+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 ()

src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs

@@ -23,19 +23,20 @@ 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
+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
     normUri <- normalizeUriWithPath uri
     actions <- runMaybeT $ do
         entry <- I.getModule normUri
         lift $ fetchCodeActions range entry
-    responder $ Right $ J.List $ 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
@@ -63,8 +64,8 @@ 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
-                    caKind = J.CodeActionQuickFix
+                    command = J.Command text "decl.applyTypeHint" $ Just args
+                    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

src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs

@@ -21,11 +21,12 @@ 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
+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 $ J.List $ fromMaybe [] lenses
+        responder $ Right $ J.InL $ fromMaybe [] lenses
 
 fetchCodeLenses :: (MonadIO m, MonadLsp CFG.Config m) => I.ModuleStoreEntry -> m [J.CodeLens]
 fetchCodeLenses entry = do
@@ -60,7 +61,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