diff --git a/ChangeLog.md b/ChangeLog.md --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,9 @@ # Revision history for lsp-test +## 0.17.0.1 + +- Support for newer versions of dependencies. + ## 0.17.0.0 - `ignoreRegistrationRequests` option to ignore `client/registerCapability` requests, on diff --git a/bench/SimpleBench.hs b/bench/SimpleBench.hs --- a/bench/SimpleBench.hs +++ b/bench/SimpleBench.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} module Main where diff --git a/example/Test.hs b/example/Test.hs --- a/example/Test.hs +++ b/example/Test.hs @@ -6,6 +6,7 @@ import Language.LSP.Protocol.Types import Language.LSP.Test +main :: IO () main = runSession "lsp-demo-reactor-server" fullCaps "test/data/" $ do doc <- openDoc "Rename.hs" "haskell" diff --git a/func-test/FuncTest.hs b/func-test/FuncTest.hs --- a/func-test/FuncTest.hs +++ b/func-test/FuncTest.hs @@ -15,14 +15,12 @@ import Data.Aeson qualified as J import Data.Maybe import Data.Proxy -import Data.Set qualified as Set import Language.LSP.Protocol.Lens qualified as L import Language.LSP.Protocol.Message import Language.LSP.Protocol.Types import Language.LSP.Server import Language.LSP.Test qualified as Test import System.Exit -import System.IO import System.Process import Test.Hspec import UnliftIO diff --git a/lsp-test.cabal b/lsp-test.cabal --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: lsp-test -version: 0.17.0.0 +version: 0.17.0.1 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against @@ -31,7 +31,11 @@ type: git location: https://github.com/haskell/lsp +common warnings + ghc-options: -Wunused-packages + library + import: warnings hs-source-dirs: src default-language: GHC2021 exposed-modules: Language.LSP.Test @@ -44,7 +48,7 @@ build-depends: , aeson >=2 && <2.3 , aeson-pretty ^>=0.8 - , ansi-terminal >=0.10 && <1.1 + , ansi-terminal >=0.10 && <1.2 , async ^>=2.2 , base >=4.10 && <5 , bytestring >=0.10 && <0.13 @@ -61,12 +65,11 @@ , Glob >=0.9 && <0.11 , lens >=5.1 && <5.3 , lens-aeson ^>=1.2 - , lsp ^>=2.4 - , lsp-types ^>=2.1 + , lsp ^>=2.5 + , lsp-types ^>=2.2 , mtl >=2.2 && <2.4 , parser-combinators ^>=1.3 , process ^>=1.6 - , row-types ^>=1.0 , some ^>=1.0 , text >=1 && <2.2 , time >=1.10 && <1.13 @@ -90,6 +93,7 @@ ghc-options: -W test-suite tests + import: warnings type: exitcode-stdio-1.0 hs-source-dirs: test main-is: Test.hs @@ -115,6 +119,7 @@ , unliftio test-suite func-test + import: warnings type: exitcode-stdio-1.0 hs-source-dirs: func-test default-language: GHC2021 @@ -123,7 +128,6 @@ , base , aeson , co-log-core - , containers , hspec , lens , lsp @@ -133,6 +137,7 @@ , unliftio test-suite example + import: warnings type: exitcode-stdio-1.0 hs-source-dirs: example default-language: GHC2021 @@ -145,11 +150,12 @@ build-tool-depends: lsp:lsp-demo-reactor-server benchmark simple-bench + import: warnings type: exitcode-stdio-1.0 hs-source-dirs: bench default-language: GHC2021 main-is: SimpleBench.hs - ghc-options: -Wall -O2 -eventlog -rtsopts + ghc-options: -Wall -O2 -rtsopts build-depends: , base , extra diff --git a/src/Language/LSP/Test.hs b/src/Language/LSP/Test.hs --- a/src/Language/LSP/Test.hs +++ b/src/Language/LSP/Test.hs @@ -1,8 +1,8 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} {- | Module : Language.LSP.Test @@ -289,7 +289,7 @@ caps -- TODO: make this configurable? (Just $ Object $ lspConfig config') - (Just TraceValues_Off) + (Just TraceValue_Off) (fmap InL $ initialWorkspaceFolders config) runSession' serverIn serverOut serverProc listenServer config caps rootDir exitServer $ do -- Wrap the session around initialize and shutdown calls @@ -546,7 +546,7 @@ -- | The path to the document to open, __relative to the root directory__. FilePath -> -- | The text document's language identifier, e.g. @"haskell"@. - T.Text -> + LanguageKind -> -- | The content of the text document to create. T.Text -> -- | The identifier of the document just created. @@ -559,7 +559,7 @@ let pred :: SomeRegistration -> [TRegistration Method_WorkspaceDidChangeWatchedFiles] pred (SomeRegistration r@(TRegistration _ SMethod_WorkspaceDidChangeWatchedFiles _)) = [r] pred _ = mempty - regs = concatMap pred $ Map.elems dynCaps + regs = concatMap pred dynCaps watchHits :: FileSystemWatcher -> Bool watchHits (FileSystemWatcher (GlobPattern (InL (Pattern pattern))) kind) = -- If WatchKind is excluded, defaults to all true as per spec @@ -591,7 +591,7 @@ {- | Opens a text document that /exists on disk/, and sends a textDocument/didOpen notification to the server. -} -openDoc :: FilePath -> T.Text -> Session TextDocumentIdentifier +openDoc :: FilePath -> LanguageKind -> Session TextDocumentIdentifier openDoc file languageId = do context <- ask let fp = rootDir context file @@ -601,7 +601,7 @@ {- | This is a variant of `openDoc` that takes the file content as an argument. Use this is the file exists /outside/ of the current workspace. -} -openDoc' :: FilePath -> T.Text -> T.Text -> Session TextDocumentIdentifier +openDoc' :: FilePath -> LanguageKind -> T.Text -> Session TextDocumentIdentifier openDoc' file languageId contents = do context <- ask let fp = rootDir context file @@ -740,7 +740,7 @@ Note that this does not wait for more to come in. -} getCurrentDiagnostics :: TextDocumentIdentifier -> Session [Diagnostic] -getCurrentDiagnostics doc = fromMaybe [] . Map.lookup (toNormalizedUri $ doc ^. L.uri) . curDiagnostics <$> get +getCurrentDiagnostics doc = Map.findWithDefault [] (toNormalizedUri $ doc ^. L.uri) . curDiagnostics <$> get -- | Returns the tokens of all progress sessions that have started but not yet ended. getIncompleteProgressSessions :: Session (Set.Set ProgressToken) diff --git a/src/Language/LSP/Test/Compat.hs b/src/Language/LSP/Test/Compat.hs --- a/src/Language/LSP/Test/Compat.hs +++ b/src/Language/LSP/Test/Compat.hs @@ -1,6 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} -{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} -- For some reason ghc warns about not using -- Control.Monad.IO.Class but it's needed for @@ -10,8 +10,7 @@ module Language.LSP.Test.Compat where import Data.Maybe -import Data.Row -import Data.Text qualified as T +import Language.LSP.Protocol.Types qualified as L import System.IO #if MIN_VERSION_process(1,6,3) @@ -103,7 +102,7 @@ return () where ignoreSigPipe = ignoreIOError ResourceVanished ePIPE ignorePermDenied = ignoreIOError PermissionDenied eACCES - + ignoreIOError :: IOErrorType -> Errno -> IO () -> IO () ignoreIOError ioErrorType errno = C.handle $ \e -> case e of @@ -118,5 +117,5 @@ #endif -lspTestClientInfo :: Rec ("name" .== T.Text .+ "version" .== Maybe T.Text) -lspTestClientInfo = #name .== "lsp-test" .+ #version .== (Just CURRENT_PACKAGE_VERSION) +lspTestClientInfo :: L.ClientInfo +lspTestClientInfo = L.ClientInfo{L._name = "lsp-test", L._version = Just CURRENT_PACKAGE_VERSION} diff --git a/src/Language/LSP/Test/Decoding.hs b/src/Language/LSP/Test/Decoding.hs --- a/src/Language/LSP/Test/Decoding.hs +++ b/src/Language/LSP/Test/Decoding.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} module Language.LSP.Test.Decoding where @@ -10,7 +10,6 @@ import Data.Aeson.Types import Data.ByteString.Lazy.Char8 qualified as B import Data.Foldable -import Data.Functor.Const import Data.Functor.Product import Data.Maybe import Language.LSP.Protocol.Lens qualified as L @@ -82,7 +81,7 @@ let (mm, newMap) = pickFromIxMap lid reqMap in case mm of Nothing -> Nothing - Just m -> Just $ (m, Pair m (Const newMap)) + Just m -> Just (m, Pair m (Const newMap)) unP (Success (FromServerMess m msg)) = (reqMap, FromServerMess m msg) unP (Success (FromServerRsp (Pair m (Const newMap)) msg)) = (newMap, FromServerRsp m msg) unP (Error e) = error $ "Error decoding " <> show obj <> " :" <> e diff --git a/src/Language/LSP/Test/Files.hs b/src/Language/LSP/Test/Files.hs --- a/src/Language/LSP/Test/Files.hs +++ b/src/Language/LSP/Test/Files.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} module Language.LSP.Test.Files ( swapFiles, @@ -83,18 +83,13 @@ swapDocumentChangeUri (InR (InR (InL renameFile))) = InR $ InR $ InL $ L.newUri .~ f (renameFile ^. L.newUri) $ renameFile swapDocumentChangeUri (InR (InR (InR deleteFile))) = InR $ InR $ InR $ swapUri id deleteFile in e - & L.changes . _Just %~ swapKeys f + & L.changes . _Just %~ M.mapKeys f & L.documentChanges . _Just . traversed %~ swapDocumentChangeUri - swapKeys :: (Uri -> Uri) -> M.Map Uri b -> M.Map Uri b - swapKeys f = M.foldlWithKey' (\acc k v -> M.insert (f k) v acc) M.empty - swapUri :: L.HasUri b Uri => Lens' a b -> a -> a - swapUri lens x = - let newUri = f (x ^. lens . L.uri) - in (lens . L.uri) .~ newUri $ x + swapUri lens = (lens . L.uri) %~ f - -- \| Transforms rootUri/rootPath. + -- Transforms rootUri/rootPath. transformInit :: InitializeParams -> InitializeParams transformInit x = let modifyRootPath p = diff --git a/src/Language/LSP/Test/Parsing.hs b/src/Language/LSP/Test/Parsing.hs --- a/src/Language/LSP/Test/Parsing.hs +++ b/src/Language/LSP/Test/Parsing.hs @@ -1,7 +1,7 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} module Language.LSP.Test.Parsing ( -- $receiving diff --git a/src/Language/LSP/Test/Session.hs b/src/Language/LSP/Test/Session.hs --- a/src/Language/LSP/Test/Session.hs +++ b/src/Language/LSP/Test/Session.hs @@ -2,9 +2,10 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} +{-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedLabels #-} -{-# LANGUAGE TypeInType #-} +{-# LANGUAGE DataKinds #-} module Language.LSP.Test.Session ( Session(..) @@ -80,7 +81,6 @@ import System.Timeout ( timeout ) import Data.IORef import Colog.Core (LogAction (..), WithSeverity (..), Severity (..)) -import Data.Row import Data.String (fromString) import Data.Either (partitionEithers) @@ -118,13 +118,13 @@ -- with a 'mylang' key whose value is the actual config for the server. You -- can also include other config sections if your server may request those. , ignoreLogNotifications :: Bool - -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications + -- ^ Whether or not to ignore @window/showMessage@ and @window/logMessage@ notifications -- from the server, defaults to True. , ignoreConfigurationRequests :: Bool -- ^ Whether or not to ignore @workspace/configuration@ requests from the server, -- defaults to True. , ignoreRegistrationRequests :: Bool - -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@ + -- ^ Whether or not to ignore @client/registerCapability@ and @client/unregisterCapability@ -- requests from the server, defaults to True. , initialWorkspaceFolders :: Maybe [WorkspaceFolder] -- ^ The initial workspace folders to send in the @initialize@ request. @@ -247,7 +247,7 @@ curId <- getCurTimeoutId case msg of ServerMessage sMsg -> yield sMsg - TimeoutMessage tId -> when (curId == tId) $ lastReceivedMessage <$> get >>= throw . Timeout + TimeoutMessage tId -> when (curId == tId) $ get >>= throw . Timeout . lastReceivedMessage -- | An internal version of 'runSession' that allows for a custom handler to listen to the server. -- It also does not automatically send initialize and exit messages. @@ -338,7 +338,7 @@ let requestedSections = mapMaybe (\i -> i ^? L.section . _Just) $ r ^. L.params . L.items let o = curLspConfig state -- check for each requested section whether we have it - let configsOrErrs = (flip fmap) requestedSections $ \section -> + let configsOrErrs = flip fmap requestedSections $ \section -> case o ^. at (fromString $ T.unpack section) of Just config -> Right config Nothing -> Left section @@ -347,9 +347,9 @@ -- we have to return exactly the number of sections requested, so if we can't find all of them then that's an error sendMessage $ TResponseMessage "2.0" (Just $ r ^. L.id) $ - if null errs - then (Right configs) - else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> (T.pack $ show errs)) Nothing + if null errs + then Right configs + else Left $ ResponseError (InL LSPErrorCodes_RequestFailed) ("No configuration for requested sections: " <> T.pack (show errs)) Nothing _ -> pure () unless ( (ignoringLogNotifications state && isLogNotification msg) @@ -414,7 +414,7 @@ -- First, prefer the versioned documentChanges field allChangeParams <- case r ^. L.params . L.edit . L.documentChanges of - Just (cs) -> do + Just cs -> do mapM_ (checkIfNeedsOpened . documentChangeUri) cs -- replace the user provided version numbers with the VFS ones + 1 -- (technically we should check that the user versions match the VFS ones) @@ -472,8 +472,8 @@ -- TODO: move somewhere reusable editToChangeEvent :: TextEdit |? AnnotatedTextEdit -> TextDocumentContentChangeEvent - editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. L.range) .+ #rangeLength .== Nothing .+ #text .== (e ^. L.newText) - editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ #range .== (e ^. L.range) .+ #rangeLength .== Nothing .+ #text .== (e ^. L.newText) + editToChangeEvent (InR e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = e ^. L.range , _rangeLength = Nothing , _text = e ^. L.newText } + editToChangeEvent (InL e) = TextDocumentContentChangeEvent $ InL $ TextDocumentContentChangePartial { _range = e ^. L.range , _rangeLength = Nothing , _text = e ^. L.newText } getParamsFromDocumentChange :: DocumentChange -> Maybe DidChangeTextDocumentParams getParamsFromDocumentChange (InL textDocumentEdit) = getParamsFromTextDocumentEdit textDocumentEdit @@ -491,11 +491,11 @@ textDocumentEdits uri edits = do vers <- textDocumentVersions uri - pure $ map (\(v, e) -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) $ zip vers edits + pure $ zipWith (\v e -> TextDocumentEdit (review _versionedTextDocumentIdentifier v) [InL e]) vers edits getChangeParams uri edits = do edits <- textDocumentEdits uri (reverse edits) - pure $ catMaybes $ map getParamsFromTextDocumentEdit edits + pure $ mapMaybe getParamsFromTextDocumentEdit edits mergeParams :: [DidChangeTextDocumentParams] -> DidChangeTextDocumentParams mergeParams params = let events = concat (toList (map (toList . (^. L.contentChanges)) params)) diff --git a/test/DummyServer.hs b/test/DummyServer.hs --- a/test/DummyServer.hs +++ b/test/DummyServer.hs @@ -1,6 +1,6 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} module DummyServer where diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,7 +1,7 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeInType #-} import Control.Applicative.Combinators import Control.Concurrent