Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 4530e68c00
Fetching contributors…

Cannot retrieve contributors at this time

file 57 lines (49 sloc) 1.619 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57
{- 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
import System.Posix.Terminal
import System.Posix.Signals

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)

{- Pauses the main thread, letting children run until program termination. -}
waitForTermination :: IO ()
waitForTermination = do
lock <- newEmptyMVar
check softwareTermination lock
whenM (queryTerminal stdInput) $
check keyboardSignal lock
takeMVar lock
where
check sig lock = void $
installHandler sig (CatchOnce $ putMVar lock ()) Nothing
Something went wrong with that request. Please try again.