-- 'Language.Haskell.LSP.Test.sendRequest' and
-- 'Language.Haskell.LSP.Test.sendNotification'.
--- newtype Session a = Session (ParserStateReader FromServerMessage SessionState SessionContext IO a)
-
newtype Session a = Session (ConduitParser FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) a)
deriving (Functor, Applicative, Monad, MonadIO, Alternative)
-- | 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
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 = SessionState (IdInt 0) mempty mempty 0 False Nothing
- runSession' = runSession context initState
+ initState vfs = SessionState (IdInt 0) vfs
+ mempty 0 False Nothing
+ runSession' ses = initVFS $ \vfs -> runSession context (initState vfs) ses
errorHandler = throwTo mainThreadId :: SessionException -> IO()
serverListenerLauncher =
forM_ bumpedVersions $ \(VersionedTextDocumentIdentifier uri v) ->
modify $ \s ->
let oldVFS = vfs s
- update (VirtualFile oldV t mf) = VirtualFile (fromMaybe oldV v) t mf
- newVFS = Map.adjust update (toNormalizedUri uri) oldVFS
+ 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 }
where checkIfNeedsOpened uri = do
ctx <- ask
-- if its not open, open it
- unless (toNormalizedUri uri `Map.member` 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
liftIO $ B.hPut (serverIn ctx) $ addHeader (encode msg)
modifyM $ \s -> do
- newVFS <- liftIO $ openVFS (vfs s) msg
+ let (newVFS,_) = openVFS (vfs s) msg
return $ s { vfs = newVFS }
getParams (TextDocumentEdit docId (List edits)) =
showPretty = B.unpack . encodePretty
+