{-# 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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall s t a b. AReview s t a b -> b -> t
review 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 = forall t. TimeDiff t => Iso' t Int64
microseconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (forall a. Num a => a -> a -> a
(*) Integer
1000000 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Integral a => a -> Integer
toInteger) (\ Integer
ps -> forall a b. (RealFrac a, Integral b) => a -> b
round (Integer
ps 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 = forall a s. Getting a s a -> s -> a
view 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 = forall s t a b. AReview s t a b -> b -> t
review 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 = 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 = forall s t a b. AReview s t a b -> b -> t
review forall t. TimeDiff t => Iso' t 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 = forall a s. Getting a s a -> s -> a
view 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 = forall a b c. (a -> b -> c) -> b -> a -> c
flip 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 = 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 = forall a s. Getting a s a -> s -> a
view forall t. TimeDiff t => 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 = forall s t a b. AReview s t a b -> b -> t
review forall t. TimeDiff t => Iso' t Int64
microseconds