module Scheduler.Main ( MainScheduler
, getMainScheduler
, runMainScheduler
) where
import Control.Concurrent
import Control.Concurrent.STM
import Data.IORef
import Scheduler
import Scheduler.Internal
import System.IO.Unsafe
newtype MainScheduler = MainScheduler (TQueue (ScheduledAction MainScheduler))
instance Scheduler MainScheduler where
schedule (MainScheduler q) action = do
(sa, d) <- newScheduledAction action
atomically $ writeTQueue q sa
return d
schedulerMain s@(MainScheduler q) = do
sa <- atomically $ readTQueue q
executeScheduledAction s sa
mainSchedulerRef :: IORef MainScheduler
mainSchedulerRef =
unsafePerformIO $ do
q <- atomically newTQueue
newIORef $ MainScheduler q
getMainScheduler :: IO MainScheduler
getMainScheduler = readIORef mainSchedulerRef
runMainScheduler :: IO ()
runMainScheduler =
let run = getMainScheduler >>= schedulerMain
in if rtsSupportsBoundThreads
then runInBoundThread run
else run