diff --git a/src/Quasar/Timer/PosixTimer.hsc b/src/Quasar/Timer/PosixTimer.hsc index 9a669ba870da38bcc7b1b856be0ab1c93bdbc98f..e04e780dea2e1855402197554a047444050fc3fa 100644 --- a/src/Quasar/Timer/PosixTimer.hsc +++ b/src/Quasar/Timer/PosixTimer.hsc @@ -9,7 +9,6 @@ module Quasar.Timer.PosixTimer ( CITimerSpec(..), defaultCITimerSpec, newPosixTimer, - newUnmanagedPosixTimer, setPosixTimer, setPosixIntervalTimer, ) where @@ -19,9 +18,9 @@ import Control.Monad.Catch (MonadMask) import Control.Monad.STM (atomically) import Foreign import Foreign.C -import Quasar.Disposable import Quasar.Prelude -import Quasar.ResourceManager +import Quasar.Monad +import Quasar.Resources import System.Posix.Types #include <signal.h> @@ -159,31 +158,30 @@ toCSetTimeFlags TimeAbsolute = c_TIMER_ABSTIME data PosixTimer = PosixTimer { ctimer :: CTimer, - disposable :: Disposable + disposer :: Disposer } -instance IsDisposable PosixTimer where - toDisposable = disposable +instance Resource PosixTimer where + getDisposer = disposer -newPosixTimer :: (MonadResourceManager m, MonadIO m) => ClockId -> IO () -> m PosixTimer -newPosixTimer clockId callback = registerNewResource do - liftIO $ newUnmanagedPosixTimer clockId callback +newPosixTimer :: (MonadQuasar m, MonadIO m) => ClockId -> IO () -> m PosixTimer +newPosixTimer clockId callback = do + (callbackPtr, ctimer) <- liftIO $ runInBoundThread do + callbackPtr <- mkSigevNotifyFunction (const callback) -newUnmanagedPosixTimer :: ClockId -> IO () -> IO PosixTimer -newUnmanagedPosixTimer clockId callback = runInBoundThread do - callbackPtr <- mkSigevNotifyFunction (const callback) + ctimer <- alloca \ctimerPtr -> do + alloca \sigevent -> do + poke sigevent $ CSigEventThreadCallback callbackPtr + throwErrnoIfMinus1_ "timer_create" do + c_timer_create (toCClockId clockId) sigevent ctimerPtr + peek ctimerPtr - ctimer <- alloca \ctimerPtr -> do - alloca \sigevent -> do - poke sigevent $ CSigEventThreadCallback callbackPtr - throwErrnoIfMinus1_ "timer_create" do - c_timer_create (toCClockId clockId) sigevent ctimerPtr - peek ctimerPtr + pure (callbackPtr, ctimer) - disposable <- atomically $ newDisposable (delete ctimer callbackPtr) + disposer <- registerDisposeAction (delete ctimer callbackPtr) - pure $ PosixTimer { ctimer, disposable } + pure $ PosixTimer { ctimer, disposer } where delete :: CTimer -> FunPtr SigevNotifyFunction -> IO () delete ctimer callbackPtr = do diff --git a/src/Quasar/Timer/TimerFd.hs b/src/Quasar/Timer/TimerFd.hs index 8ea9dd78b512b1eb38c32aab175b24789b1a64ce..9e939767e4df3d86711c89d46b7505e19d3dcd38 100644 --- a/src/Quasar/Timer/TimerFd.hs +++ b/src/Quasar/Timer/TimerFd.hs @@ -47,7 +47,7 @@ newTimerFd clockId callback = mask_ do c_timerfd_create (toCClockId clockId) c_TFD_CLOEXEC workerTask <- async $ liftIO $ worker timer - registerDisposeAction do + registerDisposeAction_ do await $ isDisposed workerTask timerFdClose timer