import Data.Conduit.Parser as Parser
import Data.Default
import Data.Foldable
-import Data.IORef
import Data.List
import qualified Data.Map as Map
import qualified Data.Text as T
-> SessionConfig
-> ClientCapabilities
-> FilePath -- ^ Root directory
+ -> Session () -- ^ To exit Server
-> Session a
-> IO a
-runSessionWithHandles serverIn serverOut serverHandler config caps rootDir session = do
- -- We use this IORef to make exception non-fatal when the server is supposed to shutdown.
-
- exitOk <- newIORef False
+runSessionWithHandles serverIn serverOut serverHandler config caps rootDir exitServer session = do
absRootDir <- canonicalizePath rootDir
let context = SessionContext serverIn absRootDir messageChan reqMap initRsp config caps
initState = SessionState (IdInt 0) mempty mempty 0 False Nothing
- errorHandler ex = do x <- readIORef exitOk
- unless x $ throwTo mainThreadId (ex :: SessionException)
- launchServerHandler = forkIO $ catch (serverHandler serverOut context) errorHandler
- (result, _) <- bracket
- launchServerHandler
- (\tid -> do runSession context initState sendExitMessage
- killThread tid
- atomicWriteIORef exitOk True)
- (const $ runSession context initState session)
+ 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)
return result
updateStateC :: ConduitM FromServerMessage FromServerMessage (StateT SessionState (ReaderT SessionContext IO)) ()
logMsg LogClient msg
liftIO $ B.hPut h (addHeader $ encode msg)
-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'.