{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.UnixTime.Diff (
    diffUnixTime,
    addUnixDiffTime,
    secondsToUnixDiffTime,
    microSecondsToUnixDiffTime,
) where

import Data.Int
import Data.UnixTime.Types
import Foreign.C.Types

-- $setup
-- >>> :set -XOverloadedStrings

----------------------------------------------------------------

calc :: CTime -> Int32 -> UnixDiffTime
calc :: CTime -> Int32 -> UnixDiffTime
calc CTime
sec Int32
usec = (CTime -> Int32 -> UnixDiffTime) -> (CTime, Int32) -> UnixDiffTime
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CTime -> Int32 -> UnixDiffTime
UnixDiffTime ((CTime, Int32) -> UnixDiffTime)
-> (Int32 -> (CTime, Int32)) -> Int32 -> UnixDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTime -> Int32 -> (CTime, Int32)
adjust CTime
sec (Int32 -> UnixDiffTime) -> Int32 -> UnixDiffTime
forall a b. (a -> b) -> a -> b
$ Int32
usec

calc' :: CTime -> Int32 -> UnixDiffTime
calc' :: CTime -> Int32 -> UnixDiffTime
calc' CTime
sec Int32
usec = (CTime -> Int32 -> UnixDiffTime) -> (CTime, Int32) -> UnixDiffTime
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CTime -> Int32 -> UnixDiffTime
UnixDiffTime ((CTime, Int32) -> UnixDiffTime)
-> (Int32 -> (CTime, Int32)) -> Int32 -> UnixDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTime -> Int32 -> (CTime, Int32)
slowAdjust CTime
sec (Int32 -> UnixDiffTime) -> Int32 -> UnixDiffTime
forall a b. (a -> b) -> a -> b
$ Int32
usec

calcU :: CTime -> Int32 -> UnixTime
calcU :: CTime -> Int32 -> UnixTime
calcU CTime
sec Int32
usec = (CTime -> Int32 -> UnixTime) -> (CTime, Int32) -> UnixTime
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry CTime -> Int32 -> UnixTime
UnixTime ((CTime, Int32) -> UnixTime)
-> (Int32 -> (CTime, Int32)) -> Int32 -> UnixTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CTime -> Int32 -> (CTime, Int32)
adjust CTime
sec (Int32 -> UnixTime) -> Int32 -> UnixTime
forall a b. (a -> b) -> a -> b
$ Int32
usec

-- | Arithmetic operations where (1::UnixDiffTime) means 1 second.
--
-- >>> (3 :: UnixDiffTime) + 2
-- UnixDiffTime {udtSeconds = 5, udtMicroSeconds = 0}
-- >>> (2 :: UnixDiffTime) - 5
-- UnixDiffTime {udtSeconds = -3, udtMicroSeconds = 0}
-- >>> (3 :: UnixDiffTime) * 2
-- UnixDiffTime {udtSeconds = 6, udtMicroSeconds = 0}
instance Num UnixDiffTime where
    UnixDiffTime CTime
s1 Int32
u1 + :: UnixDiffTime -> UnixDiffTime -> UnixDiffTime
+ UnixDiffTime CTime
s2 Int32
u2 = CTime -> Int32 -> UnixDiffTime
calc (CTime
s1 CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+ CTime
s2) (Int32
u1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
u2)
    UnixDiffTime CTime
s1 Int32
u1 - :: UnixDiffTime -> UnixDiffTime -> UnixDiffTime
- UnixDiffTime CTime
s2 Int32
u2 = CTime -> Int32 -> UnixDiffTime
calc (CTime
s1 CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
- CTime
s2) (Int32
u1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
u2)
    UnixDiffTime CTime
s1 Int32
u1 * :: UnixDiffTime -> UnixDiffTime -> UnixDiffTime
* UnixDiffTime CTime
s2 Int32
u2 = CTime -> Int32 -> UnixDiffTime
calc' (CTime
s1 CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
* CTime
s2) (Int32
u1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
u2)
    negate :: UnixDiffTime -> UnixDiffTime
negate (UnixDiffTime CTime
s Int32
u) = CTime -> Int32 -> UnixDiffTime
UnixDiffTime (-CTime
s) (-Int32
u)
    abs :: UnixDiffTime -> UnixDiffTime
abs (UnixDiffTime CTime
s Int32
u) = CTime -> Int32 -> UnixDiffTime
UnixDiffTime (CTime -> CTime
forall a. Num a => a -> a
abs CTime
s) (Int32 -> Int32
forall a. Num a => a -> a
abs Int32
u)
    signum :: UnixDiffTime -> UnixDiffTime
signum (UnixDiffTime CTime
s Int32
u)
        | CTime
s CTime -> CTime -> Bool
forall a. Eq a => a -> a -> Bool
== CTime
0 Bool -> Bool -> Bool
&& Int32
u Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0 = UnixDiffTime
0
        | CTime
s CTime -> CTime -> Bool
forall a. Ord a => a -> a -> Bool
> CTime
0 = UnixDiffTime
1
        | Bool
otherwise = -UnixDiffTime
1
    fromInteger :: Integer -> UnixDiffTime
fromInteger Integer
i = CTime -> Int32 -> UnixDiffTime
UnixDiffTime (Integer -> CTime
forall a. Num a => Integer -> a
fromInteger Integer
i) Int32
0

{-# RULES "Integral->UnixDiffTime" fromIntegral = secondsToUnixDiffTime #-}

instance Real UnixDiffTime where
    toRational :: UnixDiffTime -> Rational
toRational = UnixDiffTime -> Rational
forall a. Fractional a => UnixDiffTime -> a
toFractional

{-# RULES "UnixDiffTime->Fractional" realToFrac = toFractional #-}

----------------------------------------------------------------

-- | Calculating difference between two 'UnixTime'.
--
-- >>> UnixTime 100 2000 `diffUnixTime` UnixTime 98 2100
-- UnixDiffTime {udtSeconds = 1, udtMicroSeconds = 999900}
diffUnixTime :: UnixTime -> UnixTime -> UnixDiffTime
diffUnixTime :: UnixTime -> UnixTime -> UnixDiffTime
diffUnixTime (UnixTime CTime
s1 Int32
u1) (UnixTime CTime
s2 Int32
u2) = CTime -> Int32 -> UnixDiffTime
calc (CTime
s1 CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
- CTime
s2) (Int32
u1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
u2)

-- | Adding difference to 'UnixTime'.
--
-- >>> UnixTime 100 2000 `addUnixDiffTime` microSecondsToUnixDiffTime ((-1003000) :: Int)
-- UnixTime {utSeconds = 98, utMicroSeconds = 999000}
addUnixDiffTime :: UnixTime -> UnixDiffTime -> UnixTime
addUnixDiffTime :: UnixTime -> UnixDiffTime -> UnixTime
addUnixDiffTime (UnixTime CTime
s1 Int32
u1) (UnixDiffTime CTime
s2 Int32
u2) = CTime -> Int32 -> UnixTime
calcU (CTime
s1 CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+ CTime
s2) (Int32
u1 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
u2)

-- | Creating difference from seconds.
--
-- >>> secondsToUnixDiffTime (100 :: Int)
-- UnixDiffTime {udtSeconds = 100, udtMicroSeconds = 0}
secondsToUnixDiffTime :: Integral a => a -> UnixDiffTime
secondsToUnixDiffTime :: forall a. Integral a => a -> UnixDiffTime
secondsToUnixDiffTime a
sec = CTime -> Int32 -> UnixDiffTime
UnixDiffTime (a -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
sec) Int32
0
{-# INLINE secondsToUnixDiffTime #-}

-- | Creating difference from micro seconds.
--
-- >>> microSecondsToUnixDiffTime (12345678 :: Int)
-- UnixDiffTime {udtSeconds = 12, udtMicroSeconds = 345678}
--
-- >>> microSecondsToUnixDiffTime ((-12345678) :: Int)
-- UnixDiffTime {udtSeconds = -12, udtMicroSeconds = -345678}
microSecondsToUnixDiffTime :: Integral a => a -> UnixDiffTime
microSecondsToUnixDiffTime :: forall a. Integral a => a -> UnixDiffTime
microSecondsToUnixDiffTime a
usec = CTime -> Int32 -> UnixDiffTime
calc (a -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
s) (a -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
u)
  where
    (a
s, a
u) = a -> (a, a)
forall a. Integral a => a -> (a, a)
secondMicro a
usec
{-# INLINE microSecondsToUnixDiffTime #-}

----------------------------------------------------------------

adjust :: CTime -> Int32 -> (CTime, Int32)
adjust :: CTime -> Int32 -> (CTime, Int32)
adjust CTime
sec Int32
usec
    | CTime
sec CTime -> CTime -> Bool
forall a. Ord a => a -> a -> Bool
>= CTime
0 = (CTime, Int32)
ajp
    | Bool
otherwise = (CTime, Int32)
ajm
  where
    micro :: Int32
micro = Int32
1000000
    mmicro :: Int32
mmicro = -Int32
micro
    ajp :: (CTime, Int32)
ajp
        | Int32
usec Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
micro = (CTime
sec CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+ CTime
1, Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
micro)
        | Int32
usec Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0 = (CTime
sec, Int32
usec)
        | Bool
otherwise = (CTime
sec CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
- CTime
1, Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
micro)
    ajm :: (CTime, Int32)
ajm
        | Int32
usec Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
mmicro = (CTime
sec CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
- CTime
1, Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
micro)
        | Int32
usec Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Int32
0 = (CTime
sec, Int32
usec)
        | Bool
otherwise = (CTime
sec CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+ CTime
1, Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
micro)

slowAdjust :: CTime -> Int32 -> (CTime, Int32)
slowAdjust :: CTime -> Int32 -> (CTime, Int32)
slowAdjust CTime
sec Int32
usec = (CTime
sec CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+ Int32 -> CTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
s, Int32
usec Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
u)
  where
    (Int32
s, Int32
u) = Int32 -> (Int32, Int32)
forall a. Integral a => a -> (a, a)
secondMicro Int32
usec

secondMicro :: Integral a => a -> (a, a)
secondMicro :: forall a. Integral a => a -> (a, a)
secondMicro a
usec = a
usec a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
`quotRem` a
1000000

toFractional :: Fractional a => UnixDiffTime -> a
toFractional :: forall a. Fractional a => UnixDiffTime -> a
toFractional (UnixDiffTime CTime
s Int32
u) = CTime -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac CTime
s a -> a -> a
forall a. Num a => a -> a -> a
+ Int32 -> a
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int32
u a -> a -> a
forall a. Fractional a => a -> a -> a
/ a
1000000
{-# SPECIALIZE toFractional :: UnixDiffTime -> Double #-}