{-# LANGUAGE NoImplicitPrelude #-}

module GHC.Event.Windows.Thread (
    ensureIOManagerIsRunning,
    interruptIOManager,
    threadDelay,
    registerDelay,
) where

import GHC.Conc.Sync
import GHC.Base
import GHC.Event.Windows
import GHC.IO
import GHC.IOPort

ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning :: IO ()
ensureIOManagerIsRunning = IO ()
wakeupIOManager

interruptIOManager :: IO ()
interruptIOManager :: IO ()
interruptIOManager = IO ()
interruptSystemManager

-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
-- 2147483647 μs, less than 36 minutes.
threadDelay :: Int -> IO ()
threadDelay :: Int -> IO ()
threadDelay Int
usecs = IO () -> IO ()
forall a. IO a -> IO a
mask_ (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    IOPort ()
m <- IO (IOPort ())
forall a. IO (IOPort a)
newEmptyIOPort
    Manager
mgr <- IO Manager
getSystemManager
    TimeoutKey
reg <- Manager -> Int -> IO () -> IO TimeoutKey
registerTimeout Manager
mgr Int
usecs (IO () -> IO TimeoutKey) -> IO () -> IO TimeoutKey
forall a b. (a -> b) -> a -> b
$ IOPort () -> () -> IO Bool
forall a. IOPort a -> a -> IO Bool
writeIOPort IOPort ()
m () IO Bool -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    IOPort () -> IO ()
forall a. IOPort a -> IO a
readIOPort IOPort ()
m IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`onException` Manager -> TimeoutKey -> IO ()
unregisterTimeout Manager
mgr TimeoutKey
reg

-- | Be careful not to exceed @maxBound :: Int@, which on 32-bit machines is only
-- 2147483647 μs, less than 36 minutes.
registerDelay :: Int -> IO (TVar Bool)
registerDelay :: Int -> IO (TVar Bool)
registerDelay Int
usecs = do
    TVar Bool
t <- Bool -> IO (TVar Bool)
forall a. a -> IO (TVar a)
newTVarIO Bool
False
    Manager
mgr <- IO Manager
getSystemManager
    TimeoutKey
_ <- Manager -> Int -> IO () -> IO TimeoutKey
registerTimeout Manager
mgr Int
usecs (IO () -> IO TimeoutKey) -> IO () -> IO TimeoutKey
forall a b. (a -> b) -> a -> b
$ STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar Bool -> Bool -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar Bool
t Bool
True
    TVar Bool -> IO (TVar Bool)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TVar Bool
t