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

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

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

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

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
s1CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+CTime
s2) (Int32
u1Int32 -> 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
s1CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
-CTime
s2) (Int32
u1Int32 -> 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
s1CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
*CTime
s2) (Int32
u1Int32 -> 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
s1CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
-CTime
s2) (Int32
u1Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
-Int32
u2)

-- | Adding difference to 'UnixTime'.
--
-- >>> UnixTime 100 2000 `addUnixDiffTime` microSecondsToUnixDiffTime (-1003000)
-- 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
s1CTime -> CTime -> CTime
forall a. Num a => a -> a -> a
+CTime
s2) (Int32
u1Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+Int32
u2)

-- | Creating difference from seconds.
--
-- >>> secondsToUnixDiffTime 100
-- UnixDiffTime {udtSeconds = 100, udtMicroSeconds = 0}

secondsToUnixDiffTime :: (Integral a) => a -> UnixDiffTime
secondsToUnixDiffTime :: 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
-- UnixDiffTime {udtSeconds = 12, udtMicroSeconds = 345678}
--
-- >>> microSecondsToUnixDiffTime (-12345678)
-- UnixDiffTime {udtSeconds = -12, udtMicroSeconds = -345678}

microSecondsToUnixDiffTime :: (Integral a) => a -> UnixDiffTime
microSecondsToUnixDiffTime :: 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 :: 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 :: 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 #-}