{-# LANGUAGE TemplateHaskell #-}
module Network.Legion.Fork (
forkC
) where
import Control.Concurrent (forkIO)
import Control.Exception (SomeException, try)
import Control.Monad (void)
import Control.Monad.Logger (logError, askLoggerIO, runLoggingT)
import Control.Monad.Trans.Class (lift)
import Data.Text (pack)
import Network.Legion.LIO (LIO)
import System.Exit (ExitCode(ExitFailure))
import System.IO (hPutStrLn, stderr)
import System.Posix.Process (exitImmediately)
forkC
:: String
-> LIO ()
-> LIO ()
forkC name io = do
logging <- askLoggerIO
lift . void . forkIO $ do
result <- try (runLoggingT io logging)
case result of
Left err -> do
let msg =
"Exception caught in critical thread " ++ show name
++ ". We are crashing the entire program because we can't "
++ "continue without this thread. The error was: "
++ show (err :: SomeException)
(`runLoggingT` logging) . $(logError) . pack $ msg
putStrLn msg
hPutStrLn stderr msg
exitImmediately (ExitFailure 1)
Right v -> return v