1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
|
{-# 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 time | time <= 0 =
-- When time is a big negative integer, casting it to Int may overflow.
-- So we handle it as a special case here.
return ()
delay time = do
let maxWait = min time $ toInteger (maxBound :: Int)
threadDelay $ fromInteger maxWait
when (maxWait /= time) $ delay (time - maxWait)
|
