{-# 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
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
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
Eq Seconds
-> (Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord 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
$cp1Ord :: Eq Seconds
Ord, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
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 :: Seconds -> IO a -> IO a
runEvery Seconds
n IO a
a = IO a -> IO a
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO a -> IO a) -> IO a -> IO a
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) = Microseconds -> IO ()
unboundDelay (Int -> Microseconds
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n Microseconds -> Microseconds -> Microseconds
forall a. Num a => a -> a -> a
* Microseconds
oneSecond)
unboundDelay :: Microseconds -> IO ()
unboundDelay :: Microseconds -> IO ()
unboundDelay Microseconds
time = do
let maxWait :: Microseconds
maxWait = Microseconds -> Microseconds -> Microseconds
forall a. Ord a => a -> a -> a
min Microseconds
time (Microseconds -> Microseconds) -> Microseconds -> Microseconds
forall a b. (a -> b) -> a -> b
$ Int -> Microseconds
forall a. Integral a => a -> Microseconds
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Microseconds -> Int
forall a. Num a => Microseconds -> a
fromInteger Microseconds
maxWait
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Microseconds
maxWait Microseconds -> Microseconds -> Bool
forall a. Eq a => a -> a -> Bool
/= Microseconds
time) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Microseconds -> IO ()
unboundDelay (Microseconds
time Microseconds -> Microseconds -> Microseconds
forall a. Num a => a -> a -> a
- Microseconds
maxWait)
waitForTermination :: IO ()
waitForTermination :: IO ()
waitForTermination = do
#ifdef mingw32_HOST_OS
forever $ threadDelaySeconds (Seconds 6000)
#else
MVar ()
lock <- IO (MVar ())
forall a. IO (MVar a)
newEmptyMVar
let check :: Signal -> IO ()
check Signal
sig = IO Handler -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Handler -> IO ()) -> IO Handler -> IO ()
forall a b. (a -> b) -> a -> b
$
Signal -> Handler -> Maybe SignalSet -> IO Handler
installHandler Signal
sig (IO () -> Handler
CatchOnce (IO () -> Handler) -> IO () -> Handler
forall a b. (a -> b) -> a -> b
$ MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
lock ()) Maybe SignalSet
forall a. Maybe a
Nothing
Signal -> IO ()
check Signal
softwareTermination
IO Bool -> IO () -> IO ()
forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM (Fd -> IO Bool
queryTerminal Fd
stdInput) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
Signal -> IO ()
check Signal
keyboardSignal
MVar () -> IO ()
forall a. MVar a -> IO a
takeMVar MVar ()
lock
#endif
oneSecond :: Microseconds
oneSecond :: Microseconds
oneSecond = Microseconds
1000000