From 2fd3fde8b28fd5e188090ecd975122d6c3984396 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 11 Nov 2012 13:09:05 -0400 Subject: added a runTimeout function This adds a dep on haskell's async library, but since that's been added to the recent haskell platform release, it should not be much hardship to my poor long-suffering library chasing users. --- Utility/ThreadScheduler.hs | 15 +++++++++++++++ 1 file changed, 15 insertions(+) (limited to 'Utility/ThreadScheduler.hs') diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs index 6557398fd..5e165c9ca 100644 --- a/Utility/ThreadScheduler.hs +++ b/Utility/ThreadScheduler.hs @@ -11,6 +11,8 @@ module Utility.ThreadScheduler where import Common import Control.Concurrent +import Control.Exception +import Control.Concurrent.Async import System.Posix.Terminal import System.Posix.Signals @@ -44,6 +46,19 @@ unboundDelay time = do threadDelay $ fromInteger maxWait when (maxWait /= time) $ unboundDelay (time - maxWait) +{- Runs an action until a timeout is reached. If it fails to complete in + - time, or throws an exception, returns a Left value. + - + - Note that if the action runs an unsafe foreign call, the signal to + - cancel it may not arrive until the call returns. -} +runTimeout :: Seconds -> IO a -> IO (Either SomeException a) +runTimeout secs a = do + runner <- async a + controller <- async $ do + threadDelaySeconds secs + cancel runner + cancel controller `after` waitCatch runner + {- Pauses the main thread, letting children run until program termination. -} waitForTermination :: IO () waitForTermination = do -- cgit v1.2.3