{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE CPP #-}
module Test.Hspec.Core.Clock (
  Seconds(..)
, toMilliseconds
, toMicroseconds
, getMonotonicTime
, measure
, sleep
, timeout
) where

import           Prelude ()
import           Test.Hspec.Core.Compat

import           Text.Printf
import           Control.Concurrent
import qualified System.Timeout as System

#if MIN_VERSION_base(4,11,0)
import qualified GHC.Clock as GHC
#else
import           Data.Time.Clock.POSIX
#endif

newtype Seconds = Seconds Double
  deriving (Seconds -> Seconds -> Bool
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, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
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, Eq 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
Ord, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Seconds
$cfromInteger :: Integer -> Seconds
signum :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
abs :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cnegate :: Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c+ :: Seconds -> Seconds -> Seconds
Num, Num Seconds
Rational -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
Num a
-> (a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
fromRational :: Rational -> Seconds
$cfromRational :: Rational -> Seconds
recip :: Seconds -> Seconds
$crecip :: Seconds -> Seconds
/ :: Seconds -> Seconds -> Seconds
$c/ :: Seconds -> Seconds -> Seconds
Fractional, Seconds -> ModifierParser
Seconds -> FieldFormatter
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
parseFormat :: Seconds -> ModifierParser
$cparseFormat :: Seconds -> ModifierParser
formatArg :: Seconds -> FieldFormatter
$cformatArg :: Seconds -> FieldFormatter
PrintfArg)

toMilliseconds :: Seconds -> Int
toMilliseconds :: Seconds -> Int
toMilliseconds (Seconds Double
s) = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
s forall a. Num a => a -> a -> a
* Double
1000)

toMicroseconds :: Seconds -> Int
toMicroseconds :: Seconds -> Int
toMicroseconds (Seconds Double
s) = forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
s forall a. Num a => a -> a -> a
* Double
1000000)

getMonotonicTime :: IO Seconds
#if MIN_VERSION_base(4,11,0)
getMonotonicTime :: IO Seconds
getMonotonicTime = Double -> Seconds
Seconds forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Double
GHC.getMonotonicTime
#else
getMonotonicTime = do
  t <- getPOSIXTime
  return $ Seconds (realToFrac t)
#endif

measure :: IO a -> IO (Seconds, a)
measure :: forall a. IO a -> IO (Seconds, a)
measure IO a
action = do
  Seconds
t0 <- IO Seconds
getMonotonicTime
  a
a <- IO a
action
  Seconds
t1 <- IO Seconds
getMonotonicTime
  forall (m :: * -> *) a. Monad m => a -> m a
return (Seconds
t1 forall a. Num a => a -> a -> a
- Seconds
t0, a
a)

sleep :: Seconds -> IO ()
sleep :: Seconds -> IO ()
sleep = Int -> IO ()
threadDelay forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Int
toMicroseconds

timeout :: Seconds -> IO a -> IO (Maybe a)
timeout :: forall a. Seconds -> IO a -> IO (Maybe a)
timeout = forall a. Int -> IO a -> IO (Maybe a)
System.timeout forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Int
toMicroseconds