diff options
| author | Joey Hess <joey@kitenet.net> | 2014-05-14 19:41:05 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-05-14 19:41:05 -0400 |
| commit | 7115d1ec162b4059b3e8e8f84bd8d5898c1db025 (patch) | |
| tree | 42c1cce54e890e1d56484794ab33129132d8fee2 /Utility/ThreadScheduler.hs | |
| parent | ffe371a9d42cded461236e972a24a142419d7fc4 (diff) | |
moved source code to src
This is to work around OSX's brain-damange regarding filename case
insensitivity.
Avoided moving config.hs, because it's a config file. Put in a symlink to
make build work.
Diffstat (limited to 'Utility/ThreadScheduler.hs')
| -rw-r--r-- | Utility/ThreadScheduler.hs | 75 |
1 files changed, 0 insertions, 75 deletions
diff --git a/Utility/ThreadScheduler.hs b/Utility/ThreadScheduler.hs deleted file mode 100644 index fc026d7e..00000000 --- a/Utility/ThreadScheduler.hs +++ /dev/null @@ -1,75 +0,0 @@ -{- thread scheduling - - - - Copyright 2012, 2013 Joey Hess <joey@kitenet.net> - - Copyright 2011 Bas van Dijk & Roel van Dijk - - - - License: BSD-2-clause - -} - -{-# LANGUAGE CPP #-} - -module Utility.ThreadScheduler where - -import Control.Monad -import Control.Concurrent -#ifndef mingw32_HOST_OS -import Control.Monad.IfElse -import System.Posix.IO -#endif -#ifndef mingw32_HOST_OS -import System.Posix.Signals -#ifndef __ANDROID__ -import System.Posix.Terminal -#endif -#endif - -newtype Seconds = Seconds { fromSeconds :: Int } - deriving (Eq, Ord, Show) - -type Microseconds = Integer - -{- 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) - -{- 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 :: Microseconds -> IO () -unboundDelay time = do - let maxWait = min time $ toInteger (maxBound :: Int) - threadDelay $ fromInteger maxWait - when (maxWait /= time) $ unboundDelay (time - maxWait) - -{- Pauses the main thread, letting children run until program termination. -} -waitForTermination :: IO () -waitForTermination = do -#ifdef mingw32_HOST_OS - runEvery (Seconds 600) $ - void getLine -#else - lock <- newEmptyMVar - let check sig = void $ - installHandler sig (CatchOnce $ putMVar lock ()) Nothing - check softwareTermination -#ifndef __ANDROID__ - whenM (queryTerminal stdInput) $ - check keyboardSignal -#endif - takeMVar lock -#endif - -oneSecond :: Microseconds -oneSecond = 1000000 |
