summaryrefslogtreecommitdiff
path: root/Utility/ThreadScheduler.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/ThreadScheduler.hs')
-rw-r--r--Utility/ThreadScheduler.hs75
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