time-manager 0.2.1 → 0.2.2

raw patch · 3 files changed

+45/−17 lines, 3 files

Files

• ChangeLog.md +6/−0
• System/TimeManager.hs +38/−16
• time-manager.cabal +1/−1

@@ -1,5 +1,11 @@ # ChangeLog for time-manager +## 0.2.2++* `initialize` with non positive integer creates a time manager+  which does not maintain timeout.+  [#1017](https://github.com/yesodweb/wai/pull/1017)+ ## 0.2.1  * Export KilledByThreadManager exception

@@ -35,16 +35,18 @@  import Control.Concurrent (mkWeakThreadId, myThreadId) import qualified Control.Exception as E+import Control.Monad (void) import Control.Reaper import Data.IORef (IORef) import qualified Data.IORef as I import Data.Typeable (Typeable)+import System.IO.Unsafe import System.Mem.Weak (deRefWeak)  ----------------------------------------------------------------  -- | A timeout manager-type Manager = Reaper [Handle] Handle+data Manager = Manager (Reaper [Handle] Handle) | NoManager  -- | An action to be performed on timeout. type TimeoutAction = IO ()@@ -56,6 +58,20 @@     , handleStateRef :: IORef State     } +emptyAction :: IORef TimeoutAction+emptyAction = unsafePerformIO $ I.newIORef (return ())++emptyState :: IORef State+emptyState = unsafePerformIO $ I.newIORef Inactive++emptyHandle :: Handle+emptyHandle =+    Handle+        { handleManager = NoManager+        , handleActionRef = emptyAction+        , handleStateRef = emptyState+        }+ data State     = Active -- Manager turns it to Inactive.     | Inactive -- Manager removes it with timeout action.@@ -66,15 +82,18 @@ -- | Creating timeout manager which works every N micro seconds --   where N is the first argument. initialize :: Int -> IO Manager+initialize timeout+    | timeout <= 0 = return NoManager initialize timeout =-    mkReaper-        defaultReaperSettings-            { -- Data.Set cannot be used since 'partition' cannot be used-              -- with 'readIORef`. So, let's just use a list.-              reaperAction = mkListAction prune-            , reaperDelay = timeout-            , reaperThreadName = "WAI timeout manager (Reaper)"-            }+    Manager+        <$> mkReaper+            defaultReaperSettings+                { -- Data.Set cannot be used since 'partition' cannot be used+                  -- with 'readIORef`. So, let's just use a list.+                  reaperAction = mkListAction prune+                , reaperDelay = timeout+                , reaperThreadName = "WAI timeout manager (Reaper)"+                }   where     prune m@Handle{..} = do         state <- I.atomicModifyIORef' handleStateRef (\x -> (inactivate x, x))@@ -92,7 +111,8 @@  -- | Stopping timeout manager with onTimeout fired. stopManager :: Manager -> IO ()-stopManager mgr = E.mask_ (reaperStop mgr >>= mapM_ fire)+stopManager NoManager = return ()+stopManager (Manager mgr) = E.mask_ (reaperStop mgr >>= mapM_ fire)   where     fire Handle{..} = do         onTimeout <- I.readIORef handleActionRef@@ -100,7 +120,8 @@  -- | Killing timeout manager immediately without firing onTimeout. killManager :: Manager -> IO ()-killManager = reaperKill+killManager NoManager = return ()+killManager (Manager mgr) = reaperKill mgr  ---------------------------------------------------------------- @@ -126,12 +147,13 @@  -- | Registering a timeout action. register :: Manager -> TimeoutAction -> IO Handle-register mgr !onTimeout = do+register NoManager _ = return emptyHandle+register m@(Manager mgr) !onTimeout = do     actionRef <- I.newIORef onTimeout     stateRef <- I.newIORef Active     let h =             Handle-                { handleManager = mgr+                { handleManager = m                 , handleActionRef = actionRef                 , handleStateRef = stateRef                 }@@ -140,9 +162,9 @@  -- | Removing the 'Handle' from the 'Manager' immediately. cancel :: Handle -> IO ()-cancel Handle{..} = do-    _ <- reaperModify handleManager filt-    return ()+cancel Handle{..} = case handleManager of+    NoManager -> return ()+    Manager mgr -> void $ reaperModify mgr filt   where     -- It's very important that this function forces the whole workload so we     -- don't retain old handles, otherwise disasterous leaks occur.

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