{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
module Data.Time.Clock.Duration.Types
(
AbsoluteDuration (..)
, RelativeDuration (..)
, Time (..)
) where
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Fixed (E6, E12, Fixed, HasResolution (resolution))
import Data.Proxy (Proxy (Proxy))
import Data.Ratio (Ratio)
import Data.Time.Clock (DiffTime, NominalDiffTime, picosecondsToDiffTime)
import Foreign.C.Types (CSUSeconds (CSUSeconds), CUSeconds (CUSeconds))
import Language.Haskell.TH.Syntax (Lift)
class AbsoluteDuration a where
toAbsoluteDuration :: Time -> a
instance AbsoluteDuration DiffTime where
toAbsoluteDuration = picosecondsToDiffTime . round . inPsScale . toSeconds
instance AbsoluteDuration NominalDiffTime where
toAbsoluteDuration = realToFrac . toAbsoluteDuration @DiffTime
instance AbsoluteDuration CUSeconds where
toAbsoluteDuration = CUSeconds . round . inµsScale . toSeconds
instance AbsoluteDuration CSUSeconds where
toAbsoluteDuration = CSUSeconds . round . inµsScale . toSeconds
class RelativeDuration a where
toRelativeDuration :: HasResolution r => Proxy r -> Time -> a
instance RelativeDuration Int where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance RelativeDuration Int8 where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance RelativeDuration Int16 where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance RelativeDuration Int32 where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance RelativeDuration Int64 where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance RelativeDuration Integer where
toRelativeDuration proxy = round . convertScale proxy . toSeconds
instance HasResolution a => RelativeDuration (Fixed a) where
toRelativeDuration proxy = realToFrac . convertScale proxy . toSeconds
instance Integral a => RelativeDuration (Ratio a) where
toRelativeDuration proxy = realToFrac . convertScale proxy . toSeconds
instance RelativeDuration Float where
toRelativeDuration proxy = realToFrac . convertScale proxy . toSeconds
instance RelativeDuration Double where
toRelativeDuration proxy = realToFrac . convertScale proxy . toSeconds
data Time
= Picosec Rational
| Nanosec Rational
| Microsec Rational
| Millisec Rational
| Second Rational
| Minute Rational
| Hour Rational
| Day Rational
| Week Rational
| Year Rational
deriving (Lift)
toSeconds :: Time -> Rational
toSeconds (Picosec x) = x / 1000000000000
toSeconds (Nanosec x) = x / 1000000000
toSeconds (Microsec x) = x / 1000000
toSeconds (Millisec x) = x / 1000
toSeconds (Second x) = x
toSeconds (Minute x) = x * 60
toSeconds (Hour x) = x * 60 * 60
toSeconds (Day x) = x * 60 * 60 * 24
toSeconds (Week x) = x * 60 * 60 * 24 * 7
toSeconds (Year x) = x * 60 * 60 * 24 * 365
convertScale :: forall r. (HasResolution r) => Proxy r -> Rational -> Rational
convertScale _ = (* fromIntegral (resolution (0 :: Fixed r)))
inPsScale :: Rational -> Rational
inPsScale = convertScale (Proxy :: Proxy E12)
inµsScale :: Rational -> Rational
inµsScale = convertScale (Proxy :: Proxy E6)