# 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
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
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
, 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
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
-- 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
-- | 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]
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
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
-- | 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 ()
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
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
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
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
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
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
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
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
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 ()