lsp-test 0.7.0.0 → 0.8.0.0
raw patch · 8 files changed
+61/−44 lines, 8 filesdep ~haskell-lspPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: haskell-lsp
API changes (from Hackage documentation)
- Language.Haskell.LSP.Test: type Session = ParserStateReader FromServerMessage SessionState SessionContext IO
+ Language.Haskell.LSP.Test: data Session a
Files
- ChangeLog.md +5/−0
- lsp-test.cabal +3/−3
- src/Language/Haskell/LSP/Test.hs +16/−17
- src/Language/Haskell/LSP/Test/Decoding.hs +4/−3
- src/Language/Haskell/LSP/Test/Messages.hs +5/−4
- src/Language/Haskell/LSP/Test/Parsing.hs +6/−2
- src/Language/Haskell/LSP/Test/Session.hs +19/−12
- test/Test.hs +3/−3
ChangeLog.md view
@@ -1,5 +1,10 @@ # Revision history for lsp-test +## 0.8.0.0 -- 2019-10-18++* Make `Session` a newtype+* Update for haskell-lsp-0.17.0.0 (@cocreature)+ ## 0.7.0.0 -- 2019-09-08 * Update for haskell-lsp-0.16.0.0
lsp-test.cabal view
@@ -1,5 +1,5 @@ name: lsp-test-version: 0.7.0.0+version: 0.8.0.0 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against@@ -36,7 +36,7 @@ , parser-combinators:Control.Applicative.Combinators default-language: Haskell2010 build-depends: base >= 4.10 && < 5- , haskell-lsp == 0.16.*+ , haskell-lsp == 0.17.* , aeson , aeson-pretty , ansi-terminal@@ -79,7 +79,7 @@ build-depends: base >= 4.10 && < 5 , hspec , lens- , haskell-lsp == 0.16.*+ , haskell-lsp == 0.17.* , lsp-test , data-default , aeson
src/Language/Haskell/LSP/Test.hs view
@@ -8,7 +8,7 @@ Description : A functional testing framework for LSP servers. Maintainer : luke_lau@icloud.com Stability : experimental-Portability : POSIX+Portability : non-portable Provides the framework to start functionally testing <https://github.com/Microsoft/language-server-protocol Language Server Protocol servers>.@@ -163,8 +163,7 @@ Nothing -> return () -- Run the actual test- result <- session- return result+ session where -- | Asks the server to shutdown and exit politely exitServer :: Session ()@@ -378,7 +377,7 @@ -- | Returns the symbols in a document. getDocumentSymbols :: TextDocumentIdentifier -> Session (Either [DocumentSymbol] [SymbolInformation]) getDocumentSymbols doc = do- ResponseMessage _ rspLid mRes mErr <- request TextDocumentDocumentSymbol (DocumentSymbolParams doc) :: Session DocumentSymbolsResponse+ 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)@@ -389,7 +388,7 @@ getCodeActions :: TextDocumentIdentifier -> Range -> Session [CAResult] getCodeActions doc range = do ctx <- getCodeActionContext doc- rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx)+ rsp <- request TextDocumentCodeAction (CodeActionParams doc range ctx Nothing) case rsp ^. result of Just (List xs) -> return xs@@ -407,7 +406,7 @@ where go :: CodeActionContext -> [CAResult] -> Diagnostic -> Session [CAResult] go ctx acc diag = do- ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx)+ ResponseMessage _ rspLid mRes mErr <- request TextDocumentCodeAction (CodeActionParams doc (diag ^. range) ctx Nothing) case mErr of Just e -> throw (UnexpectedResponseError rspLid e)@@ -429,7 +428,7 @@ executeCommand :: Command -> Session () executeCommand cmd = do let args = decode $ encode $ fromJust $ cmd ^. arguments- execParams = ExecuteCommandParams (cmd ^. command) args+ execParams = ExecuteCommandParams (cmd ^. command) args Nothing request_ WorkspaceExecuteCommand execParams -- | Executes a code action.@@ -488,7 +487,7 @@ -- | Returns the completions for the position in the document. getCompletions :: TextDocumentIdentifier -> Position -> Session [CompletionItem] getCompletions doc pos = do- rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos)+ rsp <- request TextDocumentCompletion (TextDocumentPositionParams doc pos Nothing) case getResponseResult rsp of Completions (List items) -> return items@@ -501,7 +500,7 @@ -> Session [Location] -- ^ The locations of the references. getReferences doc pos inclDecl = let ctx = ReferenceContext inclDecl- params = ReferenceParams doc pos ctx+ params = ReferenceParams doc pos ctx Nothing in getResponseResult <$> request TextDocumentReferences params -- | Returns the definition(s) for the term at the specified position.@@ -509,7 +508,7 @@ -> Position -- ^ The position the term is at. -> Session [Location] -- ^ The location(s) of the definitions getDefinitions doc pos = do- let params = TextDocumentPositionParams doc pos+ let params = TextDocumentPositionParams doc pos Nothing rsp <- request TextDocumentDefinition params :: Session DefinitionResponse case getResponseResult rsp of SingleLoc loc -> pure [loc]@@ -520,13 +519,13 @@ -> Position -- ^ The position the term is at. -> Session [Location] -- ^ The location(s) of the definitions getTypeDefinitions doc pos =- let params = TextDocumentPositionParams doc pos+ let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentTypeDefinition params -- | Renames the term at the specified position. rename :: TextDocumentIdentifier -> Position -> String -> Session () rename doc pos newName = do- let params = RenameParams doc pos (T.pack newName)+ let params = RenameParams doc pos (T.pack newName) Nothing rsp <- request TextDocumentRename params :: Session RenameResponse let wEdit = getResponseResult rsp req = RequestMessage "" (IdInt 0) WorkspaceApplyEdit (ApplyWorkspaceEditParams wEdit)@@ -535,13 +534,13 @@ -- | Returns the hover information at the specified position. getHover :: TextDocumentIdentifier -> Position -> Session (Maybe Hover) getHover doc pos =- let params = TextDocumentPositionParams doc pos+ let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentHover params -- | Returns the highlighted occurences of the term at the specified position getHighlights :: TextDocumentIdentifier -> Position -> Session [DocumentHighlight] getHighlights doc pos =- let params = TextDocumentPositionParams doc pos+ let params = TextDocumentPositionParams doc pos Nothing in getResponseResult <$> request TextDocumentDocumentHighlight params -- | Checks the response for errors and throws an exception if needed.@@ -554,14 +553,14 @@ -- | Applies formatting to the specified document. formatDoc :: TextDocumentIdentifier -> FormattingOptions -> Session () formatDoc doc opts = do- let params = DocumentFormattingParams doc opts+ let params = DocumentFormattingParams doc opts Nothing edits <- getResponseResult <$> request TextDocumentFormatting params applyTextEdits doc edits -- | Applies formatting to the specified range in a document. formatRange :: TextDocumentIdentifier -> FormattingOptions -> Range -> Session () formatRange doc opts range = do- let params = DocumentRangeFormattingParams doc range opts+ let params = DocumentRangeFormattingParams doc range opts Nothing edits <- getResponseResult <$> request TextDocumentRangeFormatting params applyTextEdits doc edits @@ -574,6 +573,6 @@ -- | Returns the code lenses for the specified document. getCodeLenses :: TextDocumentIdentifier -> Session [CodeLens] getCodeLenses tId = do- rsp <- request TextDocumentCodeLens (CodeLensParams tId) :: Session CodeLensResponse+ rsp <- request TextDocumentCodeLens (CodeLensParams tId Nothing) :: Session CodeLensResponse case getResponseResult rsp of List res -> pure res
src/Language/Haskell/LSP/Test/Decoding.hs view
@@ -3,6 +3,7 @@ import Prelude hiding ( id ) import Data.Aeson+import Data.Foldable import Control.Exception import Control.Lens import qualified Data.ByteString.Lazy.Char8 as B@@ -131,9 +132,9 @@ WindowShowMessage -> NotShowMessage $ fromJust $ decode bytes WindowLogMessage -> NotLogMessage $ fromJust $ decode bytes CancelRequestServer -> NotCancelRequestFromServer $ fromJust $ decode bytes- WindowProgressStart -> NotProgressStart $ fromJust $ decode bytes- WindowProgressReport -> NotProgressReport $ fromJust $ decode bytes- WindowProgressDone -> NotProgressDone $ fromJust $ decode bytes+ Progress ->+ fromJust $ asum [NotWorkDoneProgressBegin <$> decode bytes, NotWorkDoneProgressReport <$> decode bytes, NotWorkDoneProgressEnd <$> decode bytes]+ WindowWorkDoneProgressCreate -> ReqWorkDoneProgressCreate $ fromJust $ decode bytes TelemetryEvent -> NotTelemetry $ fromJust $ decode bytes WindowShowMessageRequest -> ReqShowMessage $ fromJust $ decode bytes ClientRegisterCapability -> ReqRegisterCapability $ fromJust $ decode bytes
src/Language/Haskell/LSP/Test/Messages.hs view
@@ -60,6 +60,7 @@ (ReqShowMessage m) -> request m (ReqUnregisterCapability m) -> request m (ReqCustomServer m) -> request m+ (ReqWorkDoneProgressCreate m) -> request m (RspInitialize m) -> response m (RspShutdown m) -> response m (RspHover m) -> response m@@ -92,9 +93,9 @@ (NotPublishDiagnostics m) -> notification m (NotLogMessage m) -> notification m (NotShowMessage m) -> notification m- (NotProgressStart m) -> notification m- (NotProgressReport m) -> notification m- (NotProgressDone m) -> notification m+ (NotWorkDoneProgressBegin m) -> notification m+ (NotWorkDoneProgressReport m) -> notification m+ (NotWorkDoneProgressEnd m) -> notification m (NotTelemetry m) -> notification m (NotCancelRequestFromServer m) -> notification m (NotCustomServer m) -> notification m@@ -148,6 +149,6 @@ (NotDidSaveTextDocument m) -> notification m (NotDidChangeWatchedFiles m) -> notification m (NotDidChangeWorkspaceFolders m) -> notification m- (NotProgressCancel m) -> notification m+ (NotWorkDoneProgressCancel m) -> notification m (ReqCustomClient m) -> request m (NotCustomClient m) -> notification m
src/Language/Haskell/LSP/Test/Parsing.hs view
@@ -23,7 +23,8 @@ import Control.Monad import Data.Aeson import qualified Data.ByteString.Lazy.Char8 as B-import Data.Conduit.Parser+import Data.Conduit.Parser hiding (named)+import qualified Data.Conduit.Parser (named) import qualified Data.Text as T import Data.Typeable import Language.Haskell.LSP.Messages@@ -81,7 +82,7 @@ threadDelay (timeout * 1000000) writeChan chan (TimeoutMessage timeoutId) - x <- await+ x <- Session await unless skipTimeout $ modify $ \s -> s { curTimeoutId = timeoutId + 1 }@@ -93,6 +94,9 @@ logMsg LogServer x return a Nothing -> empty++named :: T.Text -> Session a -> Session a+named s (Session x) = Session (Data.Conduit.Parser.named s x) -- | Matches a message of type @a@. message :: forall a. (Typeable a, FromJSON a) => Session a
src/Language/Haskell/LSP/Test/Session.hs view
@@ -1,12 +1,13 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE RankNTypes #-} module Language.Haskell.LSP.Test.Session- ( Session+ ( Session(..) , SessionConfig(..) , defaultConfig , SessionMessage(..)@@ -28,6 +29,7 @@ where +import Control.Applicative import Control.Concurrent hiding (yield) import Control.Exception import Control.Lens hiding (List)@@ -40,7 +42,7 @@ import Control.Monad.Trans.Reader (ReaderT, runReaderT) import qualified Control.Monad.Trans.Reader as Reader (ask) import Control.Monad.Trans.State (StateT, runStateT)-import qualified Control.Monad.Trans.State as State (get, put)+import qualified Control.Monad.Trans.State as State import qualified Data.ByteString.Lazy.Char8 as B import Data.Aeson import Data.Aeson.Encode.Pretty@@ -76,7 +78,8 @@ -- 'Language.Haskell.LSP.Test.sendRequest' and -- 'Language.Haskell.LSP.Test.sendNotification'. -type Session = ParserStateReader FromServerMessage SessionState SessionContext IO+newtype Session a = Session (ConduitParser FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) a)+ deriving (Functor, Applicative, Monad, MonadIO, Alternative) #if __GLASGOW_HASKELL__ >= 806 instance MonadFail Session where@@ -121,10 +124,10 @@ asks :: (r -> b) -> m b asks f = f <$> ask -instance Monad m => HasReader r (ParserStateReader a s r m) where- ask = lift $ lift Reader.ask+instance HasReader SessionContext Session where+ ask = Session (lift $ lift Reader.ask) -instance Monad m => HasReader SessionContext (ConduitM a b (StateT s (ReaderT SessionContext m))) where+instance Monad m => HasReader r (ConduitM a b (StateT s (ReaderT r m))) where ask = lift $ lift Reader.ask data SessionState = SessionState@@ -150,19 +153,22 @@ modifyM :: (HasState s m, Monad m) => (s -> m s) -> m () modifyM f = get >>= f >>= put -instance Monad m => HasState s (ParserStateReader a s r m) where+instance HasState SessionState Session where+ get = Session (lift State.get)+ put = Session . lift . State.put++instance Monad m => HasState s (ConduitM a b (StateT s m))+ where get = lift State.get put = lift . State.put -instance Monad m => HasState SessionState (ConduitM a b (StateT SessionState m))+instance Monad m => HasState s (ConduitParser a (StateT s m)) where get = lift State.get put = lift . State.put -type ParserStateReader a s r m = ConduitParser a (StateT s (ReaderT r m))- runSession :: SessionContext -> SessionState -> Session a -> IO (a, SessionState)-runSession context state session = runReaderT (runStateT conduit state) context+runSession context state (Session session) = runReaderT (runStateT conduit state) context where conduit = runConduit $ chanSource .| watchdog .| updateStateC .| runConduitParser (catchError session handler) @@ -235,7 +241,8 @@ updateState msg yield msg -updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m) => FromServerMessage -> m ()+updateState :: (MonadIO m, HasReader SessionContext m, HasState SessionState m)+ => FromServerMessage -> m () updateState (NotPublishDiagnostics n) = do let List diags = n ^. params . diagnostics doc = n ^. params . uri
test/Test.hs view
@@ -118,7 +118,7 @@ selector _ = False sesh = do doc <- openDoc "Desktop/simple.hs" "haskell"- sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc)+ sendRequest TextDocumentDocumentSymbol (DocumentSymbolParams doc Nothing) skipMany anyNotification message :: Session RenameResponse -- the wrong type in runSession "hie" fullCaps "test/data/renamePass" sesh@@ -154,7 +154,7 @@ let args = toJSON $ AOP (doc ^. uri) (Position 1 14) "Redundant bracket"- reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))+ reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) Nothing request_ WorkspaceExecuteCommand reqParams editReq <- message :: Session ApplyWorkspaceEditRequest@@ -177,7 +177,7 @@ let args = toJSON $ AOP (doc ^. uri) (Position 1 14) "Redundant bracket"- reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args]))+ reqParams = ExecuteCommandParams "applyrefact:applyOne" (Just (List [args])) Nothing request_ WorkspaceExecuteCommand reqParams contents <- getDocumentEdit doc liftIO $ contents `shouldBe` "main :: IO Int\nmain = return 42\n"