summaryrefslogtreecommitdiff
path: root/Utility/ThreadScheduler.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2012-06-13 17:53:19 -0400
committerGravatar Joey Hess <joey@kitenet.net>2012-06-13 17:53:19 -0400
commit36d73b00171aa26bf5379be7dbd66611834a0459 (patch)
treeef0f37d5623a0a6ae4bd3eb859c21ee572e129e5 /Utility/ThreadScheduler.hs
parent24370fa3ac4fcb5c1d2a8e727fb4730f0d2d9789 (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.hs42
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)