{-# LANGUAGE CPP, NoImplicitPrelude #-}

#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#endif

-- | Arbitrarily long thread delays.
module Control.Concurrent.Thread.Delay ( delay ) where


-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

-- from base:
import Control.Concurrent ( threadDelay )
import Control.Monad      ( when, return )
import Data.Eq            ( (/=) )
import Data.Function      ( ($) )
import Data.Int           ( Int )
import Data.Ord           ( min, (<=) )
import Prelude            ( Integer, toInteger, fromInteger, maxBound, (-) )
import System.IO          ( IO )

#if __GLASGOW_HASKELL__ < 700
import Control.Monad      ( (>>) )
#endif


-------------------------------------------------------------------------------
-- Delay
-------------------------------------------------------------------------------

{-|
Like @Control.Concurrent.'threadDelay'@, but not bounded by an 'Int'.

Suspends the current thread for a given number of microseconds (GHC only).

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.
-}
delay :: Integer -> IO ()
delay :: Integer -> IO ()
delay Integer
time | Integer
time Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
0 =
  -- When time is a big negative integer, casting it to Int may overflow.
  -- So we handle it as a special case here.
  () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
delay Integer
time = do
  let maxWait :: Integer
maxWait = Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
time (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int)
  Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
maxWait
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
maxWait Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
time) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> IO ()
delay (Integer
time Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
maxWait)