{-# 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
import System.Posix.Terminal
#endif
newtype Seconds = Seconds { Seconds -> Int
fromSeconds :: Int }
deriving (Seconds -> Seconds -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c== :: Seconds -> Seconds -> Bool
Eq, Eq Seconds
Seconds -> Seconds -> Bool
Seconds -> Seconds -> Ordering
Seconds -> Seconds -> Seconds
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmax :: Seconds -> Seconds -> Seconds
>= :: Seconds -> Seconds -> Bool
$c>= :: Seconds -> Seconds -> Bool
> :: Seconds -> Seconds -> Bool
$c> :: Seconds -> Seconds -> Bool
<= :: Seconds -> Seconds -> Bool
$c<= :: Seconds -> Seconds -> Bool
< :: Seconds -> Seconds -> Bool
$c< :: Seconds -> Seconds -> Bool
compare :: Seconds -> Seconds -> Ordering
$ccompare :: Seconds -> Seconds -> Ordering
Ord, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Seconds] -> ShowS
$cshowList :: [Seconds] -> ShowS
show :: Seconds -> String
$cshow :: Seconds -> String
showsPrec :: Int -> Seconds -> ShowS
$cshowsPrec :: Int -> Seconds -> ShowS
Show)
type Microseconds = Integer
runEvery :: Seconds -> IO a -> IO a
runEvery :: forall a. Seconds -> IO a -> IO a
runEvery Seconds
n IO a
a = forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ do
Seconds -> IO ()
threadDelaySeconds Seconds
n
IO a
a
threadDelaySeconds :: Seconds -> IO ()
threadDelaySeconds :: Seconds -> IO ()
threadDelaySeconds (Seconds Int
n) = Integer -> IO ()
unboundDelay (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n forall a. Num a => a -> a -> a
* Integer
oneSecond)
unboundDelay :: Microseconds -> IO ()
unboundDelay :: Integer -> IO ()
unboundDelay Integer
time = do
let maxWait :: Integer
maxWait = forall a. Ord a => a -> a -> a
min Integer
time forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int)
Int -> IO ()
threadDelay forall a b. (a -> b) -> a -> b
$ forall a. Num a => Integer -> a
fromInteger Integer
maxWait
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
maxWait forall a. Eq a => a -> a -> Bool
/= Integer
time) forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
unboundDelay (Integer
time forall a. Num a => a -> a -> a
- Integer
maxWait)
waitForTermination :: IO ()
waitForTermination :: IO ()
waitForTermination = do
#ifdef mingw32_HOST_OS
forever $ threadDelaySeconds (Seconds 6000)
#else
MVar ()
lock <- forall a. IO (MVar a)
newEmptyMVar
let check :: Signal -> IO ()
check Signal
sig = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sig (IO () -> Handler
CatchOnce forall a b. (a -> b) -> a -> b
$ forall a. MVar a -> a -> IO ()
putMVar MVar ()
lock ()) forall a. Maybe a
Nothing
Signal -> IO ()
check Signal
softwareTermination
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Fd -> IO Bool
queryTerminal Fd
stdInput) forall a b. (a -> b) -> a -> b
$
Signal -> IO ()
check Signal
keyboardSignal
forall a. MVar a -> IO a
takeMVar MVar ()
lock
#endif
oneSecond :: Microseconds
oneSecond :: Integer
oneSecond = Integer
1000000