1{-# LANGUAGE GeneralizedNewtypeDeriving #-}
2module Test.Hspec.Core.Clock (
3  Seconds(..)
4, toMicroseconds
5, getMonotonicTime
6, measure
7, sleep
8, timeout
9) where
10
11import           Text.Printf
12import           System.Clock
13import           Control.Concurrent
14import qualified System.Timeout as System
15
16newtype Seconds = Seconds Double
17  deriving (Eq, Show, Num, Fractional, PrintfArg)
18
19toMicroseconds :: Seconds -> Int
20toMicroseconds (Seconds s) = floor (s * 1000000)
21
22getMonotonicTime :: IO Seconds
23getMonotonicTime = do
24  t <- getTime Monotonic
25  return $ Seconds ((fromIntegral . toNanoSecs $ t) / 1000000000)
26
27measure :: IO a -> IO (Seconds, a)
28measure action = do
29  t0 <- getMonotonicTime
30  a <- action
31  t1 <- getMonotonicTime
32  return (t1 - t0, a)
33
34sleep :: Seconds -> IO ()
35sleep = threadDelay . toMicroseconds
36
37timeout :: Seconds -> IO a -> IO (Maybe a)
38timeout = System.timeout . toMicroseconds
39