{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Snap.Internal.Http.Server.Clock
  ( ClockTime
  , getClockTime
  , sleepFor
  , sleepSecs
  , fromSecs
  , toSecs
  ) where

import           Control.Concurrent (threadDelay)
import qualified System.Clock       as Clock

type ClockTime = Clock.TimeSpec

------------------------------------------------------------------------------
sleepFor :: ClockTime -> IO ()
sleepFor :: ClockTime -> IO ()
sleepFor ClockTime
t = Int -> IO ()
threadDelay (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d
  where
    d :: Int64
d  = (ClockTime -> Int64
Clock.nsec ClockTime
t Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
1000000 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* ClockTime -> Int64
Clock.sec ClockTime
t)


------------------------------------------------------------------------------
sleepSecs :: Double -> IO ()
sleepSecs :: Double -> IO ()
sleepSecs = ClockTime -> IO ()
sleepFor (ClockTime -> IO ()) -> (Double -> ClockTime) -> Double -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> ClockTime
fromSecs


------------------------------------------------------------------------------
getClockTime :: IO ClockTime
getClockTime :: IO ClockTime
getClockTime = Clock -> IO ClockTime
Clock.getTime Clock
Clock.Monotonic


------------------------------------------------------------------------------
fromSecs :: Double -> ClockTime
fromSecs :: Double -> ClockTime
fromSecs Double
d = let (Int64
s, Double
r) = Double -> (Int64, Double)
forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction Double
d
             in Int64 -> Int64 -> ClockTime
Clock.TimeSpec Int64
s (Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Int64) -> Double -> Int64
forall a b. (a -> b) -> a -> b
$! Double
1000000000 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
r)


------------------------------------------------------------------------------
toSecs :: ClockTime -> Double
toSecs :: ClockTime -> Double
toSecs ClockTime
t = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ClockTime -> Int64
Clock.sec ClockTime
t) Double -> Double -> Double
forall a. Num a => a -> a -> a
+
           Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ClockTime -> Int64
Clock.nsec ClockTime
t) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000000000.0