{-# 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
(Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool) -> Eq Seconds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Seconds -> Seconds -> Bool
== :: Seconds -> Seconds -> Bool
$c/= :: Seconds -> Seconds -> Bool
/= :: Seconds -> Seconds -> Bool
Eq, Int -> Seconds -> ShowS
[Seconds] -> ShowS
Seconds -> String
(Int -> Seconds -> ShowS)
-> (Seconds -> String) -> ([Seconds] -> ShowS) -> Show Seconds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Seconds -> ShowS
showsPrec :: Int -> Seconds -> ShowS
$cshow :: Seconds -> String
show :: Seconds -> String
$cshowList :: [Seconds] -> ShowS
showList :: [Seconds] -> ShowS
Show, Eq Seconds
Eq Seconds =>
(Seconds -> Seconds -> Ordering)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Bool)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> Ord 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
$ccompare :: Seconds -> Seconds -> Ordering
compare :: Seconds -> Seconds -> Ordering
$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
>= :: Seconds -> Seconds -> Bool
$cmax :: Seconds -> Seconds -> Seconds
max :: Seconds -> Seconds -> Seconds
$cmin :: Seconds -> Seconds -> Seconds
min :: Seconds -> Seconds -> Seconds
Ord, Integer -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Integer -> Seconds)
-> Num Seconds
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Seconds -> Seconds -> Seconds
+ :: Seconds -> Seconds -> Seconds
$c- :: Seconds -> Seconds -> Seconds
- :: Seconds -> Seconds -> Seconds
$c* :: Seconds -> Seconds -> Seconds
* :: Seconds -> Seconds -> Seconds
$cnegate :: Seconds -> Seconds
negate :: Seconds -> Seconds
$cabs :: Seconds -> Seconds
abs :: Seconds -> Seconds
$csignum :: Seconds -> Seconds
signum :: Seconds -> Seconds
$cfromInteger :: Integer -> Seconds
fromInteger :: Integer -> Seconds
Num, Num Seconds
Num Seconds =>
(Seconds -> Seconds -> Seconds)
-> (Seconds -> Seconds)
-> (Rational -> Seconds)
-> Fractional Seconds
Rational -> Seconds
Seconds -> Seconds
Seconds -> Seconds -> Seconds
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: Seconds -> Seconds -> Seconds
/ :: Seconds -> Seconds -> Seconds
$crecip :: Seconds -> Seconds
recip :: Seconds -> Seconds
$cfromRational :: Rational -> Seconds
fromRational :: Rational -> Seconds
Fractional, Seconds -> ModifierParser
Seconds -> FieldFormatter
(Seconds -> FieldFormatter)
-> (Seconds -> ModifierParser) -> PrintfArg Seconds
forall a.
(a -> FieldFormatter) -> (a -> ModifierParser) -> PrintfArg a
$cformatArg :: Seconds -> FieldFormatter
formatArg :: Seconds -> FieldFormatter
$cparseFormat :: Seconds -> ModifierParser
parseFormat :: Seconds -> ModifierParser
PrintfArg)

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

toMicroseconds :: Seconds -> Int
toMicroseconds :: Seconds -> Int
toMicroseconds (Seconds Double
s) = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
s Double -> Double -> Double
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 (Double -> Seconds) -> IO Double -> IO 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
  (Seconds, a) -> IO (Seconds, a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Seconds
t1 Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
- Seconds
t0, a
a)

sleep :: Seconds -> IO ()
sleep :: Seconds -> IO ()
sleep = Int -> IO ()
threadDelay (Int -> IO ()) -> (Seconds -> Int) -> Seconds -> IO ()
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 = Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
System.timeout (Int -> IO a -> IO (Maybe a))
-> (Seconds -> Int) -> Seconds -> IO a -> IO (Maybe a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Seconds -> Int
toMicroseconds