From ddf9bc17ce8a548a927c201c6b0edb8cf1c9fcad Mon Sep 17 00:00:00 2001 From: Luke Lau Date: Mon, 4 May 2020 19:16:24 +0100 Subject: [PATCH] Support haskell-lsp-0.22 --- ChangeLog.md | 6 +++- lsp-test.cabal | 8 ++--- src/Language/Haskell/LSP/Test.hs | 36 +++++++++++------------ src/Language/Haskell/LSP/Test/Decoding.hs | 1 - src/Language/Haskell/LSP/Test/Files.hs | 16 ++++------ src/Language/Haskell/LSP/Test/Replay.hs | 8 ++--- src/Language/Haskell/LSP/Test/Session.hs | 2 +- test/Test.hs | 3 +- 8 files changed, 40 insertions(+), 40 deletions(-) diff --git a/ChangeLog.md b/ChangeLog.md index c83131f..ab65edd 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,6 +1,10 @@ # Revision history for lsp-test -## 0.10.1.0 -- 2020-03-21 +## 0.10.3.0 -- 2020-05-04 + +* Build with new haskell-lsp-0.22 + +## 0.10.2.0 -- 2020-03-21 * Bump constraints for new haskell-lsp diff --git a/lsp-test.cabal b/lsp-test.cabal index 4142b2b..c6d543c 100644 --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -1,5 +1,5 @@ name: lsp-test -version: 0.10.2.0 +version: 0.10.3.0 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against @@ -20,7 +20,7 @@ build-type: Simple cabal-version: 2.0 extra-source-files: README.md , ChangeLog.md -tested-with: GHC == 8.2.2 , GHC == 8.4.2 , GHC == 8.4.3, GHC == 8.6.4, GHC == 8.6.5, GHC == 8.8.1 +tested-with: GHC == 8.2.2 , GHC == 8.4.2 , GHC == 8.4.3, GHC == 8.6.4, GHC == 8.6.5, GHC == 8.8.1, GHC == 8.10.1 source-repository head type: git @@ -35,7 +35,7 @@ library , parser-combinators:Control.Applicative.Combinators default-language: Haskell2010 build-depends: base >= 4.10 && < 5 - , haskell-lsp >= 0.19 && < 0.22 + , haskell-lsp >= 0.22 && < 0.23 , aeson , aeson-pretty , ansi-terminal @@ -77,7 +77,7 @@ test-suite tests build-depends: base >= 4.10 && < 5 , hspec , lens - , haskell-lsp >= 0.19 && < 0.22 + , haskell-lsp >= 0.22 && < 0.23 , lsp-test , data-default , aeson diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index b3f535f..36841e8 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -160,7 +160,9 @@ runSessionWithConfig config' serverExe caps rootDir session = do -- collect them and then... (inBetween, initRspMsg) <- manyTill_ anyMessage (responseForId initReqId) - liftIO $ maybe (return ()) (putStrLn . ("Error while initializing: " ++) . show ) (initRspMsg ^. LSP.error) + case initRspMsg ^. LSP.result of + Left error -> liftIO $ putStrLn ("Error while initializing: " ++ show error) + Right _ -> pure () initRspVar <- initRsp <$> ask liftIO $ putMVar initRspVar initRspMsg @@ -412,12 +414,11 @@ noDiagnostics = do -- | Returns the symbols in a document. getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation]) getDocumentSymbols doc = do - ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse - maybe (return ()) (throw . UnexpectedResponseError rspLid) mErr - case mRes of - Just (DSDocumentSymbols (List xs)) -> return (Left xs) - Just (DSSymbolInformation (List xs)) -> return (Right xs) - Nothing -> Prelude.error "No result and no error in DocumentSymbolsResponse" + ResponseMessage _ rspLid res <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) :: Session DocumentSymbolsResponse + case res of + Right (DSDocumentSymbols (List xs)) -> return (Left xs) + Right (DSSymbolInformation (List xs)) -> return (Right xs) + Left err -> throw (UnexpectedResponseError rspLid err) -- | Returns the code actions in the specified range. getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult] @@ -426,8 +427,8 @@ getCodeActions doc range = do rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing) case rsp ^. result of - Just (List xs) -> return xs - _ -> throw (UnexpectedResponseError (rsp ^. LSP.id) (fromJust $ rsp ^. LSP.error)) + Right (List xs) -> return xs + Left error -> throw (UnexpectedResponseError (rsp ^. LSP.id) error) -- | Returns all the code actions in a document by -- querying the code actions at each of the current @@ -441,13 +442,11 @@ getAllCodeActions doc = do where go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult] go ctx acc diag = do - ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing) + ResponseMessage _ rspLid res <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing) - case mErr of - Just e -> throw (UnexpectedResponseError rspLid e) - Nothing -> - let Just (List cmdOrCAs) = mRes - in return (acc ++ cmdOrCAs) + case res of + Left e -> throw (UnexpectedResponseError rspLid e) + Right (List cmdOrCAs) -> pure (acc ++ cmdOrCAs) getCodeActionContext :: TextDocumentIdentifier -> Session CodeActionContext getCodeActionContext doc = do @@ -581,9 +580,10 @@ getHighlights doc pos = -- | Checks the response for errors and throws an exception if needed. -- Returns the result if successful. getResponseResult :: ResponseMessage a -> a -getResponseResult rsp = fromMaybe exc (rsp ^. result) - where exc = throw $ UnexpectedResponseError (rsp ^. LSP.id) - (fromJust $ rsp ^. LSP.error) +getResponseResult rsp = + case rsp ^. result of + Right x -> x + Left err -> throw $ UnexpectedResponseError (rsp ^. LSP.id) err -- | Applies formatting to the specified document. formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () diff --git a/src/Language/Haskell/LSP/Test/Decoding.hs b/src/Language/Haskell/LSP/Test/Decoding.hs index e635267..8805976 100644 --- a/src/Language/Haskell/LSP/Test/Decoding.hs +++ b/src/Language/Haskell/LSP/Test/Decoding.hs @@ -12,7 +12,6 @@ import System.IO import System.IO.Error import Language.Haskell.LSP.Types import Language.Haskell.LSP.Types.Lens - hiding ( error ) import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Test.Exceptions import qualified Data.HashMap.Strict as HM diff --git a/src/Language/Haskell/LSP/Test/Files.hs b/src/Language/Haskell/LSP/Test/Files.hs index 1c453a6..b56f536 100644 --- a/src/Language/Haskell/LSP/Test/Files.hs +++ b/src/Language/Haskell/LSP/Test/Files.hs @@ -9,7 +9,7 @@ where import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Types -import Language.Haskell.LSP.Types.Lens hiding (error) +import Language.Haskell.LSP.Types.Lens import Language.Haskell.LSP.Messages import Control.Lens import qualified Data.HashMap.Strict as HM @@ -63,15 +63,11 @@ mapUris f event = fromServerMsg (NotPublishDiagnostics n) = NotPublishDiagnostics $ swapUri params n fromServerMsg (RspDocumentSymbols r) = - let newSymbols = case r ^. result of - Just (DSSymbolInformation si) -> Just (DSSymbolInformation (fmap (swapUri location) si)) - x -> x - in RspDocumentSymbols $ result .~ newSymbols $ r - - fromServerMsg (RspRename r) = - let oldResult = r ^. result :: Maybe WorkspaceEdit - newResult = fmap swapWorkspaceEdit oldResult - in RspRename $ result .~ newResult $ r + let swapUri' (DSSymbolInformation si) = DSSymbolInformation (swapUri location <$> si) + swapUri' (DSDocumentSymbols dss) = DSDocumentSymbols dss -- no file locations here + in RspDocumentSymbols $ r & result %~ (fmap swapUri') + + fromServerMsg (RspRename r) = RspRename $ r & result %~ (fmap swapWorkspaceEdit) fromServerMsg x = x diff --git a/src/Language/Haskell/LSP/Test/Replay.hs b/src/Language/Haskell/LSP/Test/Replay.hs index ac55e9e..861d6f7 100644 --- a/src/Language/Haskell/LSP/Test/Replay.hs +++ b/src/Language/Haskell/LSP/Test/Replay.hs @@ -13,7 +13,7 @@ import qualified Data.Text as T import Language.Haskell.LSP.Capture import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Types -import Language.Haskell.LSP.Types.Lens as LSP hiding (error) +import Language.Haskell.LSP.Types.Lens as LSP import Data.Aeson import Data.Default import Data.List @@ -108,7 +108,7 @@ sendMessages (nextMsg:remainingMsgs) reqSema rspSema = sendMessages remainingMsgs reqSema rspSema - response msg@(ResponseMessage _ id _ _) = do + response msg@(ResponseMessage _ id _) = do liftIO $ putStrLn $ "Waiting for request id " ++ show id ++ " from the server" reqId <- liftIO $ takeMVar reqSema if responseId reqId /= id @@ -220,9 +220,9 @@ swapCommands pid (FromClient t (ReqExecuteCommand req):xs) = FromClient t (ReqE swapCommands pid (FromServer t (RspInitialize rsp):xs) = FromServer t (RspInitialize swapped):swapCommands pid xs where swapped = case newCommands of - Just cmds -> result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp + Just cmds -> result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands .~ cmds $ rsp Nothing -> rsp - oldCommands = rsp ^? result . _Just . LSP.capabilities . executeCommandProvider . _Just . commands + oldCommands = rsp ^? result . _Right . LSP.capabilities . executeCommandProvider . _Just . commands newCommands = fmap (fmap (swapPid pid)) oldCommands swapCommands pid (x:xs) = x:swapCommands pid xs diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index ac4c9ff..c33d801 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -60,7 +60,7 @@ import Data.Function import Language.Haskell.LSP.Messages import Language.Haskell.LSP.Types.Capabilities import Language.Haskell.LSP.Types -import Language.Haskell.LSP.Types.Lens hiding (error) +import Language.Haskell.LSP.Types.Lens import Language.Haskell.LSP.VFS import Language.Haskell.LSP.Test.Compat import Language.Haskell.LSP.Test.Decoding diff --git a/test/Test.hs b/test/Test.hs index eb0eef0..e38af42 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -7,6 +7,7 @@ import Test.Hspec import Data.Aeson import Data.Default import qualified Data.HashMap.Strict as HM +import Data.Either import Data.Maybe import qualified Data.Text as T import Control.Applicative.Combinators @@ -37,7 +38,7 @@ main = hspec $ do in session `shouldThrow` anySessionException it "initializeResponse" $ runSession "hie" fullCaps "test/data/renamePass" $ do rsp <- initializeResponse - liftIO $ rsp ^. result `shouldNotBe` Nothing + liftIO $ rsp ^. result `shouldSatisfy` isLeft it "runSessionWithConfig" $ runSession "hie" didChangeCaps "test/data/renamePass" $ return () -- 2.30.2