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.
This commit is contained in:
parent
2172cc586e
commit
b312e54ba7
4 changed files with 18 additions and 1 deletions
|
@ -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
|
||||
|
|
1
debian/control
vendored
1
debian/control
vendored
|
@ -42,6 +42,7 @@ Build-Depends:
|
|||
libghc-network-protocol-xmpp-dev (>= 0.4.3-2),
|
||||
libghc-gnutls-dev (>= 0.1.4),
|
||||
libghc-xml-types-dev,
|
||||
libghc-async-dev,
|
||||
ikiwiki,
|
||||
perlmagick,
|
||||
git,
|
||||
|
|
|
@ -19,6 +19,7 @@ quite a lot.
|
|||
* [edit-distance](http://hackage.haskell.org/package/edit-distance)
|
||||
* [hS3](http://hackage.haskell.org/package/hS3) (optional)
|
||||
* [SafeSemaphore](http://hackage.haskell.org/package/SafeSemaphore)
|
||||
* [async](http://hackage.haskell.org/package/async)
|
||||
* Optional haskell stuff, used by the [[assistant]] and its webapp (edit Makefile to disable)
|
||||
* [stm](http://hackage.haskell.org/package/stm)
|
||||
(version 2.3 or newer)
|
||||
|
|
|
@ -57,7 +57,7 @@ Executable git-annex
|
|||
pcre-light, extensible-exceptions, dataenc, SHA, process, json, HTTP,
|
||||
base (>= 4.5 && < 4.7), monad-control, transformers-base, lifted-base,
|
||||
IfElse, text, QuickCheck >= 2.1, bloomfilter, edit-distance, process,
|
||||
SafeSemaphore
|
||||
SafeSemaphore, async
|
||||
-- Need to list these because they're generated from .hsc files.
|
||||
Other-Modules: Utility.Touch Utility.Mounts
|
||||
Include-Dirs: Utility
|
||||
|
|
Loading…
Add table
Reference in a new issue