From: Luke Lau Date: Fri, 20 Dec 2019 00:01:01 +0000 (+0000) Subject: Merge branch 'master' into github-actions X-Git-Url: https://git.lukelau.me/?p=lsp-test.git;a=commitdiff_plain;h=14966566f56badb30e257defe62463e484a2892a;hp=a61a867b278edc025489298b360340e7ddec05e7 Merge branch 'master' into github-actions --- diff --git a/.gitignore b/.gitignore index b057681..223787e 100644 --- a/.gitignore +++ b/.gitignore @@ -1,4 +1,5 @@ .stack-work +stack.yaml.lock dist .cabal-sandbox cabal.sandbox.config diff --git a/ChangeLog.md b/ChangeLog.md index c75f2c6..17c926a 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -1,5 +1,12 @@ # Revision history for lsp-test +## 0.9.0.0 -- 2019-12-1 + +* Add `ignoreLogNotifications` config option +* Add ability to override `logStdErr` and `logMessages` config options with + the `LSP_TEST_LOG_STDERR` and `LOG_TEST_LOG_MESSAGES` environment variables +* Update for haskell-lsp-0.19.0.0 (@mpickering) + ## 0.8.2.0 -- 2019-11-17 * Expose `satisfyMaybe` (@cocreature) diff --git a/lsp-test.cabal b/lsp-test.cabal index bdb4275..0d43611 100644 --- a/lsp-test.cabal +++ b/lsp-test.cabal @@ -1,5 +1,5 @@ name: lsp-test -version: 0.8.2.0 +version: 0.9.0.0 synopsis: Functional test framework for LSP servers. description: A test framework for writing tests against @@ -13,7 +13,6 @@ license: BSD3 license-file: LICENSE author: Luke Lau maintainer: luke_lau@icloud.com -stability: experimental bug-reports: https://github.com/bubba/lsp-test/issues copyright: 2019 Luke Lau category: Testing @@ -36,7 +35,7 @@ library , parser-combinators:Control.Applicative.Combinators default-language: Haskell2010 build-depends: base >= 4.10 && < 5 - , haskell-lsp == 0.18.* + , haskell-lsp == 0.19.* , aeson , aeson-pretty , ansi-terminal @@ -53,7 +52,6 @@ library , mtl , parser-combinators , process >= 1.6 - , rope-utf16-splay , text , transformers , unordered-containers @@ -79,7 +77,7 @@ test-suite tests build-depends: base >= 4.10 && < 5 , hspec , lens - , haskell-lsp == 0.18.* + , haskell-lsp == 0.19.* , lsp-test , data-default , aeson diff --git a/src/Language/Haskell/LSP/Test.hs b/src/Language/Haskell/LSP/Test.hs index a6612e2..3ad7b2f 100644 --- a/src/Language/Haskell/LSP/Test.hs +++ b/src/Language/Haskell/LSP/Test.hs @@ -37,6 +37,7 @@ module Language.Haskell.LSP.Test , module Language.Haskell.LSP.Test.Parsing -- * Utilities -- | Quick helper functions for common tasks. + -- ** Initialization , initializeResponse -- ** Documents @@ -109,10 +110,10 @@ import Language.Haskell.LSP.Test.Exceptions import Language.Haskell.LSP.Test.Parsing import Language.Haskell.LSP.Test.Session import Language.Haskell.LSP.Test.Server +import System.Environment import System.IO import System.Directory import System.FilePath -import qualified Data.Rope.UTF16 as Rope -- | Starts a new session. -- @@ -136,10 +137,12 @@ runSessionWithConfig :: SessionConfig -- ^ Configuration options for the session -> FilePath -- ^ The filepath to the root directory for the session. -> Session a -- ^ The session to run. -> IO a -runSessionWithConfig config serverExe caps rootDir session = do +runSessionWithConfig config' serverExe caps rootDir session = do pid <- getCurrentProcessID absRootDir <- canonicalizePath rootDir + config <- envOverrideConfig config' + let initializeParams = InitializeParams (Just pid) (Just $ T.pack absRootDir) (Just $ filePathToUri absRootDir) @@ -184,12 +187,23 @@ runSessionWithConfig config serverExe caps rootDir session = do (RspShutdown _) -> return () _ -> listenServer serverOut context + -- | Check environment variables to override the config + envOverrideConfig :: SessionConfig -> IO SessionConfig + envOverrideConfig cfg = do + logMessages' <- fromMaybe (logMessages cfg) <$> checkEnv "LSP_TEST_LOG_MESSAGES" + logStdErr' <- fromMaybe (logStdErr cfg) <$> checkEnv "LSP_TEST_LOG_STDERR" + return $ cfg { logMessages = logMessages', logStdErr = logStdErr' } + where checkEnv :: String -> IO (Maybe Bool) + checkEnv s = fmap convertVal <$> lookupEnv s + convertVal "0" = False + convertVal _ = True + -- | The current text contents of a document. documentContents :: TextDocumentIdentifier -> Session T.Text documentContents doc = do vfs <- vfs <$> get let file = vfsMap vfs Map.! toNormalizedUri (doc ^. uri) - return $ Rope.toText $ Language.Haskell.LSP.VFS._text file + return (virtualFileText file) -- | Parses an ApplyEditRequest, checks that it is for the passed document -- and returns the new content @@ -452,7 +466,7 @@ getVersionedDoc (TextDocumentIdentifier uri) = do fs <- vfsMap . vfs <$> get let ver = case fs Map.!? toNormalizedUri uri of - Just (VirtualFile v _) -> Just v + Just vf -> Just (virtualFileVersion vf) _ -> Nothing return (VersionedTextDocumentIdentifier uri ver) diff --git a/src/Language/Haskell/LSP/Test/Exceptions.hs b/src/Language/Haskell/LSP/Test/Exceptions.hs index dd31ea3..713b25f 100644 --- a/src/Language/Haskell/LSP/Test/Exceptions.hs +++ b/src/Language/Haskell/LSP/Test/Exceptions.hs @@ -11,7 +11,7 @@ import Data.List import qualified Data.ByteString.Lazy.Char8 as B -- | An exception that can be thrown during a 'Haskell.LSP.Test.Session.Session' -data SessionException = Timeout +data SessionException = Timeout (Maybe FromServerMessage) | NoContentLengthHeader | UnexpectedMessage String FromServerMessage | ReplayOutOfOrder FromServerMessage [FromServerMessage] @@ -24,12 +24,16 @@ data SessionException = Timeout instance Exception SessionException instance Show SessionException where - show Timeout = "Timed out waiting to receive a message from the server." + show (Timeout lastMsg) = + "Timed out waiting to receive a message from the server." ++ + case lastMsg of + Just msg -> "\nLast message received:\n" ++ B.unpack (encodePretty msg) + Nothing -> mempty show NoContentLengthHeader = "Couldn't read Content-Length header from the server." show (UnexpectedMessage expected lastMsg) = "Received an unexpected message from the server:\n" ++ "Was parsing: " ++ expected ++ "\n" ++ - "Last message received: " ++ show lastMsg + "Last message received:\n" ++ B.unpack (encodePretty lastMsg) show (ReplayOutOfOrder received expected) = let expected' = nub expected getJsonDiff = lines . B.unpack . encodePretty diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 67e4ae6..ac4c9ff 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -91,15 +91,24 @@ instance MonadFail Session where -- | Stuff you can configure for a 'Session'. data SessionConfig = SessionConfig { messageTimeout :: Int -- ^ Maximum time to wait for a message in seconds, defaults to 60. - , logStdErr :: Bool -- ^ Redirect the server's stderr to this stdout, defaults to False. - , logMessages :: Bool -- ^ Trace the messages sent and received to stdout, defaults to False. + , logStdErr :: Bool + -- ^ Redirect the server's stderr to this stdout, defaults to False. + -- Can be overriden with @LSP_TEST_LOG_STDERR@. + , logMessages :: Bool + -- ^ Trace the messages sent and received to stdout, defaults to False. + -- Can be overriden with the environment variable @LSP_TEST_LOG_MESSAGES@. , logColor :: Bool -- ^ Add ANSI color to the logged messages, defaults to True. , lspConfig :: Maybe Value -- ^ The initial LSP config as JSON value, defaults to Nothing. + , ignoreLogNotifications :: Bool + -- ^ Whether or not to ignore 'Language.Haskell.LSP.Types.ShowMessageNotification' and + -- 'Language.Haskell.LSP.Types.LogMessageNotification', defaults to False. + -- + -- @since 0.9.0.0 } -- | The configuration used in 'Language.Haskell.LSP.Test.runSession'. defaultConfig :: SessionConfig -defaultConfig = SessionConfig 60 False False True Nothing +defaultConfig = SessionConfig 60 False False True Nothing False instance Default SessionConfig where def = defaultConfig @@ -181,15 +190,20 @@ runSession context state (Session session) = runReaderT (runStateT conduit state chanSource = do msg <- liftIO $ readChan (messageChan context) + unless (ignoreLogNotifications (config context) && isLogNotification msg) $ yield msg chanSource + isLogNotification (ServerMessage (NotShowMessage _)) = True + isLogNotification (ServerMessage (NotLogMessage _)) = True + isLogNotification _ = False + watchdog :: ConduitM SessionMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) () watchdog = Conduit.awaitForever $ \msg -> do curId <- curTimeoutId <$> get case msg of ServerMessage sMsg -> yield sMsg - TimeoutMessage tId -> when (curId == tId) $ throw Timeout + TimeoutMessage tId -> when (curId == tId) $ lastReceivedMessage <$> get >>= throw . Timeout -- | 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. @@ -281,7 +295,7 @@ updateState (ReqApplyWorkspaceEdit r) = do forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) -> modify $ \s -> let oldVFS = vfs s - update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t + update (VirtualFile oldV file_ver t) = VirtualFile (fromMaybe oldV v) (file_ver + 1) t newVFS = updateVFS (Map.adjust update (toNormalizedUri uri)) oldVFS in s { vfs = newVFS } @@ -290,7 +304,7 @@ updateState (ReqApplyWorkspaceEdit r) = do ctx <- ask -- if its not open, open it - unless (toNormalizedUri uri `Map.member` (vfsMap oldVFS)) $ do + unless (toNormalizedUri uri `Map.member` vfsMap oldVFS) $ do let fp = fromJust $ uriToFilePath uri contents <- liftIO $ T.readFile fp let item = TextDocumentItem (filePathToUri fp) "" 0 contents @@ -362,3 +376,4 @@ logMsg t msg = do showPretty = B.unpack . encodePretty + diff --git a/stack.yaml b/stack.yaml index 1e8b3c2..c3e341c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,11 +1,3 @@ -resolver: lts-13.26 +resolver: nightly-2019-12-16 packages: - . - -extra-deps: - - rope-utf16-splay-0.3.1.0 - - github: alanz/haskell-lsp - commit: 2aacc5ca706bcce111e976a1af4a95a376137c5e - subdirs: - - . - - haskell-lsp-types diff --git a/stack.yaml.lock b/stack.yaml.lock deleted file mode 100644 index d72396d..0000000 --- a/stack.yaml.lock +++ /dev/null @@ -1,51 +0,0 @@ -# This file was autogenerated by Stack. -# You should not edit this file by hand. -# For more information, please see the documentation at: -# https://docs.haskellstack.org/en/stable/lock_files - -packages: -- completed: - hackage: rope-utf16-splay-0.3.1.0@sha256:15a53c57f8413d193054bb5f045929edae3b2669def4c6af63197b30dc1d5003,2029 - pantry-tree: - size: 667 - sha256: 876b05bbbd1394bb862a7e2d460f6fe30f509c4c9a530530cb9fe7ec19a89c30 - original: - hackage: rope-utf16-splay-0.3.1.0 -- completed: - size: 86224 - subdir: . - url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz - cabal-file: - size: 5264 - sha256: ddfcc2798f04bcb1ec20fafc02c03faa197322192578e879cef5852aba43ebcb - name: haskell-lsp - version: 0.17.0.0 - sha256: fbbc3ebdbb2c0f6eacdb9f3c8a3550e71617aff9df279da175c8b99c422ddeb9 - pantry-tree: - size: 5675 - sha256: 80539460483f0459786fce73d842b203eef003fd1c657281daec8aea2957db3f - original: - subdir: . - url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz -- completed: - size: 86224 - subdir: haskell-lsp-types - url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz - cabal-file: - size: 2941 - sha256: 9078237412d0596a7d09d432389c8fa21d6f3e21ed2ed761b3093a21607d6c28 - name: haskell-lsp-types - version: 0.17.0.0 - sha256: fbbc3ebdbb2c0f6eacdb9f3c8a3550e71617aff9df279da175c8b99c422ddeb9 - pantry-tree: - size: 2501 - sha256: a575ce26976bd31d34a9db27e20e8e34d9b50b8d2e34a2e3772b3236b8cf778c - original: - subdir: haskell-lsp-types - url: https://github.com/alanz/haskell-lsp/archive/2aacc5ca706bcce111e976a1af4a95a376137c5e.tar.gz -snapshots: -- completed: - size: 499889 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/26.yaml - sha256: ecb02ee16829df8d7219e7d7fe6c310819820bf335b0b9534bce84d3ea896684 - original: lts-13.26 diff --git a/test/Test.hs b/test/Test.hs index 22f8e21..ed8c6b5 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -93,7 +93,9 @@ main = hspec $ do getDocumentSymbols doc -- should now timeout skipManyTill anyMessage message :: Session ApplyWorkspaceEditRequest - in sesh `shouldThrow` (== Timeout) + isTimeout (Timeout _) = True + isTimeout _ = False + in sesh `shouldThrow` isTimeout describe "SessionException" $ do @@ -333,6 +335,12 @@ main = hspec $ do pred _ = False void $ satisfy pred + describe "ignoreLogNotifications" $ + it "works" $ + runSessionWithConfig (defaultConfig { ignoreLogNotifications = True }) "hie" fullCaps "test/data" $ do + openDoc "Format.hs" "haskell" + void publishDiagnosticsNotification + mkRange sl sc el ec = Range (Position sl sc) (Position el ec) didChangeCaps :: ClientCapabilities