- 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)
+ msgTimeoutMs = messageTimeout config * 10^6
+ serverAndListenerFinalizer tid = do
+ let cleanup
+ | Just sp <- mServerProc = do
+ -- Give the server some time to exit cleanly
+ timeout msgTimeoutMs (waitForProcess sp)
+ cleanupProcess (Just serverIn, Just serverOut, Nothing, sp)
+ | otherwise = pure ()
+ finally (timeout msgTimeoutMs (runSession' exitServer))
+ -- Make sure to kill the listener first, before closing
+ -- handles etc via cleanupProcess
+ (killThread tid >> cleanup)
+
+ (result, _) <- bracket serverListenerLauncher
+ serverAndListenerFinalizer
+ (const $ initVFS $ \vfs -> runSessionMonad context (initState vfs) session)