time-manager 0.1.2 → 0.1.3

raw patch · 3 files changed

+65/−33 lines, 3 files

Files

• ChangeLog.md +4/−0
• System/TimeManager.hs +60/−32
• time-manager.cabal +1/−1

@@ -1,5 +1,9 @@ # ChangeLog for time-manager +## 0.1.3++* Providing `withHandle` and `withHandleKillThread`.+ ## 0.1.2  * Holding `Weak ThreadId` to prevent thread leak again

@@ -14,21 +14,25 @@     withManager,     withManager', -    -- ** Registration-    register,-    registerKillThread,+    -- ** Registering a timeout action+    withHandle,+    withHandleKillThread,      -- ** Control     tickle,-    cancel,     pause,     resume, +    -- ** Low level+    register,+    registerKillThread,+    cancel,+     -- ** Exceptions     TimeoutThread (..), ) where -import Control.Concurrent (myThreadId, mkWeakThreadId)+import Control.Concurrent (mkWeakThreadId, myThreadId) import qualified Control.Exception as E import Control.Reaper import Data.IORef (IORef)@@ -96,6 +100,22 @@  ---------------------------------------------------------------- +-- | Registering a timeout action and unregister its handle+--   when the body action is finished.+withHandle :: Manager -> TimeoutAction -> (Handle -> IO a) -> IO a+withHandle mgr onTimeout action =+    E.bracket (register mgr onTimeout) cancel action++-- | Registering a timeout action of killing this thread and+--   unregister its handle when the body action is killed or finished.+withHandleKillThread :: Manager -> TimeoutAction -> (Handle -> IO ()) -> IO ()+withHandleKillThread mgr onTimeout action =+    E.handle handler $ E.bracket (registerKillThread mgr onTimeout) cancel action+  where+    handler TimeoutThread = return ()++----------------------------------------------------------------+ -- | Registering a timeout action. register :: Manager -> TimeoutAction -> IO Handle register mgr !onTimeout = do@@ -105,48 +125,56 @@     reaperAdd mgr h     return h --- | Registering a timeout action of killing this thread.-registerKillThread :: Manager -> TimeoutAction -> IO Handle-registerKillThread m onTimeout = do-    tid <- myThreadId-    wtid <- mkWeakThreadId tid-    -- First run the timeout action in case the child thread is masked.-    register m $ onTimeout `E.finally` do-        mtid <- deRefWeak wtid-        case mtid of-          Nothing -> return ()-          Just tid' -> E.throwTo tid' TimeoutThread+-- | Removing the 'Handle' from the 'Manager' immediately.+cancel :: Handle -> IO ()+cancel (Handle mgr _ stateRef) = do+    _ <- reaperModify mgr filt+    return ()+  where+    -- It's very important that this function forces the whole workload so we+    -- don't retain old handles, otherwise disasterous leaks occur.+    filt [] = []+    filt (h@(Handle _ _ stateRef') : hs)+        | stateRef == stateRef' = hs+        | otherwise =+            let !hs' = filt hs+             in h : hs' +----------------------------------------------------------------++-- | The asynchronous exception thrown if a thread is registered via+-- 'registerKillThread'. data TimeoutThread = TimeoutThread     deriving (Typeable)+ instance E.Exception TimeoutThread where     toException = E.asyncExceptionToException     fromException = E.asyncExceptionFromException instance Show TimeoutThread where     show TimeoutThread = "Thread killed by timeout manager" +-- | Registering a timeout action of killing this thread.+--   'TimeoutThread' is thrown to the thread which called this+--   function on timeout. Catch 'TimeoutThread' if you don't+--   want to leak the asynchronous exception to GHC RTS.+registerKillThread :: Manager -> TimeoutAction -> IO Handle+registerKillThread m onTimeout = do+    tid <- myThreadId+    wtid <- mkWeakThreadId tid+    -- First run the timeout action in case the child thread is masked.+    register m $+        onTimeout `E.finally` do+            mtid <- deRefWeak wtid+            case mtid of+                Nothing -> return ()+                Just tid' -> E.throwTo tid' TimeoutThread+ ----------------------------------------------------------------  -- | Setting the state to active. --   'Manager' turns active to inactive repeatedly. tickle :: Handle -> IO () tickle (Handle _ _ stateRef) = I.writeIORef stateRef Active---- | Removing the 'Handle' from the 'Manager' immediately.-cancel :: Handle -> IO ()-cancel (Handle mgr _ stateRef) = do-    _ <- reaperModify mgr filt-    return ()-  where-    -- It's very important that this function forces the whole workload so we-    -- don't retain old handles, otherwise disasterous leaks occur.-    filt [] = []-    filt (h@(Handle _ _ stateRef') : hs)-        | stateRef == stateRef' =-            hs-        | otherwise =-            let !hs' = filt hs-             in h : hs'  -- | Setting the state to paused. --   'Manager' does not change the value.

@@ -1,5 +1,5 @@ Name:                time-manager-Version:             0.1.2+Version:             0.1.3 Synopsis:            Scalable timer License:             MIT License-file:        LICENSE