{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif

{-| Types and functions for
<http://en.wikipedia.org/wiki/Coordinated_Universal_Time UTC> and
<http://en.wikipedia.org/wiki/Universal_Time#Versions UT1>.

If you don't care about leap seconds, keep to 'UTCTime' and
'NominalDiffTime' for your clock calculations, and you'll be fine.

"Data.Thyme.Time" provides 'Num', 'Real', 'Fractional' and 'RealFrac'
instances for 'DiffTime' and 'NominalDiffTime', but their use is
discouraged. See "Data.Thyme.Docs#spaces" for details.

Use 'fromSeconds' and 'toSeconds' to convert between 'DiffTime'
/ 'NominalDiffTime' and other numeric types; use 'fromSeconds'' for
literals to avoid type defaulting warnings.

-}

module Data.Thyme.Clock (
    -- * UTC
      UTCTime
    , utctDay, utctDayTime
    , _utctDay, _utctDayTime
#if __GLASGOW_HASKELL__ >= 708
    , pattern UTCTime
#endif
    , mkUTCTime
    , utcTime

    , UTCView (..), _utcvDay, _utcvDayTime
    , NominalDiffTime

    , getCurrentTime

    -- * Absolute intervals
    , DiffTime

    -- * Time interval conversion
    , TimeDiff (..)
    , toSeconds, fromSeconds
    , toSeconds', fromSeconds'
    , picoseconds

    -- * Universal Time
    , UniversalTime
#if __GLASGOW_HASKELL__ >= 708
    , pattern UniversalTime
#endif
    , modJulianDate

    -- * Compatibility
    , getModJulianDate
    , mkModJulianDate
    , secondsToDiffTime
    , picosecondsToDiffTime
    , unUTCTime
    , addUTCTime
    , diffUTCTime
    , toMicroseconds
    , fromMicroseconds
    ) where

import Prelude
import Control.Lens
import Data.AffineSpace
import Data.Int
import Data.Ratio ((%))
import Data.Thyme.Clock.Internal
import Data.Thyme.Clock.POSIX

-- | Get the current UTC date and time from the local system clock.
--
-- @
-- > 'Data.Thyme.Clock.getCurrentTime'
-- 2016-01-15 13:42:02.287688 UTC
-- @
--
-- See also: 'Data.Thyme.LocalTime.getZonedTime', 'getPOSIXTime'.
getCurrentTime :: IO UTCTime
getCurrentTime :: IO UTCTime
getCurrentTime = (POSIXTime -> UTCTime) -> IO POSIXTime -> IO UTCTime
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (AReview UTCTime UTCTime POSIXTime POSIXTime -> POSIXTime -> UTCTime
forall s t a b. AReview s t a b -> b -> t
review AReview UTCTime UTCTime POSIXTime POSIXTime
Iso' UTCTime POSIXTime
posixTime) IO POSIXTime
getPOSIXTime

-- | Conversion between 'TimeDiff' and picoseconds. In the reverse
-- direction, picoseconds are 'round'ed to the nearest microsecond.
{-# INLINE picoseconds #-}
picoseconds :: (TimeDiff t) => Iso' t Integer
picoseconds :: forall t. TimeDiff t => Iso' t Integer
picoseconds = Overloaded p f t t Int64 Int64
forall t. TimeDiff t => Iso' t Int64
Iso' t Int64
microseconds Overloaded p f t t Int64 Int64
-> (p Integer (f Integer) -> p Int64 (f Int64))
-> p Integer (f Integer)
-> p t (f t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int64 -> Integer)
-> (Integer -> Int64) -> Iso Int64 Int64 Integer Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
(*) Integer
1000000 (Integer -> Integer) -> (Int64 -> Integer) -> Int64 -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger) (\ Integer
ps -> Rational -> Int64
forall b. Integral b => Rational -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Integer
ps Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
1000000))

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

-- | Convert a 'UniversalTime' to the fractional number of days since the
-- <http://en.wikipedia.org/wiki/Julian_day#Variants Modified Julian Date epoch>.
--
-- @
-- 'getModJulianDate' = 'view' 'modJulianDate'
-- @
{-# INLINE getModJulianDate #-}
getModJulianDate :: UniversalTime -> Rational
getModJulianDate :: UniversalTime -> Rational
getModJulianDate = Getting Rational UniversalTime Rational
-> UniversalTime -> Rational
forall a s. Getting a s a -> s -> a
view Getting Rational UniversalTime Rational
Iso' UniversalTime Rational
modJulianDate

-- | Construct a 'UniversalTime' from the fractional number of days since the
-- <http://en.wikipedia.org/wiki/Julian_day#Variants Modified Julian Date epoch>.
--
-- @
-- 'mkModJulianDate' = 'review' 'modJulianDate'
-- @
{-# INLINE mkModJulianDate #-}
mkModJulianDate :: Rational -> UniversalTime
mkModJulianDate :: Rational -> UniversalTime
mkModJulianDate = AReview UniversalTime UniversalTime Rational Rational
-> Rational -> UniversalTime
forall s t a b. AReview s t a b -> b -> t
review AReview UniversalTime UniversalTime Rational Rational
Iso' UniversalTime Rational
modJulianDate

-- | Construct a 'DiffTime' from some number of seconds.
--
-- This is just 'fromSeconds' with a more constrained type.
--
-- @
-- 'secondsToDiffTime' = 'fromSeconds'
-- @
{-# INLINE secondsToDiffTime #-}
secondsToDiffTime :: Int64 -> DiffTime
secondsToDiffTime :: Int64 -> DiffTime
secondsToDiffTime = Int64 -> DiffTime
forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds

-- | Construct a 'DiffTime' from some number of picoseconds.
-- The input will be rounded to the nearest microsecond.
--
-- @
-- 'picosecondsToDiffTime' a = 'microseconds' 'Control.Lens.#' 'quot' (a '+' 'signum' a '*' 500000) 1000000
-- @
{-# INLINE picosecondsToDiffTime #-}
picosecondsToDiffTime :: Integer -> DiffTime
picosecondsToDiffTime :: Integer -> DiffTime
picosecondsToDiffTime = AReview DiffTime DiffTime Integer Integer -> Integer -> DiffTime
forall s t a b. AReview s t a b -> b -> t
review AReview DiffTime DiffTime Integer Integer
forall t. TimeDiff t => Iso' t Integer
Iso' DiffTime Integer
picoseconds

-- | Decompose a 'UTCTime' into a 'UTCView'.
--
-- @
-- 'unUTCTime' = 'view' 'utcTime'
-- @
--
-- With @{-# LANGUAGE ViewPatterns #-}@, you can write: e.g.
--
-- @
-- f :: 'UTCTime' -> ('Day', 'DiffTime')
-- f ('unUTCTime' -> 'UTCView' day dt) = (day, dt)
-- @
--
-- For GHC 7.8 or later, there is also the pattern synonym
-- @<Data-Thyme-Clock.html#v:UTCTime UTCTime>@.
{-# INLINE unUTCTime #-}
unUTCTime :: UTCTime -> UTCView
unUTCTime :: UTCTime -> UTCView
unUTCTime = Getting UTCView UTCTime UTCView -> UTCTime -> UTCView
forall a s. Getting a s a -> s -> a
view Getting UTCView UTCTime UTCView
Iso' UTCTime UTCView
utcTime

-- | Add a duration to a point in time.
--
-- @
-- 'addUTCTime' = 'flip' ('.+^')
-- 'addUTCTime' d t ≡ t '.+^' d
-- @
--
-- See also the 'AffineSpace' instance for 'UTCTime'.
{-# INLINE addUTCTime #-}
addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime
addUTCTime :: POSIXTime -> UTCTime -> UTCTime
addUTCTime = (UTCTime -> POSIXTime -> UTCTime)
-> POSIXTime -> UTCTime -> UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> Diff UTCTime -> UTCTime
UTCTime -> POSIXTime -> UTCTime
forall p. AffineSpace p => p -> Diff p -> p
(.+^)

-- | The duration difference between two time points.
--
-- @
-- 'diffUTCTime' = ('.-.')
-- 'diffUTCTime' a b = a '.-.' b
-- @
--
-- See also the 'AffineSpace' instance for 'UTCTime'.
{-# INLINE diffUTCTime #-}
diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime :: UTCTime -> UTCTime -> POSIXTime
diffUTCTime = UTCTime -> UTCTime -> Diff UTCTime
UTCTime -> UTCTime -> POSIXTime
forall p. AffineSpace p => p -> p -> Diff p
(.-.)

-- | The number of microseconds in a 'DiffTime' or 'NominalDiffTime'.
--
-- @
-- 'toMicroseconds' :: 'DiffTime' -> 'Int64'
-- 'toMicroseconds' :: 'NominalDiffTime' -> 'Int64'
-- 'toMicroseconds' = 'view' 'microseconds'
-- 'toMicroseconds' d ≡ d '^.' 'microseconds'
-- @
{-# INLINE toMicroseconds #-}
toMicroseconds :: (TimeDiff t) => t -> Int64
toMicroseconds :: forall t. TimeDiff t => t -> Int64
toMicroseconds = Getting Int64 t Int64 -> t -> Int64
forall a s. Getting a s a -> s -> a
view Getting Int64 t Int64
forall t. TimeDiff t => Iso' t Int64
Iso' t Int64
microseconds

-- | Construct a 'DiffTime' or 'NominalDiffTime' from a number of
-- microseconds.
--
-- @
-- 'fromMicroseconds' :: 'Int64' -> 'DiffTime'
-- 'fromMicroseconds' :: 'Int64' -> 'NominalDiffTime'
-- 'fromMicroseconds' = 'review' 'microseconds'
-- 'fromMicroseconds' n ≡ 'microseconds' 'Control.Lens.#' n
-- @
{-# INLINE fromMicroseconds #-}
fromMicroseconds :: (TimeDiff t) => Int64 -> t
fromMicroseconds :: forall t. TimeDiff t => Int64 -> t
fromMicroseconds = AReview t t Int64 Int64 -> Int64 -> t
forall s t a b. AReview s t a b -> b -> t
review AReview t t Int64 Int64
forall t. TimeDiff t => Iso' t Int64
Iso' t Int64
microseconds