packages feed

time-manager 0.5.1 → 0.5.2

raw patch · 6 files changed

+90/−35 lines, 6 files

Files

ChangeLog.md view
@@ -1,5 +1,16 @@ # ChangeLog for time-manager +## 0.5.2++* A timeout now fires on Windows under the old I/O manager, which is+  still the default there. The timer was `GHC.Event.Windows`, WinIO's+  own, so nothing ran the action unless the program used WinIO: warp+  timed no connection out, and neither did anything else on top.+  [#1139](https://github.com/yesodweb/wai/issues/1139)+* `tickle` extends a timeout by microseconds on Windows as it does+  everywhere else.  It floored the value to a whole second there, which+  meant a timeout under a second was never extended at all.+ ## 0.5.1  * A renewed timeout compared nanoseconds with microseconds, so a timeout
System/TimeManager.hs view
@@ -3,7 +3,9 @@ {-# LANGUAGE RecordWildCards #-}  -- | Timeout manager. Since @v0.3.0@, timeout manager is a wrapper of--- GHC System TimerManager.+-- GHC System TimerManager, except on Windows, where it has a timer of+-- its own: the one in @GHC.Event.Windows@ belongs to WinIO and never+-- runs under the I\/O manager which is still the default there. -- -- Some caveats of using this package: --@@ -59,7 +61,7 @@ import System.TimeManager.Internal  #if defined(mingw32_HOST_OS)-import qualified GHC.Event.Windows as EV+import qualified System.TimeManager.Windows as EV #else import qualified GHC.Event as EV #endif@@ -97,13 +99,6 @@ -- --   Setting the timeout to zero or lower @(<= 0)@ will produce a --   `defaultManager`.------   __WARNING for Windows users:__ /the precision of extending timeouts/---   /is only full "seconds". The provided microseconds will be floored/---   /to the first full second. (i.e. @initialize 2_500_000@ will get/---   /extended by 2 seconds on a 'tickle')/---   /This also means timeouts of less than one second will not be extended/---   /when using 'tickle'./ initialize :: Int -> IO Manager initialize = pure . Manager . max 0 @@ -363,12 +358,6 @@ -- -- Careful: this does NOT reactivate an already 'pause'd 'Handle'! ----- __WARNING for Windows users:__ /the precision of extending timeouts/--- /is only full "seconds". The provided microseconds will be floored/--- /to the first full second. (i.e. @initialize 2_500_000@ will get/--- /extended by 2 seconds on a 'tickle')/--- /This also means timeouts of less than one second will not be extended/--- /when using 'tickle'./ tickle :: Handle -> IO () tickle h@Handle{..} =     withNonEmptyHandle h $@@ -378,15 +367,8 @@                 now <- getMonotonicTimeNSec                 I.atomicWriteIORef handleLastRenewed now   where-    -- For some reason the Windows implementation of 'updateTimeout' wants-    -- full seconds, instead of the microseconds that's used when registering...     updateTheTimeout key =-        EV.updateTimeout handleTimerManager key-#if defined(mingw32_HOST_OS)-            (fromIntegral (handleTimeout `div` 1_000_000))-#else-            handleTimeout-#endif+        EV.updateTimeout handleTimerManager key handleTimeout  -- | Pauses the timeout so you can 'resume' it later. Does not stop it entirely. -- Use 'cancel' if you want to make sure the action will not be resumed.
System/TimeManager/Internal.hs view
@@ -10,7 +10,7 @@ import Data.Word (Word64)  #if defined(mingw32_HOST_OS)-import qualified GHC.Event.Windows as EV+import qualified System.TimeManager.Windows as EV #else import qualified GHC.Event as EV #endif
+ System/TimeManager/Windows.hs view
@@ -0,0 +1,64 @@+{-# LANGUAGE NumericUnderscores #-}++-- | A timer for Windows which does not depend on the I\/O manager.+--+--   @GHC.Event.Windows@ is WinIO's manager, so a timeout registered with+--   it is never run when the program uses the old Windows I\/O manager,+--   which is still the default.  This does the same job with one thread+--   and 'threadDelay' per timeout, which both managers drive.+module System.TimeManager.Windows (+    Manager,+    TimeoutKey,+    getSystemManager,+    registerTimeout,+    unregisterTimeout,+    updateTimeout,+) where++import Control.Concurrent (ThreadId, forkIO, killThread, threadDelay)+import Data.IORef (IORef, newIORef, readIORef, writeIORef)+import Data.Word (Word64)+import GHC.Clock (getMonotonicTimeNSec)++-- | There is nothing to keep: each timeout is its own thread.+data Manager = Manager++getSystemManager :: IO Manager+getSystemManager = pure Manager++-- | A registered timeout.  The deadline is read by the thread rather+--   than captured, so that 'updateTimeout' does not have to replace it.+data TimeoutKey = TimeoutKey (IORef Word64) ThreadId++instance Eq TimeoutKey where+    TimeoutKey _ t1 == TimeoutKey _ t2 = t1 == t2++-- | Run the action once the given number of microseconds has passed.+registerTimeout :: Manager -> Int -> IO () -> IO TimeoutKey+registerTimeout _ us action = do+    ref <- newIORef =<< deadlineIn us+    tid <- forkIO $ wait ref+    pure $ TimeoutKey ref tid+  where+    wait ref = do+        deadline <- readIORef ref+        now <- getMonotonicTimeNSec+        if now >= deadline+            then action+            else do+                -- Round up, so that a deadline under a microsecond away+                -- is still waited for rather than busy looped on.+                threadDelay $ fromIntegral ((deadline - now + 999) `div` 1_000)+                wait ref++-- | Move the deadline the given number of microseconds into the future.+updateTimeout :: Manager -> TimeoutKey -> Int -> IO ()+updateTimeout _ (TimeoutKey ref _) us = writeIORef ref =<< deadlineIn us++unregisterTimeout :: Manager -> TimeoutKey -> IO ()+unregisterTimeout _ (TimeoutKey _ tid) = killThread tid++deadlineIn :: Int -> IO Word64+deadlineIn us = do+    now <- getMonotonicTimeNSec+    pure $ now + fromIntegral (max 0 us) * 1_000
test/Spec.hs view
@@ -9,19 +9,11 @@ import Test.Hspec  #if defined(mingw32_HOST_OS)--- -- Uncomment when reenabling the tests for Windows--- import qualified GHC.Event.Windows as EV+import qualified System.TimeManager.Windows as EV #else import qualified GHC.Event as EV #endif -#if defined(mingw32_HOST_OS)-main :: IO ()-main = hspec $ do-    describe "TimeManager" $ do-        it "tests don't work on windows" $-            pendingWith "requires more testing on a Windows machine"-#else import Control.Concurrent (     MVar,     forkIO,@@ -386,4 +378,3 @@ oldResume Handle{..} = do     key <- EV.registerTimeout handleTimerManager handleTimeout handleAction     I.writeIORef handleState $ Active key-#endif
time-manager.cabal view
@@ -1,6 +1,6 @@ cabal-version:      >=1.10 name:               time-manager-version:            0.5.1+version:            0.5.2 license:            MIT license-file:       LICENSE maintainer:         kazu@iij.ad.jp@@ -25,6 +25,9 @@     other-modules:         System.TimeManager.Internal +    if os(windows)+        other-modules: System.TimeManager.Windows+     default-language:   Haskell2010     default-extensions: Strict StrictData     ghc-options:        -Wall@@ -40,6 +43,10 @@         System.ThreadManager,         System.TimeManager,         System.TimeManager.Internal++    if os(windows)+        other-modules: System.TimeManager.Windows+     build-depends:    base     default-language: Haskell2010     ghc-options:      -Wall -threaded