diff options
author | Joey Hess <joey@kitenet.net> | 2012-06-13 17:53:19 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2012-06-13 17:53:19 -0400 |
commit | 36d73b00171aa26bf5379be7dbd66611834a0459 (patch) | |
tree | ef0f37d5623a0a6ae4bd3eb859c21ee572e129e5 /Utility/ThreadScheduler.hs | |
parent | 24370fa3ac4fcb5c1d2a8e727fb4730f0d2d9789 (diff) |
slightly higher-level thread scheduling code
Including support for unbound thread sleeping. Haskell's max thread sleep
is 37 minutes, due to maxBound Int!
Diffstat (limited to 'Utility/ThreadScheduler.hs')
-rw-r--r-- | Utility/ThreadScheduler.hs | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs new file mode 100644 index 000000000..9204cd9b9 --- /dev/null +++ b/Utility/ThreadScheduler.hs @@ -0,0 +1,42 @@ +{- thread scheduling + - + - Copyright 2012 Joey Hess <joey@kitenet.net> + - Copyright 2011 Bas van Dijk & Roel van Dijk + - + - Licensed under the GNU GPL version 3 or higher. + -} + +module Utility.ThreadScheduler where + +import Common +import Control.Concurrent + +newtype Seconds = Seconds { fromSeconds :: Int } + deriving (Eq, Ord, Show) + +{- Runs an action repeatedly forever, sleeping at least the specified number + - of seconds in between. -} +runEvery :: Seconds -> IO a -> IO a +runEvery n a = forever $ do + threadDelaySeconds n + a + +threadDelaySeconds :: Seconds -> IO () +threadDelaySeconds (Seconds n) = unboundDelay (fromIntegral n * oneSecond) + where + oneSecond = 1000000 -- microseconds + +{- Like threadDelay, but not bounded by an Int. + - + - There is no guarantee that the thread will be rescheduled promptly when the + - delay has expired, but the thread will never continue to run earlier than + - specified. + - + - Taken from the unbounded-delay package to avoid a dependency for 4 lines + - of code. + -} +unboundDelay :: Integer -> IO () +unboundDelay time = do + let maxWait = min time $ toInteger (maxBound :: Int) + threadDelay $ fromInteger maxWait + when (maxWait /= time) $ unboundDelay (time - maxWait) |