X-Git-Url: https://git.lukelau.me/?a=blobdiff_plain;f=src%2FLanguage%2FHaskell%2FLSP%2FTest%2FSession.hs;h=21c008643e95869badbe46daa67a1fe9bda9209c;hb=3a38253a1fcd83c83b05fbfbf132d1ead842b0a7;hp=07b588666772f10a2369f92a37a5a96cb89aca67;hpb=16501021ea92ae3c84dbfd99a3c2dd631685b49c;p=lsp-test.git diff --git a/src/Language/Haskell/LSP/Test/Session.hs b/src/Language/Haskell/LSP/Test/Session.hs index 07b5886..21c0086 100644 --- a/src/Language/Haskell/LSP/Test/Session.hs +++ b/src/Language/Haskell/LSP/Test/Session.hs @@ -91,15 +91,22 @@ 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. + -- ^ Whether or not to ignore 'ShowMessageNotification' and 'LogMessageNotification', defaults to False. + -- @since 0.9.0.0 + , ignoreLogNotifications :: Bool } -- | 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,9 +188,14 @@ 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 @@ -281,7 +293,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 } @@ -362,3 +374,4 @@ logMsg t msg = do showPretty = B.unpack . encodePretty +