From 0bc8d43ca3af9a749a0021ec233e9255d2bb105e Mon Sep 17 00:00:00 2001 From: Vekhir <134215107+Vekhir@users.noreply.github.com> Date: Mon, 25 Dec 2023 12:19:37 +0100 Subject: [PATCH] feat: Add support for LSP 2 (#2560) * feat: Add support for LSP 2 * fix: Update CI lsp versions lsp 2.x needs 'row-types' --------- Co-authored-by: Mann mit Hut --- dhall-lsp-server/dhall-lsp-server.cabal | 6 +- .../src/Dhall/LSP/Backend/Dhall.hs | 2 +- dhall-lsp-server/src/Dhall/LSP/Handlers.hs | 128 +++++++++--------- dhall-lsp-server/src/Dhall/LSP/Server.hs | 31 +++-- dhall-lsp-server/src/Dhall/LSP/State.hs | 2 +- dhall-lsp-server/tests/Main.hs | 30 ++-- 6 files changed, 105 insertions(+), 94 deletions(-) diff --git a/dhall-lsp-server/dhall-lsp-server.cabal b/dhall-lsp-server/dhall-lsp-server.cabal index bf8b11b9b..0d3d3aed9 100644 --- a/dhall-lsp-server/dhall-lsp-server.cabal +++ b/dhall-lsp-server/dhall-lsp-server.cabal @@ -52,7 +52,7 @@ library , dhall >= 1.38.0 && < 1.43 , dhall-json >= 1.4 && < 1.8 , filepath >= 1.4.2 && < 1.5 - , lsp >= 1.2.0.0 && < 1.5 + , lsp >= 2.1.0.0 && < 2.2 , rope-utf16-splay >= 0.3.1.0 && < 0.5 , hslogger >= 1.2.10 && < 1.4 , lens >= 4.16.1 && < 5.3 @@ -104,9 +104,9 @@ Test-Suite tests GHC-Options: -Wall Build-Depends: base , - lsp-types >= 1.2.0.0 && < 1.5 , + lsp-types >= 2.0.1 && < 2.1 , hspec >= 2.7 && < 2.11 , - lsp-test >= 0.13.0.0 && < 0.15 , + lsp-test >= 0.15.0.0 && < 0.16 , tasty >= 0.11.2 && < 1.5 , tasty-hspec >= 1.1 && < 1.3 , text >= 0.11 && < 2.1 diff --git a/dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs b/dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs index 32813f294..e7e60df83 100644 --- a/dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs +++ b/dhall-lsp-server/src/Dhall/LSP/Backend/Dhall.hs @@ -44,7 +44,7 @@ import qualified Dhall.Import as Dhall import qualified Dhall.Map import qualified Dhall.Parser as Dhall import qualified Dhall.TypeCheck as Dhall -import qualified Language.LSP.Types as LSP.Types +import qualified Language.LSP.Protocol.Types as LSP.Types import qualified Network.URI as URI diff --git a/dhall-lsp-server/src/Dhall/LSP/Handlers.hs b/dhall-lsp-server/src/Dhall/LSP/Handlers.hs index fe37522f5..982510fc0 100644 --- a/dhall-lsp-server/src/Dhall/LSP/Handlers.hs +++ b/dhall-lsp-server/src/Dhall/LSP/Handlers.hs @@ -4,6 +4,7 @@ {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeOperators #-} module Dhall.LSP.Handlers where @@ -67,18 +68,18 @@ import Data.Aeson (FromJSON(..), Value(..)) import Data.Maybe (maybeToList) import Data.Text (Text, isPrefixOf) import Language.LSP.Server (Handlers, LspT) -import Language.LSP.Types hiding (Range(..), line) -import Language.LSP.Types.Lens +import Language.LSP.Protocol.Types hiding (Range(..)) +import Language.LSP.Protocol.Message +import Language.LSP.Protocol.Lens import System.FilePath import Text.Megaparsec (SourcePos (..), unPos) import qualified Data.Aeson as Aeson -import qualified Data.HashMap.Strict as HashMap import qualified Data.Map.Strict as Map import qualified Data.Rope.UTF16 as Rope import qualified Data.Text as Text import qualified Language.LSP.Server as LSP -import qualified Language.LSP.Types as LSP.Types +import qualified Language.LSP.Protocol.Types as LSP.Types import qualified Language.LSP.VFS as LSP import qualified Network.URI as URI import qualified Network.URI.Encode as URI @@ -132,7 +133,7 @@ rangeToJSON (Range (x1,y1) (x2,y2)) = hoverHandler :: Handlers HandlerM hoverHandler = - LSP.requestHandler STextDocumentHover \request respond -> handleErrorWithDefault respond Nothing do + LSP.requestHandler SMethod_TextDocumentHover \request respond -> handleErrorWithDefault respond (InR LSP.Types.Null) do let uri_ = request^.params.textDocument.uri let Position{ _line = fromIntegral -> _line, _character = fromIntegral -> _character } = request^.params.position @@ -150,8 +151,8 @@ hoverHandler = Right (mSrc, typ) -> do let _range = fmap (rangeToJSON . rangeFromDhall) mSrc - let _contents = HoverContents (MarkupContent MkPlainText (pretty typ)) - respond (Right (Just Hover{ _contents, _range })) + let _contents = InL (mkPlainText (pretty typ)) + respond (Right (InL Hover{ _contents, _range })) Just err -> do let isHovered (Diagnosis _ (Just (Range left right)) _) = left <= (_line, _character) && (_line, _character) <= right @@ -162,14 +163,14 @@ hoverHandler = let _range = Just (rangeToJSON (Range left right)) encodedDiag = URI.encode (Text.unpack diagnosis) - _kind = MkMarkdown + _kind = MarkupKind_Markdown _value = "[Explain error](dhall-explain:?" <> Text.pack encodedDiag <> " )" - _contents = HoverContents MarkupContent{..} + _contents = InL MarkupContent{..} Just Hover{ _contents, _range } hoverFromDiagnosis _ = Nothing @@ -181,11 +182,11 @@ hoverHandler = hoverFromDiagnosis explanation - respond (Right mHover) + respond (Right (maybeToNull mHover)) documentLinkHandler :: Handlers HandlerM documentLinkHandler = - LSP.requestHandler STextDocumentDocumentLink \request respond -> handleErrorWithDefault respond (List []) do + LSP.requestHandler SMethod_TextDocumentDocumentLink \request respond -> handleErrorWithDefault respond (InL []) do let uri_ = request^.params.textDocument.uri path <- case uriToFilePath uri_ of @@ -211,23 +212,23 @@ documentLinkHandler = filePath <- localToPath prefix file let filePath' = basePath filePath -- absolute file path let _range = rangeToJSON range_ - let _target = Just (filePathToUri filePath') + let _target = Just (getUri (filePathToUri filePath')) let _tooltip = Nothing - let _xdata = Nothing + let _data_ = Nothing return [DocumentLink {..}] go (range_, Import (ImportHashed _ (Remote url)) _) = do let _range = rangeToJSON range_ let url' = url { headers = Nothing } - let _target = Just (Uri (pretty url')) + let _target = Just (pretty url') let _tooltip = Nothing - let _xdata = Nothing + let _data_ = Nothing return [DocumentLink {..}] go _ = return [] links <- liftIO $ mapM go imports - respond (Right (List (concat links))) + respond (Right (InL (concat links))) diagnosticsHandler :: Uri -> HandlerM () @@ -259,41 +260,44 @@ diagnosticsHandler _uri = do suggestionToDiagnostic Suggestion { range = range_, .. } = let _range = rangeToJSON range_ - _severity = Just DsHint + _severity = Just DiagnosticSeverity_Hint _source = Just "Dhall.Lint" _code = Nothing + _codeDescription = Nothing _message = suggestion _tags = Nothing _relatedInformation = Nothing + _data_ = Nothing in Diagnostic {..} diagnosisToDiagnostic Diagnosis { range = range_, .. } = let _range = case range_ of Just range' -> rangeToJSON range' Nothing -> LSP.Types.Range (Position 0 0) (Position 0 0) - _severity = Just DsError + _severity = Just DiagnosticSeverity_Error _source = Just doctor _code = Nothing + _codeDescription = Nothing _tags = Nothing _message = diagnosis _relatedInformation = Nothing + _data_ = Nothing in Diagnostic {..} modifying errors (Map.alter (const errs) _uri) -- cache errors let _version = Nothing let _diagnostics = - List ( concatMap (map diagnosisToDiagnostic . diagnose) (maybeToList errs) ++ map suggestionToDiagnostic suggestions ) - liftLSP (LSP.sendNotification STextDocumentPublishDiagnostics PublishDiagnosticsParams{ _uri, _version, _diagnostics }) + liftLSP (LSP.sendNotification SMethod_TextDocumentPublishDiagnostics PublishDiagnosticsParams{ _uri, _version, _diagnostics }) documentFormattingHandler :: Handlers HandlerM documentFormattingHandler = - LSP.requestHandler STextDocumentFormatting \request respond -> handleErrorWithDefault respond (List []) do + LSP.requestHandler SMethod_TextDocumentFormatting \request respond -> handleErrorWithDefault respond (InL []) do let _uri = request^.params.textDocument.uri txt <- readUri _uri @@ -308,12 +312,12 @@ documentFormattingHandler = let _newText= formatExprWithHeader chosenCharacterSet expr header let _range = LSP.Types.Range (Position 0 0) (Position numLines 0) - respond (Right (List [TextEdit{..}])) + respond (Right (InL [TextEdit{..}])) executeCommandHandler :: Handlers HandlerM executeCommandHandler = - LSP.requestHandler SWorkspaceExecuteCommand \request respond -> handleErrorWithDefault respond Aeson.Null do + LSP.requestHandler SMethod_WorkspaceExecuteCommand \request respond -> handleErrorWithDefault respond (InL Aeson.Null) do let command_ = request^.params.command if | command_ == "dhall.server.lint" -> executeLintAndFormat request respond @@ -330,11 +334,11 @@ executeCommandHandler = ) getCommandArguments - :: FromJSON a => RequestMessage 'WorkspaceExecuteCommand -> HandlerM a + :: FromJSON a => TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM a -- (HasParams s a, FromJSON a) => s -> HandlerM a getCommandArguments request = do json <- case request ^. params . arguments of - Just (List (x : _)) -> return x + Just (x : _) -> return x _ -> throwE (Error, "Failed to execute command; arguments missing.") case Aeson.fromJSON json of Aeson.Success args -> @@ -344,8 +348,8 @@ getCommandArguments request = do -- implements dhall.server.lint executeLintAndFormat - :: RequestMessage 'WorkspaceExecuteCommand - -> (Either a Value -> HandlerM b) + :: TRequestMessage 'Method_WorkspaceExecuteCommand + -> (Either a (Value |? Null) -> HandlerM b) -> HandlerM () executeLintAndFormat request respond = do uri_ <- getCommandArguments request @@ -365,21 +369,21 @@ executeLintAndFormat request respond = do let _edit = WorkspaceEdit - { _changes = Just (HashMap.singleton uri_ (List [TextEdit{..}])) + { _changes = Just (Map.singleton uri_ [TextEdit{..}]) , _documentChanges = Nothing , _changeAnnotations = Nothing } let _label = Nothing - _ <- respond (Right Aeson.Null) + _ <- respond (Right (InL Aeson.Null)) - _ <- liftLSP (LSP.sendRequest SWorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler) + _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler) return () executeAnnotateLet - :: RequestMessage 'WorkspaceExecuteCommand + :: TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM () executeAnnotateLet request = do args <- getCommandArguments request :: HandlerM TextDocumentPositionParams @@ -405,19 +409,19 @@ executeAnnotateLet request = do let _newText= formatExpr chosenCharacterSet annotExpr let _edit = WorkspaceEdit - { _changes = Just (HashMap.singleton uri_ (List [TextEdit{..}])) + { _changes = Just (Map.singleton uri_ [TextEdit{..}]) , _documentChanges = Nothing , _changeAnnotations = Nothing } let _label = Nothing - _ <- liftLSP (LSP.sendRequest SWorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler) + _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _label, _edit } nullHandler) return () executeFreezeAllImports - :: RequestMessage 'WorkspaceExecuteCommand + :: TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM () executeFreezeAllImports request = do uri_ <- getCommandArguments request @@ -444,19 +448,19 @@ executeFreezeAllImports request = do return TextEdit{..} let _edit = WorkspaceEdit - { _changes = Just (HashMap.singleton uri_ (List edits_)) + { _changes = Just (Map.singleton uri_ edits_) , _documentChanges = Nothing , _changeAnnotations = Nothing } let _label = Nothing - _ <- liftLSP (LSP.sendRequest SWorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler) + _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler) return () executeFreezeImport - :: RequestMessage 'WorkspaceExecuteCommand + :: TRequestMessage 'Method_WorkspaceExecuteCommand -> HandlerM () executeFreezeImport request = do args <- getCommandArguments request :: HandlerM TextDocumentPositionParams @@ -492,20 +496,20 @@ executeFreezeImport request = do let _newText = " " <> hash let _edit = WorkspaceEdit - { _changes = Just (HashMap.singleton uri_ (List [TextEdit{..}])) + { _changes = Just (Map.singleton uri_ [TextEdit{..}]) , _documentChanges = Nothing , _changeAnnotations = Nothing } let _label = Nothing - _ <- liftLSP (LSP.sendRequest SWorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler) + _ <- liftLSP (LSP.sendRequest SMethod_WorkspaceApplyEdit ApplyWorkspaceEditParams{ _edit, _label } nullHandler) return () completionHandler :: Handlers HandlerM completionHandler = - LSP.requestHandler STextDocumentCompletion \request respond -> handleErrorWithDefault respond (InR (CompletionList False (List []))) do + LSP.requestHandler SMethod_TextDocumentCompletion \request respond -> handleErrorWithDefault respond (InR (InL (CompletionList False Nothing []))) do let uri_ = request ^. params . textDocument . uri line_ = fromIntegral (request ^. params . position . line) col_ = fromIntegral (request ^. params . position . character) @@ -576,6 +580,7 @@ completionHandler = let toCompletionItem (Completion {..}) = CompletionItem {..} where _label = completeText + _labelDetails = Nothing _kind = Nothing _tags = mempty _detail = fmap pretty completeType @@ -588,70 +593,71 @@ completionHandler = _insertTextFormat = Nothing _insertTextMode = Nothing _textEdit = Nothing + _textEditText = Nothing _additionalTextEdits = Nothing _commitCharacters = Nothing _command = Nothing - _xdata = Nothing - - let _items = List (map toCompletionItem completions) + _data_ = Nothing + let _items = (map toCompletionItem completions) + let _itemDefaults = Nothing let _isIncomplete = False - respond (Right (InR CompletionList{..})) + respond (Right (InR (InL CompletionList{..}))) nullHandler :: a -> LspT ServerConfig IO () nullHandler _ = return () didOpenTextDocumentNotificationHandler :: Handlers HandlerM didOpenTextDocumentNotificationHandler = - LSP.notificationHandler STextDocumentDidOpen \notification -> do + LSP.notificationHandler SMethod_TextDocumentDidOpen \notification -> do let _uri = notification^.params.textDocument.uri diagnosticsHandler _uri didSaveTextDocumentNotificationHandler :: Handlers HandlerM didSaveTextDocumentNotificationHandler = - LSP.notificationHandler STextDocumentDidSave \notification -> do + LSP.notificationHandler SMethod_TextDocumentDidSave \notification -> do let _uri = notification^.params.textDocument.uri diagnosticsHandler _uri -- this handler is a stab to prevent `lsp:no handler for:` messages. initializedHandler :: Handlers HandlerM -initializedHandler = - LSP.notificationHandler SInitialized \_ -> return () +initializedHandler = + LSP.notificationHandler SMethod_Initialized \_ -> return () -- this handler is a stab to prevent `lsp:no handler for:` messages. workspaceChangeConfigurationHandler :: Handlers HandlerM -workspaceChangeConfigurationHandler = - LSP.notificationHandler SWorkspaceDidChangeConfiguration \_ -> return () +workspaceChangeConfigurationHandler = + LSP.notificationHandler SMethod_WorkspaceDidChangeConfiguration \_ -> return () -- this handler is a stab to prevent `lsp:no handler for:` messages. textDocumentChangeHandler :: Handlers HandlerM textDocumentChangeHandler = - LSP.notificationHandler STextDocumentDidChange \_ -> return () + LSP.notificationHandler SMethod_TextDocumentDidChange \_ -> return () -- this handler is a stab to prevent `lsp:no handler for:` messages. cancelationHandler :: Handlers HandlerM cancelationHandler = - LSP.notificationHandler SCancelRequest \_ -> return () + LSP.notificationHandler SMethod_CancelRequest \_ -> return () handleErrorWithDefault :: (Either a1 b -> HandlerM a2) -> b -> HandlerM a2 -> HandlerM a2 -handleErrorWithDefault respond _default = flip catchE handler +handleErrorWithDefault respond _default = flip catchE handler where handler (Log, _message) = do - let _xtype = MtLog - liftLSP $ LSP.sendNotification SWindowLogMessage LogMessageParams{..} + let _type_ = MessageType_Log + liftLSP $ LSP.sendNotification SMethod_WindowLogMessage LogMessageParams{..} respond (Right _default) handler (severity_, _message) = do - let _xtype = case severity_ of - Error -> MtError - Warning -> MtWarning - Info -> MtInfo - Log -> MtLog + let _type_ = case severity_ of + Error -> MessageType_Error + Warning -> MessageType_Warning + Info -> MessageType_Info + Log -> MessageType_Log - liftLSP $ LSP.sendNotification SWindowShowMessage ShowMessageParams{..} + liftLSP $ LSP.sendNotification SMethod_WindowShowMessage ShowMessageParams{..} respond (Right _default) diff --git a/dhall-lsp-server/src/Dhall/LSP/Server.hs b/dhall-lsp-server/src/Dhall/LSP/Server.hs index e31933579..8f2103560 100644 --- a/dhall-lsp-server/src/Dhall/LSP/Server.hs +++ b/dhall-lsp-server/src/Dhall/LSP/Server.hs @@ -22,8 +22,9 @@ import Dhall.LSP.Handlers , cancelationHandler ) import Dhall.LSP.State -import Language.LSP.Server (Options(..), ServerDefinition(..), type (<~>)(..)) -import Language.LSP.Types +import Language.LSP.Server (LspServerLog, Options(..), ServerDefinition(..), type (<~>)(..)) +import Language.LSP.Protocol.Types +import Language.LSP.Protocol.Message import System.Exit (ExitCode(..)) import qualified Control.Concurrent.MVar as MVar @@ -53,16 +54,16 @@ run mlog = do return (Right environment) let options = def - { LSP.textDocumentSync = Just syncOptions + { LSP.optTextDocumentSync = Just syncOptions - , completionTriggerCharacters = Just [':', '.', '/'] + , optCompletionTriggerCharacters = Just [':', '.', '/'] -- Note that this registers the dhall.server.lint command -- with VSCode, which means that our plugin can't expose a -- command of the same name. In the case of dhall.lint we -- name the server-side command dhall.server.lint to work -- around this peculiarity. - , executeCommandCommands = + , optExecuteCommandCommands = Just [ "dhall.server.lint", "dhall.server.annotateLet", @@ -71,7 +72,7 @@ run mlog = do ] } - let staticHandlers = + let staticHandlers _clientCapabilities = mconcat [ hoverHandler , didOpenTextDocumentNotificationHandler @@ -95,20 +96,20 @@ run mlog = do (e, newState) <- State.runStateT (Except.runExceptT handler) oldState result <- case e of Left (Log, _message) -> do - let _xtype = MtLog + let _type_ = MessageType_Log - LSP.sendNotification SWindowLogMessage LogMessageParams{..} + LSP.sendNotification SMethod_WindowLogMessage LogMessageParams{..} liftIO (fail (Text.unpack _message)) Left (severity_, _message) -> do - let _xtype = case severity_ of - Error -> MtError - Warning -> MtWarning - Info -> MtInfo - Log -> MtLog + let _type_ = case severity_ of + Error -> MessageType_Error + Warning -> MessageType_Warning + Info -> MessageType_Info + Log -> MessageType_Log - LSP.sendNotification SWindowShowMessage ShowMessageParams{..} + LSP.sendNotification SMethod_WindowShowMessage ShowMessageParams{..} liftIO (fail (Text.unpack _message)) Right a -> do return a @@ -138,7 +139,7 @@ setupLogger file = LSP.setupLogger file [] System.Log.Logger.DEBUG syncOptions :: TextDocumentSyncOptions syncOptions = TextDocumentSyncOptions { _openClose = Just True - , _change = Just TdSyncIncremental + , _change = Just TextDocumentSyncKind_Incremental , _willSave = Just False , _willSaveWaitUntil = Just False , _save = Just (InR (SaveOptions (Just False))) diff --git a/dhall-lsp-server/src/Dhall/LSP/State.hs b/dhall-lsp-server/src/Dhall/LSP/State.hs index 6a453468c..ff02f2772 100644 --- a/dhall-lsp-server/src/Dhall/LSP/State.hs +++ b/dhall-lsp-server/src/Dhall/LSP/State.hs @@ -21,7 +21,7 @@ import Dhall.LSP.Backend.Dhall (Cache, DhallError, emptyCache) import Dhall.Pretty (CharacterSet) import Language.LSP.Server (LspT) -import qualified Language.LSP.Types as J +import qualified Language.LSP.Protocol.Types as J -- Inside a handler we have access to the ServerState. The exception layer -- allows us to fail gracefully, displaying a message to the user via the diff --git a/dhall-lsp-server/tests/Main.hs b/dhall-lsp-server/tests/Main.hs index 6b3f80d75..7edbe6971 100644 --- a/dhall-lsp-server/tests/Main.hs +++ b/dhall-lsp-server/tests/Main.hs @@ -5,15 +5,15 @@ import Control.Monad.IO.Class (liftIO) import Data.Maybe (fromJust) import Language.LSP.Test -import Language.LSP.Types +import Language.LSP.Protocol.Types ( CompletionItem (..) , Diagnostic (..) , DiagnosticSeverity (..) , Hover (..) - , HoverContents (..) , MarkupContent (..) , Position (..) , Range (..) + , toEither ) import Test.Tasty import Test.Tasty.Hspec @@ -37,13 +37,13 @@ hoveringSpec dir = docId <- openDoc "Types.dhall" "dhall" let typePos = Position 0 5 functionPos = Position 2 7 - extractContents = _contents . fromJust + extractContents = toEither . _contents . fromJust getValue = T.unpack . _value typeHover <- getHover docId typePos funcHover <- getHover docId functionPos liftIO $ do case (extractContents typeHover, extractContents funcHover) of - (HoverContents typeContent, HoverContents functionContent) -> do + (Left typeContent, Left functionContent) -> do getValue typeContent `shouldBe` "Type" getValue functionContent `shouldBe` "\8704(_isAdmin : Bool) \8594 { home : Text, name : Text }" _ -> error "test failed" @@ -65,24 +65,28 @@ lintingSpec fixtureDir = {_start = Position { _line = 2, _character = 10 } , _end = Position { _line = 2, _character = 36 } } - , _severity = Just DsHint + , _severity = Just DiagnosticSeverity_Hint , _code = Nothing + , _codeDescription = Nothing , _source = Just "Dhall.Lint" , _message = "Unused let binding 'bob'" , _tags = Nothing , _relatedInformation = Nothing + , _data_ = Nothing } , Diagnostic { _range = Range { _start = Position { _line = 4, _character = 11 } , _end = Position { _line = 4, _character = 38 } } - , _severity = Just DsHint + , _severity = Just DiagnosticSeverity_Hint , _code = Nothing + , _codeDescription = Nothing , _source = Just "Dhall.Lint" , _message = "Unused let binding 'carl'" , _tags = Nothing , _relatedInformation = Nothing + , _data_ = Nothing } ] @@ -96,9 +100,9 @@ lintingSpec fixtureDir = let diag1 = head diags diag2 = diags !! 1 liftIO $ do - _severity diag1 `shouldBe` Just DsHint + _severity diag1 `shouldBe` Just DiagnosticSeverity_Hint T.unpack (_message diag1) `shouldContain` "Superfluous 'in'" - _severity diag2 `shouldBe` Just DsHint + _severity diag2 `shouldBe` Just DiagnosticSeverity_Hint T.unpack (_message diag2) `shouldContain` "Unused let binding" codeCompletionSpec :: FilePath -> Spec @@ -163,7 +167,7 @@ diagnosticsSpec fixtureDir = do _ <- openDoc "UnboundVar.dhall" "dhall" [diag] <- waitForDiagnosticsSource "Dhall.TypeCheck" liftIO $ do - _severity diag `shouldBe` Just DsError + _severity diag `shouldBe` Just DiagnosticSeverity_Error T.unpack (_message diag) `shouldContain` "Unbound variable" it "reports wrong type" $ runSession "dhall-lsp-server" fullCaps fixtureDir @@ -171,7 +175,7 @@ diagnosticsSpec fixtureDir = do _ <- openDoc "WrongType.dhall" "dhall" [diag] <- waitForDiagnosticsSource "Dhall.TypeCheck" liftIO $ do - _severity diag `shouldBe` Just DsError + _severity diag `shouldBe` Just DiagnosticSeverity_Error T.unpack (_message diag) `shouldContain` "Expression doesn't match annotation" describe "Dhall.Import" $ do it "reports invalid imports" @@ -180,7 +184,7 @@ diagnosticsSpec fixtureDir = do _ <- openDoc "InvalidImport.dhall" "dhall" [diag] <- waitForDiagnosticsSource "Dhall.Import" liftIO $ do - _severity diag `shouldBe` Just DsError + _severity diag `shouldBe` Just DiagnosticSeverity_Error T.unpack (_message diag) `shouldContain` "Invalid input" it "reports missing imports" $ runSession "dhall-lsp-server" fullCaps fixtureDir @@ -188,7 +192,7 @@ diagnosticsSpec fixtureDir = do _ <- openDoc "MissingImport.dhall" "dhall" [diag] <- waitForDiagnosticsSource "Dhall.Import" liftIO $ do - _severity diag `shouldBe` Just DsError + _severity diag `shouldBe` Just DiagnosticSeverity_Error T.unpack (_message diag) `shouldContain` "Missing file" describe "Dhall.Parser" $ it "reports invalid syntax" @@ -196,7 +200,7 @@ diagnosticsSpec fixtureDir = do $ do _ <- openDoc "InvalidSyntax.dhall" "dhall" [diag] <- waitForDiagnosticsSource "Dhall.Parser" - liftIO $ _severity diag `shouldBe` Just DsError + liftIO $ _severity diag `shouldBe` Just DiagnosticSeverity_Error main :: IO () main = do