-- SPDX-FileCopyrightText: 2019 Serokell <https://serokell.io>
--
-- SPDX-License-Identifier: MPL-2.0

{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE ExplicitForAll             #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | This module introduces 'Timestamp' data type
-- and corresponding functions for operations with time.

module Time.Timestamp
       ( Timestamp (..)
       , fromUnixTime
       , timeDiff
       , timeAdd
       , timeMul
       , (*:*)
       , timeDiv
       , (/:/)

         -- * Other operators
       , (+:+)
       , (-:-)
       , (-%-)

       ) where

import GHC.Prim (coerce)

import Time.Rational (KnownDivRat, KnownRat, Rat, RatioNat)
import Time.Units (Second, Time (..), sec, toUnit)

-- $setup
-- >>> import Time.Units (Minute, Second, minute, ms, sec)

-- | Similar to 'Time' but has no units and can be negative.
newtype Timestamp = Timestamp Rational
    deriving (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> String
$cshow :: Timestamp -> String
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Show, ReadPrec [Timestamp]
ReadPrec Timestamp
Int -> ReadS Timestamp
ReadS [Timestamp]
(Int -> ReadS Timestamp)
-> ReadS [Timestamp]
-> ReadPrec Timestamp
-> ReadPrec [Timestamp]
-> Read Timestamp
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Timestamp]
$creadListPrec :: ReadPrec [Timestamp]
readPrec :: ReadPrec Timestamp
$creadPrec :: ReadPrec Timestamp
readList :: ReadS [Timestamp]
$creadList :: ReadS [Timestamp]
readsPrec :: Int -> ReadS Timestamp
$creadsPrec :: Int -> ReadS Timestamp
Read, Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Eq, Eq Timestamp
Eq Timestamp
-> (Timestamp -> Timestamp -> Ordering)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Timestamp)
-> (Timestamp -> Timestamp -> Timestamp)
-> Ord Timestamp
Timestamp -> Timestamp -> Bool
Timestamp -> Timestamp -> Ordering
Timestamp -> Timestamp -> Timestamp
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 :: Timestamp -> Timestamp -> Timestamp
$cmin :: Timestamp -> Timestamp -> Timestamp
max :: Timestamp -> Timestamp -> Timestamp
$cmax :: Timestamp -> Timestamp -> Timestamp
>= :: Timestamp -> Timestamp -> Bool
$c>= :: Timestamp -> Timestamp -> Bool
> :: Timestamp -> Timestamp -> Bool
$c> :: Timestamp -> Timestamp -> Bool
<= :: Timestamp -> Timestamp -> Bool
$c<= :: Timestamp -> Timestamp -> Bool
< :: Timestamp -> Timestamp -> Bool
$c< :: Timestamp -> Timestamp -> Bool
compare :: Timestamp -> Timestamp -> Ordering
$ccompare :: Timestamp -> Timestamp -> Ordering
$cp1Ord :: Eq Timestamp
Ord)

-- | Converts unix time to 'Timestamp'.
fromUnixTime :: Real a => a -> Timestamp
fromUnixTime :: a -> Timestamp
fromUnixTime = Rational -> Timestamp
Timestamp (Rational -> Timestamp) -> (a -> Rational) -> a -> Timestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rational
forall a. Real a => a -> Rational
toRational

{- | Returns the result of comparison of two 'Timestamp's and
the 'Time' of that difference of given time unit.

>>> timeDiff @Second (Timestamp 4) (Timestamp 2)
(GT,2s)

>>>timeDiff @Minute (Timestamp 4) (Timestamp 2)
(GT,1/30m)

>>> timeDiff @Second (Timestamp 2) (Timestamp 4)
(LT,2s)

>>> timeDiff @Minute (Timestamp 2) (Timestamp 4)
(LT,1/30m)

-}
timeDiff :: forall (unit :: Rat) . KnownDivRat Second unit
         => Timestamp
         -> Timestamp
         -> (Ordering, Time unit)
timeDiff :: Timestamp -> Timestamp -> (Ordering, Time unit)
timeDiff (Timestamp Rational
a) (Timestamp Rational
b) =
    let (Ordering
order, RatioNat
r) = Rational -> Rational -> (Ordering, RatioNat)
ratDiff Rational
a Rational
b
    in (Ordering
order, Time (1 :% 1) -> Time unit
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit (Time (1 :% 1) -> Time unit) -> Time (1 :% 1) -> Time unit
forall a b. (a -> b) -> a -> b
$ RatioNat -> Time Second
sec RatioNat
r)

{- | Returns the result of addition of 'Time' with 'Timestamp' elements.

>>> sec 5 `timeAdd` (Timestamp 4)
Timestamp (9 % 1)

>>> minute 1 `timeAdd` (Timestamp 5)
Timestamp (65 % 1)

-}
timeAdd :: forall (unit :: Rat) . KnownDivRat unit Second
        => Time unit
        -> Timestamp
        -> Timestamp
timeAdd :: Time unit -> Timestamp -> Timestamp
timeAdd Time unit
t (Timestamp Rational
ts) = Rational -> Timestamp
Timestamp (RatioNat -> Rational
forall a. Real a => a -> Rational
toRational (Time (1 :% 1) -> RatioNat
forall (rat :: Rat). Time rat -> RatioNat
unTime (Time (1 :% 1) -> RatioNat) -> Time (1 :% 1) -> RatioNat
forall a b. (a -> b) -> a -> b
$ Time unit -> Time Second
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @Second Time unit
t) Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
+ Rational
ts)

-- | Returns the result of multiplication of two 'Time' elements.
timeMul :: forall (unit :: Rat) . KnownRat unit
        => RatioNat
        -> Time unit
        -> Time unit
timeMul :: RatioNat -> Time unit -> Time unit
timeMul RatioNat
n (Time RatioNat
t) = RatioNat -> Time unit
forall (rat :: Rat). RatioNat -> Time rat
Time (RatioNat
n RatioNat -> RatioNat -> RatioNat
forall a. Num a => a -> a -> a
* RatioNat
t)

{- | Operator version of 'timeMul'.

>>> 3 *:* sec 5
15s

>>> 2 *:* 3 *:* sec 5
30s

>>> 3 *:* 5 *:* sec 7
105s

>>> ms 2000 +:+ 2 *:* sec 3
8s

-}
infixr 7 *:*
(*:*) :: forall (unit :: Rat) . KnownRat unit
      => RatioNat -> Time unit -> Time unit
*:* :: RatioNat -> Time unit -> Time unit
(*:*) = RatioNat -> Time unit -> Time unit
forall (unit :: Rat).
KnownRat unit =>
RatioNat -> Time unit -> Time unit
timeMul

-- | Returns the result of division of two 'Time' elements.
timeDiv :: forall (unit :: Rat) . KnownRat unit
        => Time unit
        -> Time unit
        -> RatioNat
timeDiv :: Time unit -> Time unit -> RatioNat
timeDiv (Time RatioNat
t1) (Time RatioNat
t2) = RatioNat
t1 RatioNat -> RatioNat -> RatioNat
forall a. Fractional a => a -> a -> a
/ RatioNat
t2

{- | Operator version of 'timeDiv'.

>>> sec 15 /:/ sec 3
5 % 1

-}
infix 7 /:/
(/:/) :: forall (unit :: Rat) . KnownRat unit
      => Time unit -> Time unit -> RatioNat
/:/ :: Time unit -> Time unit -> RatioNat
(/:/) = Time unit -> Time unit -> RatioNat
forall (unit :: Rat).
KnownRat unit =>
Time unit -> Time unit -> RatioNat
timeDiv

-- | Sums times of different units.
--
-- >>> minute 1 +:+ sec 1
-- 61s
--
infixl 6 +:+
(+:+) :: forall (unitResult :: Rat) (unitLeft :: Rat) . KnownDivRat unitLeft unitResult
      => Time unitLeft
      -> Time unitResult
      -> Time unitResult
Time unitLeft
t1 +:+ :: Time unitLeft -> Time unitResult -> Time unitResult
+:+ Time unitResult
t2 = (RatioNat -> RatioNat -> RatioNat)
-> Time unitResult -> Time unitResult -> Time unitResult
coerce (RatioNat -> RatioNat -> RatioNat
forall a. Num a => a -> a -> a
(+) :: RatioNat -> RatioNat -> RatioNat) (Time unitLeft -> Time unitResult
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unitResult Time unitLeft
t1) Time unitResult
t2
{-# INLINE (+:+) #-}

-- | Substracts time amounts of different units. When the minuend is smaller
-- than the subtrahend, this function will throw @Underflow :: ArithException@.
--
-- >>> minute 1 -:- sec 1
-- 59s
--
infixl 6 -:-
(-:-) :: forall (unitResult :: Rat) (unitLeft :: Rat) . KnownDivRat unitLeft unitResult
      => Time unitLeft
      -> Time unitResult
      -> Time unitResult
Time unitLeft
t1 -:- :: Time unitLeft -> Time unitResult -> Time unitResult
-:- Time unitResult
t2 = (RatioNat -> RatioNat -> RatioNat)
-> Time unitResult -> Time unitResult -> Time unitResult
coerce ((-) :: RatioNat -> RatioNat -> RatioNat) (Time unitLeft -> Time unitResult
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unitResult Time unitLeft
t1) Time unitResult
t2
{-# INLINE (-:-) #-}

{- | Compute the difference between two amounts of time. The result is returned
in two components: the ordering (which input is larger) and the numeric
difference (how much larger). Unlike '-:-', does not throw @ArithException@.

>>> sec 5 -%- sec 3
(GT,2s)

>>> sec 5 -%- sec 6
(LT,1s)

-}
infix 6 -%-
(-%-) :: forall (unitResult :: Rat) (unitLeft :: Rat) . KnownDivRat unitLeft unitResult
      => Time unitLeft
      -> Time unitResult
      -> (Ordering, Time unitResult)
Time unitLeft
t1 -%- :: Time unitLeft -> Time unitResult -> (Ordering, Time unitResult)
-%- (Time RatioNat
t2Rat) =
    let (Time RatioNat
t1Rat) = Time unitLeft -> Time unitResult
forall (unitTo :: Rat) (unitFrom :: Rat).
KnownDivRat unitFrom unitTo =>
Time unitFrom -> Time unitTo
toUnit @unitResult Time unitLeft
t1
        (Ordering
order, RatioNat
rat) = Rational -> Rational -> (Ordering, RatioNat)
ratDiff (RatioNat -> Rational
forall a. Real a => a -> Rational
toRational RatioNat
t1Rat) (RatioNat -> Rational
forall a. Real a => a -> Rational
toRational RatioNat
t2Rat)
    in (Ordering
order, RatioNat -> Time unitResult
forall (rat :: Rat). RatioNat -> Time rat
Time RatioNat
rat)

ratDiff :: Rational -> Rational -> (Ordering, RatioNat)
ratDiff :: Rational -> Rational -> (Ordering, RatioNat)
ratDiff Rational
r1 Rational
r2 =
    let order :: Ordering
order = Rational -> Rational -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rational
r1 Rational
r2
        diff :: RatioNat
diff  = Rational -> RatioNat
forall a. Fractional a => Rational -> a
fromRational (Rational -> RatioNat) -> Rational -> RatioNat
forall a b. (a -> b) -> a -> b
$ case Ordering
order of
                     Ordering
LT -> Rational
r2 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r1
                     Ordering
GT -> Rational
r1 Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
- Rational
r2
                     Ordering
EQ -> Rational
0
    in (Ordering
order, RatioNat
diff)