lsp-test 0.14.0.2 → 0.14.0.3
raw patch · 9 files changed
+53/−46 lines, 9 filesdep +co-log-coredep ~Diffdep ~asyncdep ~lspPVP ok
version bump matches the API change (PVP)
Dependencies added: co-log-core
Dependency ranges changed: Diff, async, lsp, lsp-types, mtl
API changes (from Hackage documentation)
Files
- ChangeLog.md +5/−1
- bench/SimpleBench.hs +1/−1
- func-test/FuncTest.hs +4/−3
- lsp-test.cabal +10/−7
- src/Language/LSP/Test.hs +16/−19
- src/Language/LSP/Test/Exceptions.hs +1/−1
- src/Language/LSP/Test/Session.hs +14/−12
- test/DummyServer.hs +1/−1
- test/Test.hs +1/−1
ChangeLog.md view
@@ -1,8 +1,12 @@ # Revision history for lsp-test +## 0.14.0.3++* Compatibility with new `lsp-types` major version.+ ## 0.14.0.2 -* Compatibility with new lsp-types major version.+* Compatibility with new `lsp-types` major version. ## 0.14.0.1 -- 2021-07-30
bench/SimpleBench.hs view
@@ -44,7 +44,7 @@ n <- read . head <$> getArgs - forkIO $ void $ runServerWithHandles hinRead houtWrite server+ forkIO $ void $ runServerWithHandles mempty mempty hinRead houtWrite server liftIO $ putStrLn $ "Starting " <> show n <> " rounds" i <- newIORef 0
func-test/FuncTest.hs view
@@ -18,9 +18,11 @@ import UnliftIO.Concurrent import Control.Exception import System.Exit+import qualified Colog.Core as L main :: IO () main = hspec $ do+ let logger = L.cmap show L.logStringStderr describe "progress reporting" $ it "sends end notification if thread is killed" $ do (hinRead, hinWrite) <- createPipe@@ -48,7 +50,7 @@ takeMVar killVar killThread tid - forkIO $ void $ runServerWithHandles hinRead houtWrite definition+ forkIO $ void $ runServerWithHandles logger (L.hoistLogAction liftIO logger) hinRead houtWrite definition Test.runSessionWithHandles hinWrite houtRead Test.defaultConfig Test.fullCaps "." $ do -- First make sure that we get a $/progress begin notification@@ -107,8 +109,7 @@ _ -> error "Shouldn't be here" ] - - server <- async $ void $ runServerWithHandles hinRead houtWrite definition+ server <- async $ void $ runServerWithHandles logger (L.hoistLogAction liftIO logger) hinRead houtWrite definition let config = Test.defaultConfig { Test.initialWorkspaceFolders = Just [wf0]
lsp-test.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: lsp-test-version: 0.14.0.2+version: 0.14.0.3 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against@@ -36,23 +36,25 @@ , parser-combinators:Control.Applicative.Combinators default-language: Haskell2010 build-depends: base >= 4.10 && < 5- , lsp-types == 1.4.*+ , lsp-types == 1.5.*+ , lsp == 1.5.* , aeson , time , aeson-pretty , ansi-terminal- , async+ , async >= 2.0 , bytestring+ , co-log-core , conduit , conduit-parse == 0.2.* , containers >= 0.5.9 , data-default- , Diff+ , Diff >= 0.3 , directory , filepath , Glob >= 0.9 && < 0.11 , lens- , mtl+ , mtl < 2.4 , parser-combinators >= 1.2 , process >= 1.6 , text@@ -81,7 +83,7 @@ build-depends: base >= 4.10 && < 5 , hspec , lens- , lsp == 1.4.*+ , lsp == 1.5.* , lsp-test , data-default , aeson@@ -91,7 +93,7 @@ , filepath , unliftio , process- , mtl+ , mtl < 2.4 , aeson default-language: Haskell2010 @@ -103,6 +105,7 @@ , lsp-test , lsp , process+ , co-log-core , lens , unliftio , hspec
src/Language/LSP/Test.hs view
@@ -1,7 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE KindSignatures #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeInType #-}@@ -119,7 +118,7 @@ import Data.Maybe import Language.LSP.Types import Language.LSP.Types.Lens hiding- (id, capabilities, message, executeCommand, applyEdit, rename)+ (id, capabilities, message, executeCommand, applyEdit, rename, to) import qualified Language.LSP.Types.Lens as LSP import qualified Language.LSP.Types.Capabilities as C import Language.LSP.VFS@@ -135,6 +134,7 @@ import System.FilePath import System.Process (ProcessHandle) import qualified System.FilePath.Glob as Glob+import Control.Monad.State (execState) -- | Starts a new session. --@@ -151,7 +151,7 @@ -> IO a runSession = runSessionWithConfig def --- | Starts a new sesion with a custom configuration.+-- | Starts a new session with a custom configuration. runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session. -> String -- ^ The command to run the server. -> C.ClientCapabilities -- ^ The capabilities that the client should declare.@@ -198,7 +198,7 @@ config <- envOverrideConfig config' let initializeParams = InitializeParams Nothing- -- Narowing to Int32 here, but it's unlikely that a pid will+ -- Narrowing to Int32 here, but it's unlikely that a PID will -- be outside the range (Just $ fromIntegral pid) (Just lspTestClientInfo)@@ -241,7 +241,7 @@ exitServer :: Session () exitServer = request_ SShutdown Empty >> sendNotification SExit Empty - -- | Listens to the server output until the shutdown ack,+ -- | Listens to the server output until the shutdown ACK, -- makes sure it matches the record and signals any semaphores listenServer :: Handle -> SessionContext -> IO () listenServer serverOut context = do@@ -280,7 +280,7 @@ documentContents :: TextDocumentIdentifier -> Session T.Text documentContents doc = do vfs <- vfs <$> get- let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri)+ let Just file = vfs ^. vfsMap . at (toNormalizedUri (doc ^. uri)) return (virtualFileText file) -- | Parses an ApplyEditRequest, checks that it is for the passed document@@ -348,7 +348,7 @@ sendNotification STextDocumentDidOpen params = do let n = NotificationMessage "2.0" STextDocumentDidOpen params oldVFS <- vfs <$> get- let (newVFS,_) = openVFS oldVFS n+ let newVFS = flip execState oldVFS $ openVFS mempty n modify (\s -> s { vfs = newVFS }) sendMessage n @@ -356,16 +356,16 @@ sendNotification STextDocumentDidClose params = do let n = NotificationMessage "2.0" STextDocumentDidClose params oldVFS <- vfs <$> get- let (newVFS,_) = closeVFS oldVFS n+ let newVFS = flip execState oldVFS $ closeVFS mempty n modify (\s -> s { vfs = newVFS }) sendMessage n sendNotification STextDocumentDidChange params = do- let n = NotificationMessage "2.0" STextDocumentDidChange params- oldVFS <- vfs <$> get- let (newVFS,_) = changeFromClientVFS oldVFS n- modify (\s -> s { vfs = newVFS })- sendMessage n+ let n = NotificationMessage "2.0" STextDocumentDidChange params+ oldVFS <- vfs <$> get+ let newVFS = flip execState oldVFS $ changeFromClientVFS mempty n+ modify (\s -> s { vfs = newVFS })+ sendMessage n sendNotification method params = case splitClientMethod method of@@ -594,11 +594,8 @@ -- | Adds the current version to the document, as tracked by the session. getVersionedDoc :: TextDocumentIdentifier -> Session VersionedTextDocumentIdentifier getVersionedDoc (TextDocumentIdentifier uri) = do- fs <- vfsMap . vfs <$> get- let ver =- case fs Map.!? toNormalizedUri uri of- Just vf -> Just (virtualFileVersion vf)- _ -> Nothing+ vfs <- vfs <$> get+ let ver = vfs ^? vfsMap . ix (toNormalizedUri uri) . to virtualFileVersion return (VersionedTextDocumentIdentifier uri ver) -- | Applys an edit to the document and returns the updated document version.@@ -706,7 +703,7 @@ let params = HoverParams doc pos Nothing in getResponseResult <$> request STextDocumentHover params --- | Returns the highlighted occurences of the term at the specified position+-- | Returns the highlighted occurrences of the term at the specified position getHighlights :: TextDocumentIdentifier -> Position -> Session (List DocumentHighlight) getHighlights doc pos = let params = DocumentHighlightParams doc pos Nothing Nothing
src/Language/LSP/Test/Exceptions.hs view
@@ -48,7 +48,7 @@ show UnexpectedDiagnostics = "Unexpectedly received diagnostics from the server." show (IncorrectApplyEditRequest msgStr) = "ApplyEditRequest didn't contain document, instead received:\n" ++ msgStr- show (UnexpectedResponseError lid e) = "Received an exepected error in a response for id " ++ show lid ++ ":\n"+ show (UnexpectedResponseError lid e) = "Received an expected error in a response for id " ++ show lid ++ ":\n" ++ show e show UnexpectedServerTermination = "Language server unexpectedly terminated" show (IllegalInitSequenceMessage msg) =
src/Language/LSP/Test/Session.hs view
@@ -1,5 +1,4 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -46,12 +45,13 @@ #if __GLASGOW_HASKELL__ == 806 import Control.Monad.Fail #endif+import Control.Monad.Trans.Class import Control.Monad.Trans.Reader (ReaderT, runReaderT) import qualified Control.Monad.Trans.Reader as Reader (ask)-import Control.Monad.Trans.State (StateT, runStateT)+import Control.Monad.Trans.State (StateT, runStateT, execState) import qualified Control.Monad.Trans.State as State import qualified Data.ByteString.Lazy.Char8 as B-import Data.Aeson+import Data.Aeson hiding (Error) import Data.Aeson.Encode.Pretty import Data.Conduit as Conduit import Data.Conduit.Parser as Parser@@ -80,8 +80,9 @@ #ifndef mingw32_HOST_OS import System.Process (waitForProcess) #endif-import System.Timeout+import System.Timeout ( timeout ) import Data.IORef+import Colog.Core (LogAction (..), WithSeverity (..), Severity (..)) -- | A session representing one instance of launching and connecting to a server. --@@ -367,7 +368,7 @@ error "WorkspaceEdit contains neither documentChanges nor changes!" modifyM $ \s -> do- newVFS <- liftIO $ changeFromServerVFS (vfs s) r+ let newVFS = flip execState (vfs s) $ changeFromServerVFS logger r return $ s { vfs = newVFS } let groupedParams = groupBy (\a b -> a ^. textDocument == b ^. textDocument) allChangeParams@@ -384,14 +385,16 @@ modify $ \s -> let oldVFS = vfs s update (VirtualFile oldV file_ver t) = VirtualFile (fromMaybe oldV v) (file_ver +1) t- newVFS = updateVFS (Map.adjust update (toNormalizedUri uri)) oldVFS+ newVFS = oldVFS & vfsMap . ix (toNormalizedUri uri) %~ update in s { vfs = newVFS } - where checkIfNeedsOpened uri = do+ where+ logger = LogAction $ \(WithSeverity msg sev) -> case sev of { Error -> error $ show msg; _ -> pure () }+ checkIfNeedsOpened uri = do oldVFS <- vfs <$> get -- if its not open, open it- unless (toNormalizedUri uri `Map.member` vfsMap oldVFS) $ do+ unless (has (vfsMap . ix (toNormalizedUri uri)) oldVFS) $ do let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents@@ -399,7 +402,7 @@ sendMessage msg modifyM $ \s -> do- let (newVFS,_) = openVFS (vfs s) msg+ let newVFS = flip execState (vfs s) $ openVFS logger msg return $ s { vfs = newVFS } getParamsFromTextDocumentEdit :: TextDocumentEdit -> DidChangeTextDocumentParams@@ -420,9 +423,8 @@ -- For a uri returns an infinite list of versions [n,n+1,n+2,...] -- where n is the current version textDocumentVersions uri = do- m <- vfsMap . vfs <$> get- let curVer = fromMaybe 0 $- _lsp_version <$> m Map.!? (toNormalizedUri uri)+ vfs <- vfs <$> get+ let curVer = fromMaybe 0 $ vfs ^? vfsMap . ix (toNormalizedUri uri) . lsp_version pure $ map (VersionedTextDocumentIdentifier uri . Just) [curVer + 1..] textDocumentEdits uri edits = do
test/DummyServer.hs view
@@ -35,7 +35,7 @@ } bracket- (forkIO $ void $ runServerWithHandles hinRead houtWrite definition)+ (forkIO $ void $ runServerWithHandles mempty mempty hinRead houtWrite definition) killThread (const $ f (hinWrite, houtRead))
test/Test.hs view
@@ -429,7 +429,7 @@ it "full works" $ \(hin, hout) -> runSessionWithHandles hin hout def fullCaps "." $ do let doc = TextDocumentIdentifier (Uri "") Just toks <- getSemanticTokens doc- liftIO $ toks ^. xdata `shouldBe` List [0,1,2,0,0]+ liftIO $ toks ^. xdata `shouldBe` List [0,1,2,1,0] didChangeCaps :: ClientCapabilities didChangeCaps = def { _workspace = Just workspaceCaps }