module Music.Theory.Concurrent where

import Control.Concurrent {- base -}

-- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'.
threadDelaySeconds :: RealFrac n => n -> IO ()
threadDelaySeconds :: forall n. RealFrac n => n -> IO ()
threadDelaySeconds = Int -> IO ()
threadDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
(*) n
1e6

{- | The number of seconds that 'threadDelaySeconds' can wait for.
Values larger than this require a different thread delay mechanism, see 'threadSleepForSeconds'.
The value is the number of microseconds in @maxBound::Int@.
For 64-bit architectures this is not likely to be an issue, however for 32-bit it can be.

> round ((2 ** 31) / (60 * 60) / 1e6) == 1 -- hours
> round ((2 ** 63) / (60 * 60 * 24 * 365 * 100) / 1e6) == 2925 -- years
-}
threadDelaySecondsLimit :: Fractional n => n
threadDelaySecondsLimit :: forall n. Fractional n => n
threadDelaySecondsLimit = forall a b. (Integral a, Num b) => a -> b
fromIntegral ((forall a. Bounded a => a
maxBound::Int) forall a. Num a => a -> a -> a
- Int
1) forall a. Fractional a => a -> a -> a
/ n
1e6

-- | Sleep current thread for the indicated duration (in seconds).
--   Divides long sleeps into parts smaller than 'threadSleepForSeconds'.
threadSleepForSeconds :: RealFrac n => n -> IO ()
threadSleepForSeconds :: forall n. RealFrac n => n -> IO ()
threadSleepForSeconds n
n =
    if n
n forall a. Ord a => a -> a -> Bool
< forall n. Fractional n => n
threadDelaySecondsLimit
    then forall n. RealFrac n => n -> IO ()
threadDelaySeconds n
n
    else forall n. RealFrac n => n -> IO ()
threadDelaySeconds (forall n. Fractional n => n
threadDelaySecondsLimit :: Double) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall n. RealFrac n => n -> IO ()
threadSleepForSeconds (n
n forall a. Num a => a -> a -> a
- forall n. Fractional n => n
threadDelaySecondsLimit)