{-# LANGUAGE DeriveLift #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

{-|
Copyright   : (c) Ryota Kameoka, 2018
License     : BSD-3
Maintainer  : kameoka.ryota@gmail.com
Stability   : experimental

This module exports internally used type classes and data types.
You can extend this package's functionality by utilizing them.
-}

module Data.Time.Clock.Duration.Types
    (
    -- * Type classes
      AbsoluteDuration (..)
    , RelativeDuration (..)
    -- * Data types
    , 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)

-- $setup
-- >>> :set -XQuasiQuotes
-- >>> import Data.Time.Clock.Duration.QQ

-- | The 'AbsoluteDuration' class provides how to convert the given 'Time' into a specific unit of time.
-- An instance should represent a quantity with
-- <https://en.wikipedia.org/wiki/Time_in_physics the dimension of T>.
--
-- 42 seconds in 'DiffTime' (seconds):
--
-- >>> [t| 42s |] :: DiffTime
-- 42s
--
-- 42 seconds in 'CUSeconds' (microseconds):
--
-- >>> [t| 42s |] :: CUSeconds
-- 42000000
class AbsoluteDuration a where
    toAbsoluteDuration :: Time -> a

instance AbsoluteDuration DiffTime where
    toAbsoluteDuration :: Time -> DiffTime
toAbsoluteDuration = Integer -> DiffTime
picosecondsToDiffTime (Integer -> DiffTime) -> (Time -> Integer) -> Time -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Integer) -> (Time -> Rational) -> Time -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
inPsScale (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

instance AbsoluteDuration NominalDiffTime where
    toAbsoluteDuration :: Time -> NominalDiffTime
toAbsoluteDuration = DiffTime -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime -> NominalDiffTime)
-> (Time -> DiffTime) -> Time -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbsoluteDuration DiffTime => Time -> DiffTime
forall a. AbsoluteDuration a => Time -> a
toAbsoluteDuration @DiffTime

-- | /Caution:/ the fractional part will be rounded.
instance AbsoluteDuration CUSeconds where
    toAbsoluteDuration :: Time -> CUSeconds
toAbsoluteDuration = Word32 -> CUSeconds
CUSeconds (Word32 -> CUSeconds) -> (Time -> Word32) -> Time -> CUSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Word32
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Word32) -> (Time -> Rational) -> Time -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
inµsScale (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance AbsoluteDuration CSUSeconds where
    toAbsoluteDuration :: Time -> CSUSeconds
toAbsoluteDuration = Int64 -> CSUSeconds
CSUSeconds (Int64 -> CSUSeconds) -> (Time -> Int64) -> Time -> CSUSeconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int64) -> (Time -> Rational) -> Time -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Rational
inµsScale (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | The 'RelativeDuration' class represents how to calculate how long the given 'Time' is when
-- measured in a specific unit of time.
-- An instance should represent a quantity with
-- <https://en.wikipedia.org/wiki/Dimensionless_quantity the dimension of 1>.
--
-- 42 minutes in seconds:
--
-- >>> [s| 42m |] :: Int
-- 2520
--
-- 3 seconds in microseconds:
--
-- >>> [µs| 3s |] :: Int
-- 3000000
class RelativeDuration a where
    toRelativeDuration :: HasResolution r => Proxy r -> Time -> a

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Int where
    toRelativeDuration :: Proxy r -> Time -> Int
toRelativeDuration Proxy r
proxy = Rational -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int) -> (Time -> Rational) -> Time -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Int8 where
    toRelativeDuration :: Proxy r -> Time -> Int8
toRelativeDuration Proxy r
proxy = Rational -> Int8
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int8) -> (Time -> Rational) -> Time -> Int8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Int16 where
    toRelativeDuration :: Proxy r -> Time -> Int16
toRelativeDuration Proxy r
proxy = Rational -> Int16
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int16) -> (Time -> Rational) -> Time -> Int16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Int32 where
    toRelativeDuration :: Proxy r -> Time -> Int32
toRelativeDuration Proxy r
proxy = Rational -> Int32
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int32) -> (Time -> Rational) -> Time -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Int64 where
    toRelativeDuration :: Proxy r -> Time -> Int64
toRelativeDuration Proxy r
proxy = Rational -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Int64) -> (Time -> Rational) -> Time -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance RelativeDuration Integer where
    toRelativeDuration :: Proxy r -> Time -> Integer
toRelativeDuration Proxy r
proxy = Rational -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Rational -> Integer) -> (Time -> Rational) -> Time -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | /Caution:/ the fractional part will be rounded.
instance HasResolution a => RelativeDuration (Fixed a) where
    toRelativeDuration :: Proxy r -> Time -> Fixed a
toRelativeDuration Proxy r
proxy = Rational -> Fixed a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Fixed a) -> (Time -> Rational) -> Time -> Fixed a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

instance Integral a => RelativeDuration (Ratio a) where
    toRelativeDuration :: Proxy r -> Time -> Ratio a
toRelativeDuration Proxy r
proxy = Rational -> Ratio a
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Ratio a) -> (Time -> Rational) -> Time -> Ratio a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

instance RelativeDuration Float where
    toRelativeDuration :: Proxy r -> Time -> Float
toRelativeDuration Proxy r
proxy = Rational -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Float) -> (Time -> Rational) -> Time -> Float
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

instance RelativeDuration Double where
    toRelativeDuration :: Proxy r -> Time -> Double
toRelativeDuration Proxy r
proxy = Rational -> Double
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational -> Double) -> (Time -> Rational) -> Time -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy r -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale Proxy r
proxy (Rational -> Rational) -> (Time -> Rational) -> Time -> Rational
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Time -> Rational
toSeconds

-- | The parsing result of a string inside a quasiquoter.
data Time
    = Picosec  Rational
    | Nanosec  Rational
    | Microsec Rational
    | Millisec Rational -- ^ Denoted by @ms@, @msec@, @msecs@, @millisecond@, or @milliseconds@
    | Second   Rational -- ^ Denoted by @s@, @sec@, @secs@, @second@, or @seconds@
    | Minute   Rational -- ^ Denoted by @m@, @min@, @mins@, @minute@, or @minutes@
    | Hour     Rational -- ^ Denoted by @h@, @hr@, @hrs@, @hour@, or @hours@
    | Day      Rational -- ^ Denoted by @d@, @day@, or @days@
    | Week     Rational -- ^ Denoted by @w@, @week@, or @weeks@
    | Year     Rational -- ^ Denoted by @y@, @yr@, @yrs@, @year@, or @years@
    deriving (Time -> Q Exp
Time -> Q (TExp Time)
(Time -> Q Exp) -> (Time -> Q (TExp Time)) -> Lift Time
forall t. (t -> Q Exp) -> (t -> Q (TExp t)) -> Lift t
liftTyped :: Time -> Q (TExp Time)
$cliftTyped :: Time -> Q (TExp Time)
lift :: Time -> Q Exp
$clift :: Time -> Q Exp
Lift)

toSeconds :: Time -> Rational
toSeconds :: Time -> Rational
toSeconds (Picosec  Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000000000000
toSeconds (Nanosec  Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000000000
toSeconds (Microsec Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000000
toSeconds (Millisec Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000
toSeconds (Second   Rational
x) = Rational
x
toSeconds (Minute   Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60
toSeconds (Hour     Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60
toSeconds (Day      Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
24
toSeconds (Week     Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
24 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
7
toSeconds (Year     Rational
x) = Rational
x Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
60 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
24 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
365

convertScale :: forall r. (HasResolution r) => Proxy r -> Rational -> Rational
convertScale :: Proxy r -> Rational -> Rational
convertScale Proxy r
_ = (Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Integer -> Rational
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Fixed r -> Integer
forall k (a :: k) (p :: k -> *). HasResolution a => p a -> Integer
resolution (Fixed r
0 :: Fixed r)))

inPsScale :: Rational -> Rational
inPsScale :: Rational -> Rational
inPsScale = Proxy E12 -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale (Proxy E12
forall k (t :: k). Proxy t
Proxy :: Proxy E12)

inµsScale :: Rational -> Rational
inµsScale :: Rational -> Rational
inµsScale = Proxy E6 -> Rational -> Rational
forall r. HasResolution r => Proxy r -> Rational -> Rational
convertScale (Proxy E6
forall k (t :: k). Proxy t
Proxy :: Proxy E6)