Support haskell-lsp-0.22

diff --git a/ChangeLog.md b/ChangeLog.md
index c83131f1055d8c5b399ad20e19b9618cf2c906a7..ab65edddec8e1f6458d3d6c34844f4dc5b087762 100644 (file)
--- 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 4142b2ba3b81ad4b45fad128f5022beba432ec10..c6d543c9dd39e9ed1689c84e4ce4f2a16bd3721e 100644 (file)
--- 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 b3f535f3ca59f1616cee0bfb1dc1898ff68e1472..36841e8be6173406c4347a434d4bf7560e799c8c 100644 (file)
--- 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 e635267fd7f9bf6200591b4d330ca8e2c3b3df99..8805976c3dedcaef8be8c88fd06c904f1d6b0c36 100644 (file)
--- 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 1c453a6e2632c83d233358cd57de7d730319db98..b56f536a660bb9dd5812b019a381cf6ec5714e3b 100644 (file)
--- 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 ac55e9e749008c575f8a5c50dafbbec70b15040d..861d6f770dc503208bd05cef6fe03a5500cc31dc 100644 (file)
--- 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 ac4c9ff066bd5a3479b4b4181014954acc0acfa5..c33d801efc35c9bb1d5c46c6c3715c5fbf8bbde3 100644 (file)
--- 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 eb0eef0f269493d3fe3e1b95d0fc4d1210f9fffd..e38af42cf1b8de77c3ae025100d8cb32d9fb25f5 100644 (file)
--- 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 ()