{-# LANGUAGE NoImplicitPrelude #-}
module Imj.Threading
(
runAndWaitForTermination
, Termination(..)
, setupCapabilities
) where
import Imj.Prelude
import qualified Prelude
import GHC.Conc(getNumProcessors)
import Control.Concurrent( forkFinally
, MVar
, newEmptyMVar
, putMVar
, readMVar
, setNumCapabilities )
import Control.Exception( SomeException(..) )
import Control.Monad( (>=>) )
data Termination = NormalTermination
| AbnormalTermination
runAndWaitForTermination :: IO () -> IO Termination
runAndWaitForTermination io = do
gameThreadTerminated <- myForkIO io
readMVar gameThreadTerminated
setupCapabilities :: IO ()
setupCapabilities = do
nproc <- getNumProcessors
let ncap = max 1 $ quot nproc 2
setNumCapabilities ncap
myForkIO :: IO () -> IO (MVar Termination)
myForkIO io = do
mvar <- newEmptyMVar
_ <- forkFinally io (handleTerminationCause >=> putMVar mvar)
return mvar
handleTerminationCause :: Either SomeException a -> IO Termination
handleTerminationCause (Left e) = do
Prelude.putStrLn ("From game thread:\n" ++ show e)
return AbnormalTermination
handleTerminationCause _ = return NormalTermination