{-# 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 System.Console.ANSI
import System.Directory
import System.IO
import Language.Haskell.LSP.VFS
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import System.Console.ANSI
import System.Directory
import System.IO
--- 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.
absRootDir <- canonicalizePath rootDir
hSetBuffering serverIn NoBuffering
hSetBuffering serverOut NoBuffering
absRootDir <- canonicalizePath rootDir
hSetBuffering serverIn NoBuffering
hSetBuffering serverOut NoBuffering
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
+ errorHandler = throwTo mainThreadId :: SessionException -> IO()
+ serverLauncher = forkIO $ catch (serverHandler serverOut context) errorHandler
+ serverFinalizer tid = finally (timeout 60000000 (runSession' exitServer))
+ (killThread tid)
- 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
-- 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