lsp-test 0.17.0.0 → 0.17.0.1

raw patch · 13 files changed

+53/−52 lines, 13 filesdep −row-typesdep ~containersdep ~lspdep ~lsp-typesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: row-types

Dependency ranges changed: containers, lsp, lsp-types

API changes (from Hackage documentation)

Files

• ChangeLog.md +4/−0
• bench/SimpleBench.hs +0/−1
• example/Test.hs +1/−0
• func-test/FuncTest.hs +0/−2
• lsp-test.cabal +13/−7
• src/Language/LSP/Test.hs +7/−7
• src/Language/LSP/Test/Compat.hs +5/−6
• src/Language/LSP/Test/Decoding.hs +2/−3
• src/Language/LSP/Test/Files.hs +4/−9
• src/Language/LSP/Test/Parsing.hs +1/−1
• src/Language/LSP/Test/Session.hs +14/−14
• test/DummyServer.hs +1/−1
• test/Test.hs +1/−1

@@ -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

@@ -1,7 +1,6 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}  module Main where 

@@ -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" 

@@ -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

@@ -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

@@ -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)

@@ -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}

@@ -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

@@ -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 =

@@ -1,7 +1,7 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeInType #-}  module Language.LSP.Test.Parsing (   -- $receiving

@@ -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))

@@ -1,6 +1,6 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeInType #-}  module DummyServer where 

@@ -1,7 +1,7 @@+{-# LANGUAGE DataKinds #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeInType #-}  import Control.Applicative.Combinators import Control.Concurrent