import System.IO
import System.Process (ProcessHandle())
import System.Timeout
-import System.IO.Temp
-- | A session representing one instance of launching and connecting to a server.
--
, logMessages :: Bool -- ^ Trace the messages sent and received to stdout, defaults to False.
, 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
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.
mainThreadId <- myThreadId
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
- initState tmp_dir = SessionState (IdInt 0) (VFS mempty tmp_dir)
+ initState vfs = SessionState (IdInt 0) vfs
mempty 0 False Nothing
- runSession' ses = withSystemTempDirectory "lsp-test" $ \tmp_dir ->
- runSession context (initState tmp_dir) ses
+ runSession' ses = initVFS $ \vfs -> runSession context (initState vfs) ses
errorHandler = throwTo mainThreadId :: SessionException -> IO()
serverListenerLauncher =
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
showPretty = B.unpack . encodePretty
+