Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Migrate to LTS 22.30 (GHC 9.6) and lsp 2.7 #70

Merged
merged 12 commits into from
Oct 10, 2024
20 changes: 12 additions & 8 deletions app/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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
Expand All @@ -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
48 changes: 26 additions & 22 deletions curry-language-server.cabal
Original file line number Diff line number Diff line change
@@ -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

Expand Down Expand Up @@ -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.*
Expand All @@ -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

Expand All @@ -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.*
Expand All @@ -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

Expand All @@ -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.*
Expand All @@ -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
15 changes: 8 additions & 7 deletions package.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
5 changes: 3 additions & 2 deletions src/Curry/LanguageServer/Handlers.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions src/Curry/LanguageServer/Handlers/Cancel.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions src/Curry/LanguageServer/Handlers/Diagnostics.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand All @@ -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

Expand Down
7 changes: 4 additions & 3 deletions src/Curry/LanguageServer/Handlers/Initialized.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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 ()
Expand Down
13 changes: 7 additions & 6 deletions src/Curry/LanguageServer/Handlers/TextDocument/CodeAction.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
11 changes: 6 additions & 5 deletions src/Curry/LanguageServer/Handlers/TextDocument/CodeLens.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand All @@ -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

Expand Down
Loading