{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Control.Monad.Trans.Reader as Reader (ask)
import Control.Monad.Trans.State (StateT, runStateT)
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import qualified Control.Monad.Trans.Reader as Reader (ask)
import Control.Monad.Trans.State (StateT, runStateT)
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
--- You can send and receive messages to the server within 'Session' via 'getMessage',
--- 'sendRequest' and 'sendNotification'.
---
+-- You can send and receive messages to the server within 'Session' via
+-- 'Language.Haskell.LSP.Test.message',
+-- 'Language.Haskell.LSP.Test.sendRequest' and
+-- 'Language.Haskell.LSP.Test.sendNotification'.
-- | 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.
-- | 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.
}
-- | The configuration used in 'Language.Haskell.LSP.Test.runSession'.
defaultConfig :: SessionConfig
}
-- | The configuration used in 'Language.Haskell.LSP.Test.runSession'.
defaultConfig :: SessionConfig
, curTimeoutId :: Int
, overridingTimeout :: Bool
-- ^ The last received message from the server.
, curTimeoutId :: Int
, overridingTimeout :: Bool
-- ^ The last received message from the server.
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
-
- threadId <- forkIO $ void $ serverHandler serverOut context
- (result, _) <- runSession context initState session
-
- killThread threadId
-
+ launchServerHandler = forkIO $ catch (serverHandler serverOut context)
+ (throwTo mainThreadId :: SessionException -> IO())
+ (result, _) <- bracket
+ launchServerHandler
+ (\tid -> do runSession context initState sendExitMessage
+ killThread tid)
+ (const $ runSession context initState session)
- update (VirtualFile oldV t) = VirtualFile (fromMaybe oldV v) t
- newVFS = Map.adjust update uri oldVFS
+ update (VirtualFile oldV t mf) = VirtualFile (fromMaybe oldV v) t mf
+ newVFS = Map.adjust update (toNormalizedUri uri) oldVFS
let fp = fromJust $ uriToFilePath uri
contents <- liftIO $ T.readFile fp
let item = TextDocumentItem (filePathToUri fp) "" 0 contents
let fp = fromJust $ uriToFilePath uri
contents <- liftIO $ T.readFile fp
let item = TextDocumentItem (filePathToUri fp) "" 0 contents
--- | Execute a block f that will throw a 'TimeoutException'
+sendExitMessage :: (MonadIO m, HasReader SessionContext m) => m ()
+sendExitMessage = sendMessage (NotificationMessage "2.0" Exit ExitParams)
+
+-- | Execute a block f that will throw a 'Timeout' exception
-- after duration seconds. This will override the global timeout
-- for waiting for messages to arrive defined in 'SessionConfig'.
withTimeout :: Int -> Session a -> Session a
-- after duration seconds. This will override the global timeout
-- for waiting for messages to arrive defined in 'SessionConfig'.
withTimeout :: Int -> Session a -> Session a