import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Except
-#if __GLASGOW_HASKELL__ >= 806
+#if __GLASGOW_HASKELL__ == 806
import Control.Monad.Fail
#endif
import Control.Monad.Trans.Reader (ReaderT, runReaderT)
import Language.Haskell.LSP.Types
import Language.Haskell.LSP.Types.Lens hiding (error)
import Language.Haskell.LSP.VFS
+import Language.Haskell.LSP.Test.Compat
import Language.Haskell.LSP.Test.Decoding
import Language.Haskell.LSP.Test.Exceptions
import System.Console.ANSI
import System.Directory
import System.IO
+import System.Process (ProcessHandle())
+import System.Timeout
-- | A session representing one instance of launching and connecting to a server.
--
-- It also does not automatically send initialize and exit messages.
runSessionWithHandles :: Handle -- ^ Server in
-> Handle -- ^ Server out
+ -> ProcessHandle -- ^ Server process
-> (Handle -> SessionContext -> IO ()) -- ^ Server listener
-> SessionConfig
-> ClientCapabilities
-> FilePath -- ^ Root directory
- -> Session () -- ^ To exit Server
+ -> Session () -- ^ To exit the Server properly
-> Session a
-> IO a
-runSessionWithHandles serverIn serverOut serverHandler config caps rootDir exitServer session = do
-
+runSessionWithHandles serverIn serverOut serverProc serverHandler config caps rootDir exitServer session = do
absRootDir <- canonicalizePath rootDir
hSetBuffering serverIn NoBuffering
runSession' = runSession context initState
errorHandler = throwTo mainThreadId :: SessionException -> IO()
- serverLauncher = forkIO $ catch (serverHandler serverOut context) errorHandler
- serverFinalizer tid = runSession' exitServer >> killThread tid
-
- (result, _) <- bracket serverLauncher serverFinalizer (const $ runSession' session)
+ serverListenerLauncher =
+ forkIO $ catch (serverHandler serverOut context) errorHandler
+ server = (Just serverIn, Just serverOut, Nothing, serverProc)
+ serverAndListenerFinalizer tid =
+ finally (timeout (messageTimeout config * 1000000)
+ (runSession' exitServer))
+ (cleanupProcess server >> killThread tid)
+
+ (result, _) <- bracket serverListenerLauncher serverAndListenerFinalizer
+ (const $ runSession' session)
return result
updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()