{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-} -- workaround
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE PatternSynonyms #-}
#endif
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_HADDOCK hide #-}

#include "thyme.h"

module Data.Thyme.Clock.Internal where

import Prelude
import Control.DeepSeq
import Control.Lens
import Data.AdditiveGroup
import Data.AffineSpace
import Data.Basis
import Data.Data
import Data.Hashable
import Data.Int
import Data.Ix
import Data.Thyme.Internal.Micro
import Data.Thyme.Calendar.Internal
#if __GLASGOW_HASKELL__ == 704
import qualified Data.Vector.Generic
import qualified Data.Vector.Generic.Mutable
#endif
import Data.Vector.Unboxed.Deriving
import Data.VectorSpace
import GHC.Generics (Generic)
import System.Random
import Test.QuickCheck

#if !SHOW_INTERNAL
import Control.Monad
import Text.ParserCombinators.ReadPrec (lift)
import Text.ParserCombinators.ReadP (char)
import Text.Read (readPrec)
#endif

-- | Hour time-of-day.
type Hour = Int
-- | Minute time-of-day.
type Minute = Int

-- | Time intervals, encompassing both 'DiffTime' and 'NominalDiffTime'.
--
-- ==== Notes
--
-- Still affected by <http://hackage.haskell.org/trac/ghc/ticket/7611>?
class (HasBasis t, Basis t ~ (), Scalar t ~ Rational) => TimeDiff t where
    -- | Conversion between 'TimeDiff' and 'Int64' microseconds.
    --
    -- @
    -- > ('fromSeconds'' 3 :: 'DiffTime') '^.' 'microseconds'
    -- 3000000
    --
    -- > 'microseconds' 'Control.Lens.#' 4000000 :: 'DiffTime'
    -- 4s
    -- @
    microseconds :: Iso' t Int64

-- | Convert a time interval to some 'Fractional' type.
{-# INLINE toSeconds #-}
toSeconds :: (TimeDiff t, Fractional n) => t -> n
toSeconds :: forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds = (n -> n -> n
forall a. Num a => a -> a -> a
* n -> n
forall a. Fractional a => a -> a
recip n
1000000) (n -> n) -> (t -> n) -> t -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> n
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> n) -> (t -> Int64) -> t -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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

-- | Make a time interval from some 'Real' type.
--
-- Try to make sure @n@ is one of 'Float', 'Double', 'Int', 'Int64' or
-- 'Integer', for which rewrite @RULES@ have been provided.
{-# INLINE[0] fromSeconds #-}
fromSeconds :: (Real n, TimeDiff t) => n -> t
fromSeconds :: forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds = Rational -> t
forall t. TimeDiff t => Rational -> t
fromSeconds' (Rational -> t) -> (n -> Rational) -> n -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Rational
forall a. Real a => a -> Rational
toRational

-- | Type-restricted 'toSeconds' to avoid constraint-defaulting warnings.
{-# INLINE toSeconds' #-}
toSeconds' :: (TimeDiff t) => t -> Rational
toSeconds' :: forall t. TimeDiff t => t -> Rational
toSeconds' = (t -> Basis t -> Scalar t
forall v. HasBasis v => v -> Basis v -> Scalar v
`decompose'` ())

-- | Type-restricted 'fromSeconds' to avoid constraint-defaulting warnings.
{-# INLINE fromSeconds' #-}
fromSeconds' :: (TimeDiff t) => Rational -> t
fromSeconds' :: forall t. TimeDiff t => Rational -> t
fromSeconds' = (Scalar t -> t -> t
forall v. VectorSpace v => Scalar v -> v -> v
*^ Basis t -> t
forall v. HasBasis v => Basis v -> v
basisValue ())

------------------------------------------------------------------------
-- not for public consumption

{-# INLINE fromSecondsRealFrac #-}
fromSecondsRealFrac :: (RealFrac n, TimeDiff t) => n -> n -> t
fromSecondsRealFrac :: forall n t. (RealFrac n, TimeDiff t) => n -> n -> t
fromSecondsRealFrac n
_ = 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 (Int64 -> t) -> (n -> Int64) -> n -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int64
forall b. Integral b => n -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (n -> Int64) -> (n -> n) -> n -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> n
forall a. Num a => a -> a -> a
(*) n
1000000

{-# INLINE fromSecondsIntegral #-}
fromSecondsIntegral :: (Integral n, TimeDiff t) => n -> n -> t
fromSecondsIntegral :: forall n t. (Integral n, TimeDiff t) => n -> n -> t
fromSecondsIntegral n
_ = 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 (Int64 -> t) -> (n -> Int64) -> n -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
(*) Int64
1000000 (Int64 -> Int64) -> (n -> Int64) -> n -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# RULES

"fromSeconds/Float"    [~0] fromSeconds = fromSecondsRealFrac (0 :: Float)
"fromSeconds/Double"   [~0] fromSeconds = fromSecondsRealFrac (0 :: Double)
"fromSeconds/Int"      [~0] fromSeconds = fromSecondsIntegral (0 :: Int)
"fromSeconds/Int64"    [~0] fromSeconds = fromSecondsIntegral (0 :: Int64)
"fromSeconds/Integer"  [~0] fromSeconds = fromSecondsIntegral (0 :: Integer)

  #-}

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

-- | An interval or duration of time, as would be measured by a stopwatch.
--
-- 'DiffTime' is an instance of 'AdditiveGroup' as well as 'VectorSpace',
-- with 'Rational' as its 'Scalar'.
-- We do not provide 'Num', 'Real', 'Fractional' nor 'RealFrac' instances
-- here. See "Data.Thyme.Docs#spaces" for details.
--
-- @
-- > 'fromSeconds'' 100 :: 'DiffTime'
-- 100s
-- > 'fromSeconds'' 100 '^+^' 'fromSeconds'' 100 '^*' 4
-- 500s
-- > 'fromSeconds'' 100 '^-^' 'fromSeconds'' 100 '^/' 4
-- 75s
-- @
newtype DiffTime = DiffTime Micro deriving (INSTANCES_MICRO, AdditiveGroup)

derivingUnbox "DiffTime" [t| DiffTime -> Micro |]
    [| \ (DiffTime a) -> a |] [| DiffTime |]

#if SHOW_INTERNAL
deriving instance Show DiffTime
deriving instance Read DiffTime
#else
instance Show DiffTime where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Hour -> DiffTime -> ShowS
showsPrec Hour
p (DiffTime Micro
a) = Hour -> Micro -> ShowS
forall a. Show a => Hour -> a -> ShowS
showsPrec Hour
p Micro
a ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (:) Char
's'
instance Read DiffTime where
    {-# INLINEABLE readPrec #-}
    readPrec :: ReadPrec DiffTime
readPrec = (Micro -> Char -> DiffTime) -> ReadPrec (Micro -> Char -> DiffTime)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (DiffTime -> Char -> DiffTime
forall a b. a -> b -> a
const (DiffTime -> Char -> DiffTime)
-> (Micro -> DiffTime) -> Micro -> Char -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micro -> DiffTime
DiffTime) ReadPrec (Micro -> Char -> DiffTime)
-> ReadPrec Micro -> ReadPrec (Char -> DiffTime)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ReadPrec Micro
forall a. Read a => ReadPrec a
readPrec ReadPrec (Char -> DiffTime) -> ReadPrec Char -> ReadPrec DiffTime
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
's')
#endif

instance VectorSpace DiffTime where
    type Scalar DiffTime = Rational
    {-# INLINE (*^) #-}
    *^ :: Scalar DiffTime -> DiffTime -> DiffTime
(*^) = \ Scalar DiffTime
s (DiffTime Micro
t) -> Micro -> DiffTime
DiffTime (Scalar Micro
Scalar DiffTime
s Scalar Micro -> Micro -> Micro
forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro
t)

instance HasBasis DiffTime where
    type Basis DiffTime = ()
    {-# INLINE basisValue #-}
    basisValue :: Basis DiffTime -> DiffTime
basisValue = \ Basis DiffTime
_ -> Micro -> DiffTime
DiffTime (Basis Micro -> Micro
forall v. HasBasis v => Basis v -> v
basisValue ())
    {-# INLINE decompose #-}
    decompose :: DiffTime -> [(Basis DiffTime, Scalar DiffTime)]
decompose = \ (DiffTime Micro
a) -> Micro -> [(Basis Micro, Scalar Micro)]
forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Micro
a
    {-# INLINE decompose' #-}
    decompose' :: DiffTime -> Basis DiffTime -> Scalar DiffTime
decompose' = \ (DiffTime Micro
a) -> Micro -> Basis Micro -> Scalar Micro
forall v. HasBasis v => v -> Basis v -> Scalar v
decompose' Micro
a

instance TimeDiff DiffTime where
    {-# INLINE microseconds #-}
    microseconds :: Iso' DiffTime Int64
microseconds = (DiffTime -> Int64) -> (Int64 -> DiffTime) -> Iso' DiffTime Int64
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (DiffTime (Micro Int64
u)) -> Int64
u) (Micro -> DiffTime
DiffTime (Micro -> DiffTime) -> (Int64 -> Micro) -> Int64 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Micro
Micro)

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

-- | The nominal interval between two 'UTCTime's, which does not take leap
-- seconds into account.
--
-- For example, the difference between /23:59:59/ and /00:00:01/ on the
-- following day is always 2 seconds of 'NominalDiffTime', regardless of
-- whether a leap-second took place.
--
-- 'NominalDiffTime' is an instance of 'AdditiveGroup' as well as
-- 'VectorSpace', with 'Rational' as its 'Scalar'.
-- We do not provide 'Num', 'Real', 'Fractional' nor 'RealFrac' instances
-- here. See "Data.Thyme.Docs#spaces" for details.
--
-- @
-- > let d = 'fromSeconds'' 2 :: 'NominalDiffTime'
-- > d
-- 2s
-- > d '^/' 3
-- 0.666667s
-- @
--
-- See also: 'UTCTime'.
newtype NominalDiffTime = NominalDiffTime Micro deriving (INSTANCES_MICRO, AdditiveGroup)

derivingUnbox "NominalDiffTime" [t| NominalDiffTime -> Micro |]
    [| \ (NominalDiffTime a) -> a |] [| NominalDiffTime |]

#if SHOW_INTERNAL
deriving instance Show NominalDiffTime
deriving instance Read NominalDiffTime
#else
instance Show NominalDiffTime where
    {-# INLINEABLE showsPrec #-}
    showsPrec :: Hour -> NominalDiffTime -> ShowS
showsPrec Hour
p (NominalDiffTime Micro
a) String
rest = Hour -> Micro -> ShowS
forall a. Show a => Hour -> a -> ShowS
showsPrec Hour
p Micro
a (Char
's' Char -> ShowS
forall a. a -> [a] -> [a]
: String
rest)
instance Read NominalDiffTime where
    {-# INLINEABLE readPrec #-}
    readPrec :: ReadPrec NominalDiffTime
readPrec = (Micro -> Char -> NominalDiffTime)
-> ReadPrec (Micro -> Char -> NominalDiffTime)
forall a. a -> ReadPrec a
forall (m :: * -> *) a. Monad m => a -> m a
return (NominalDiffTime -> Char -> NominalDiffTime
forall a b. a -> b -> a
const (NominalDiffTime -> Char -> NominalDiffTime)
-> (Micro -> NominalDiffTime) -> Micro -> Char -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Micro -> NominalDiffTime
NominalDiffTime) ReadPrec (Micro -> Char -> NominalDiffTime)
-> ReadPrec Micro -> ReadPrec (Char -> NominalDiffTime)
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ReadPrec Micro
forall a. Read a => ReadPrec a
readPrec ReadPrec (Char -> NominalDiffTime)
-> ReadPrec Char -> ReadPrec NominalDiffTime
forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
`ap` ReadP Char -> ReadPrec Char
forall a. ReadP a -> ReadPrec a
lift (Char -> ReadP Char
char Char
's')
#endif

instance VectorSpace NominalDiffTime where
    type Scalar NominalDiffTime = Rational
    {-# INLINE (*^) #-}
    *^ :: Scalar NominalDiffTime -> NominalDiffTime -> NominalDiffTime
(*^) = \ Scalar NominalDiffTime
s (NominalDiffTime Micro
t) -> Micro -> NominalDiffTime
NominalDiffTime (Scalar Micro
Scalar NominalDiffTime
s Scalar Micro -> Micro -> Micro
forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro
t)

instance HasBasis NominalDiffTime where
    type Basis NominalDiffTime = ()
    {-# INLINE basisValue #-}
    basisValue :: Basis NominalDiffTime -> NominalDiffTime
basisValue = \ Basis NominalDiffTime
_ -> Micro -> NominalDiffTime
NominalDiffTime (Basis Micro -> Micro
forall v. HasBasis v => Basis v -> v
basisValue ())
    {-# INLINE decompose #-}
    decompose :: NominalDiffTime
-> [(Basis NominalDiffTime, Scalar NominalDiffTime)]
decompose = \ (NominalDiffTime Micro
a) -> Micro -> [(Basis Micro, Scalar Micro)]
forall v. HasBasis v => v -> [(Basis v, Scalar v)]
decompose Micro
a
    {-# INLINE decompose' #-}
    decompose' :: NominalDiffTime -> Basis NominalDiffTime -> Scalar NominalDiffTime
decompose' = \ (NominalDiffTime Micro
a) -> Micro -> Basis Micro -> Scalar Micro
forall v. HasBasis v => v -> Basis v -> Scalar v
decompose' Micro
a

instance TimeDiff NominalDiffTime where
    {-# INLINE microseconds #-}
    microseconds :: Iso' NominalDiffTime Int64
microseconds = (NominalDiffTime -> Int64)
-> (Int64 -> NominalDiffTime) -> Iso' NominalDiffTime Int64
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ (NominalDiffTime (Micro Int64
u)) -> Int64
u) (Micro -> NominalDiffTime
NominalDiffTime (Micro -> NominalDiffTime)
-> (Int64 -> Micro) -> Int64 -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Micro
Micro)

-- | The nominal length of a POSIX day: /86400 SI seconds/.
{-# INLINE posixDayLength #-}
posixDayLength :: NominalDiffTime
posixDayLength :: NominalDiffTime
posixDayLength = Overloaded
  Reviewed Identity NominalDiffTime NominalDiffTime Int64 Int64
forall t. TimeDiff t => Iso' t Int64
Iso' NominalDiffTime Int64
microseconds Overloaded
  Reviewed Identity NominalDiffTime NominalDiffTime Int64 Int64
-> Int64 -> NominalDiffTime
forall s t a b. AReview s t a b -> b -> t
# Int64
86400000000

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

-- | The principal form of universal time, namely
-- <http://en.wikipedia.org/wiki/Universal_Time#Versions UT1>.
--
-- UT1 is defined by the rotation of the Earth around its axis relative to
-- the Sun. The length of each UT1 day varies and is never exactly 86400 SI
-- seconds, unlike UTC or TAI.
--
-- The difference between UT1 and UTC is
-- <http://en.wikipedia.org/wiki/DUT1 DUT1>.
newtype UniversalTime = UniversalRep NominalDiffTime deriving (INSTANCES_MICRO)

derivingUnbox "UniversalTime" [t| UniversalTime -> NominalDiffTime |]
    [| \ (UniversalRep a) -> a |] [| UniversalRep |]

-- | Convert between 'UniversalTime' and the fractional number of days since the
-- <http://en.wikipedia.org/wiki/Julian_day#Variants Modified Julian Date epoch>.
{-# INLINE modJulianDate #-}
modJulianDate :: Iso' UniversalTime Rational
modJulianDate :: Iso' UniversalTime Rational
modJulianDate = (UniversalTime -> Rational)
-> (Rational -> UniversalTime) -> Iso' UniversalTime Rational
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
    (\ (UniversalRep NominalDiffTime
t) -> NominalDiffTime -> Rational
forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds NominalDiffTime
t Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ NominalDiffTime -> Rational
forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds NominalDiffTime
posixDayLength)
    (NominalDiffTime -> UniversalTime
UniversalRep (NominalDiffTime -> UniversalTime)
-> (Rational -> NominalDiffTime) -> Rational -> UniversalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Scalar NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. VectorSpace v => Scalar v -> v -> v
*^ NominalDiffTime
posixDayLength))

#if __GLASGOW_HASKELL__ >= 710
pattern UniversalTime :: Rational -> UniversalTime
pattern $mUniversalTime :: forall {r}. UniversalTime -> (Rational -> r) -> ((# #) -> r) -> r
$bUniversalTime :: Rational -> UniversalTime
UniversalTime mjd <- (view modJulianDate -> mjd) where
    UniversalTime Rational
mjd = Overloaded
  Reviewed Identity UniversalTime UniversalTime Rational Rational
Iso' UniversalTime Rational
modJulianDate Overloaded
  Reviewed Identity UniversalTime UniversalTime Rational Rational
-> Rational -> UniversalTime
forall s t a b. AReview s t a b -> b -> t
# Rational
mjd
#elif __GLASGOW_HASKELL__ >= 708
pattern UniversalTime mjd <- (view modJulianDate -> mjd)
#endif

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

-- | <https://en.wikipedia.org/wiki/Coordinated_Universal_Time Coördinated universal time>
-- ('UTCTime') is the most commonly used standard for civil timekeeping. It
-- is synchronised with
-- <https://en.wikipedia.org/wiki/International_Atomic_Time TAI>
-- ('Data.Thyme.Clock.AbsoluteTime') and both tick in increments of SI
-- seconds, but UTC includes occasional leap-seconds to keep it close to
-- <https://en.wikipedia.org/wiki/Universal_Time#Versions UT1>
-- ('UniversalTime').
--
-- @
-- > 'utcTime' 'Control.Lens.#' 'UTCView' ('gregorian' 'Control.Lens.#' 'YearMonthDay' 2016 1 15) ('Data.Thyme.LocalTime.timeOfDay' 'Control.Lens.#' 'Data.Thyme.LocalTime.TimeOfDay' 12 34 56.78)
-- 2016-01-15 12:34:56.78 UTC
--
-- > 'UTCTime' ('gregorian' 'Control.Lens.#' 'YearMonthDay' 2016 1 15) ('Data.Thyme.LocalTime.timeOfDay' 'Control.Lens.#' 'Data.Thyme.LocalTime.TimeOfDay' 12 34 56.78)
-- 2016-01-15 12:34:56.78 UTC
--
-- > 'mkUTCTime' 2016 1 15  12 34 56.78
-- 2016-01-15 12:34:56.78 UTC
-- @
--
-- 'UTCTime' is an 'AffineSpace' with 'NominalDiffTime' as its 'Diff'. See
-- "Data.Thyme.Docs#spaces" for details.
--
-- @
-- > let t0 = 'mkUTCTime' 2016 1 15  23 59 0
-- > let t1 = 'mkUTCTime' 2016 1 16  00  1 1
-- > let dt = t1 '.-.' t0
-- > dt
-- 121s :: 'NominalDiffTime'
--
-- > t1 '.+^' dt
-- 2016-01-16 00:03:02 UTC
--
-- > t1 '.+^' 3 '*^' dt
-- 2016-01-16 00:07:04 UTC
-- @
--
-- To decompose a 'UTCTime' into a separate 'Day' and time-of-day, use
-- 'utcTime'. To convert to a local time zone, see
-- 'Data.Thyme.LocalTime.zonedTime' or 'Data.Thyme.LocalTime.utcLocalTime'.
--
-- ==== Notes
--
-- Internally 'UTCTime' is just a 64-bit count of 'microseconds' since the
-- Modified Julian Day epoch, so @('.+^')@, @('.-.')@ et cetera ought to be
-- fast.
--
-- 'UTCTime' <https://github.com/liyang/thyme/issues/3 cannot represent leap seconds>.
-- If leap seconds matter, use 'Data.Thyme.Clock.TAI.AbsoluteTime' from
-- "Data.Thyme.Clock.TAI" instead, along with
-- 'Data.Thyme.Clock.TAI.absoluteTime'' and 'UTCView' for presentation.
newtype UTCTime = UTCRep NominalDiffTime deriving (INSTANCES_MICRO)

derivingUnbox "UTCTime" [t| UTCTime -> NominalDiffTime |]
    [| \ (UTCRep a) -> a |] [| UTCRep |]

-- | Unpacked 'UTCTime', partly for compatibility with @time@.
--
-- As of GHC 7.10, you can also use the 'UTCTime' pattern synonym.
data UTCView = UTCView
    { UTCView -> Day
utcvDay :: {-# UNPACK #-}!Day
    -- ^ Calendar date.
    , UTCView -> DiffTime
utcvDayTime :: {-# UNPACK #-}!DiffTime
    -- ^ Time elapsed since midnight; /0/ ≤ 'utcvDayTime' < /86401s/.
    } deriving (INSTANCES_USUAL, Show)

-- | 'Lens'' for the calendar 'Day' component of a 'UTCView'.
LENS(UTCView,utcvDay,Day)

-- | 'Lens'' for the time-of-day 'DiffTime' component of a 'UTCView'.
LENS(UTCView,utcvDayTime,DiffTime)

derivingUnbox "UTCView" [t| UTCView -> (Day, DiffTime) |]
    [| \ UTCView {..} -> (utcvDay, utcvDayTime) |]
    [| \ (utcvDay, utcvDayTime) -> UTCView {..} |]

instance Hashable UTCView
instance NFData UTCView

-- | 'Lens'' for the calendar 'Day' component of a 'UTCTime'.
_utctDay :: Lens' UTCTime Day
_utctDay :: Lens' UTCTime Day
_utctDay = Overloaded (->) f UTCTime UTCTime UTCView UTCView
Iso' UTCTime UTCView
utcTime Overloaded (->) f UTCTime UTCTime UTCView UTCView
-> ((Day -> f Day) -> UTCView -> f UTCView)
-> (Day -> f Day)
-> UTCTime -> f UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCView -> Day)
-> (UTCView -> Day -> UTCView) -> Lens' UTCView Day
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTCView -> Day
utcvDay
    (\ UTCView {Day
DiffTime
utcvDay :: UTCView -> Day
utcvDayTime :: UTCView -> DiffTime
utcvDay :: Day
utcvDayTime :: DiffTime
..} Day
d -> Day -> DiffTime -> UTCView
UTCView Day
d DiffTime
utcvDayTime)

-- | 'Lens'' for the time-of-day 'DiffTime' component of a 'UTCTime'.
_utctDayTime :: Lens' UTCTime DiffTime
_utctDayTime :: Lens' UTCTime DiffTime
_utctDayTime = Overloaded (->) f UTCTime UTCTime UTCView UTCView
Iso' UTCTime UTCView
utcTime Overloaded (->) f UTCTime UTCTime UTCView UTCView
-> ((DiffTime -> f DiffTime) -> UTCView -> f UTCView)
-> (DiffTime -> f DiffTime)
-> UTCTime -> f UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCView -> DiffTime)
-> (UTCView -> DiffTime -> UTCView) -> Lens' UTCView DiffTime
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UTCView -> DiffTime
utcvDayTime
    (\ UTCView {Day
DiffTime
utcvDay :: UTCView -> Day
utcvDayTime :: UTCView -> DiffTime
utcvDay :: Day
utcvDayTime :: DiffTime
..} DiffTime
t -> Day -> DiffTime -> UTCView
UTCView Day
utcvDay DiffTime
t)

-- | Accessor for the calendar 'Day' component of an 'UTCTime'.
--
-- @
-- 'utctDay' = 'view' '_utctDay'
-- @
utctDay :: UTCTime -> Day
utctDay :: UTCTime -> Day
utctDay = Getting Day UTCTime Day -> UTCTime -> Day
forall a s. Getting a s a -> s -> a
view Getting Day UTCTime Day
Lens' UTCTime Day
_utctDay

-- | Accessor for the time-of-day 'DiffTime' component of an 'UTCTime'.
--
-- @
-- 'utctDayTime' = 'view' '_utctDayTime'
-- @
utctDayTime :: UTCTime -> DiffTime
utctDayTime :: UTCTime -> DiffTime
utctDayTime = Getting DiffTime UTCTime DiffTime -> UTCTime -> DiffTime
forall a s. Getting a s a -> s -> a
view Getting DiffTime UTCTime DiffTime
Lens' UTCTime DiffTime
_utctDayTime

instance AffineSpace UTCTime where
    type Diff UTCTime = NominalDiffTime
    {-# INLINE (.-.) #-}
    .-. :: UTCTime -> UTCTime -> Diff UTCTime
(.-.) = \ (UTCRep NominalDiffTime
a) (UTCRep NominalDiffTime
b) -> NominalDiffTime
a NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^-^ NominalDiffTime
b
    {-# INLINE (.+^) #-}
    .+^ :: UTCTime -> Diff UTCTime -> UTCTime
(.+^) = \ (UTCRep NominalDiffTime
a) Diff UTCTime
d -> NominalDiffTime -> UTCTime
UTCRep (NominalDiffTime
a NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ Diff UTCTime
NominalDiffTime
d)

-- | View 'UTCTime' as an 'UTCView', comprising a 'Day' along with
-- a 'DiffTime' offset since midnight.
--
-- This is an improper lens: 'utcvDayTime' outside the range of
-- @['zeroV', 'posixDayLength')@ will carry over into 'utcvDay', with the
-- expected behaviour.
--
-- @
-- > 'view' 'utcTime' '<$>' 'Data.Thyme.Clock.getCurrentTime'
-- 'UTCView' {'utcvDay' = 2016-01-15, 'utcvDayTime' = 49322.287688s}
--
-- > 'utcTime' 'Control.Lens.#' 'UTCView' ('gregorian' 'Control.Lens.#' 'YearMonthDay' 2016 1 15) ('Data.Thyme.LocalTime.timeOfDay' 'Control.Lens.#' 'Data.Thyme.LocalTime.TimeOfDay' 12 34 56.78)
-- 2016-01-15 12:34:56.78 UTC
-- @
--
-- With @{-# LANGUAGE ViewPatterns #-}@, you can write: e.g.
--
-- @
-- f :: 'UTCTime' -> ('Day', 'DiffTime')
-- f ('view' 'utcTime' -> 'UTCView' day dt) = (day, dt)
-- @
{-# INLINE utcTime #-}
utcTime :: Iso' UTCTime UTCView
utcTime :: Iso' UTCTime UTCView
utcTime = (UTCTime -> UTCView)
-> (UTCView -> UTCTime) -> Iso' UTCTime UTCView
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso UTCTime -> UTCView
toView UTCView -> UTCTime
fromView where
    NominalDiffTime posixDay :: Micro
posixDay@(Micro Int64
uPosixDay) = NominalDiffTime
posixDayLength

    {-# INLINE toView #-}
    toView :: UTCTime -> UTCView
    toView :: UTCTime -> UTCView
toView (UTCRep (NominalDiffTime Micro
a)) = Day -> DiffTime -> UTCView
UTCView
            (Hour -> Day
ModifiedJulianDay Hour
mjd) (Micro -> DiffTime
DiffTime Micro
dt) where
        (Int64 -> Hour
forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Hour
mjd, Micro
dt) = Micro -> Micro -> (Int64, Micro)
microDivMod Micro
a Micro
posixDay

    {-# INLINE fromView #-}
    fromView :: UTCView -> UTCTime
    fromView :: UTCView -> UTCTime
fromView (UTCView (ModifiedJulianDay Hour
mjd) (DiffTime Micro
dt)) = NominalDiffTime -> UTCTime
UTCRep NominalDiffTime
a where
        a :: NominalDiffTime
a = Micro -> NominalDiffTime
NominalDiffTime (Int64 -> Micro
Micro (Hour -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Hour
mjd Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
uPosixDay) Micro -> Micro -> Micro
forall v. AdditiveGroup v => v -> v -> v
^+^ Micro
dt)

#if __GLASGOW_HASKELL__ >= 710
pattern UTCTime :: Day -> DiffTime -> UTCTime
pattern $mUTCTime :: forall {r}. UTCTime -> (Day -> DiffTime -> r) -> ((# #) -> r) -> r
$bUTCTime :: Day -> DiffTime -> UTCTime
UTCTime d t <- (view utcTime -> UTCView d t) where
    UTCTime Day
d DiffTime
t = Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
Iso' UTCTime UTCView
utcTime Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
-> UTCView -> UTCTime
forall s t a b. AReview s t a b -> b -> t
# Day -> DiffTime -> UTCView
UTCView Day
d DiffTime
t
#elif __GLASGOW_HASKELL__ >= 708
pattern UTCTime d t <- (view utcTime -> UTCView d t)
#endif

-- | Construct a 'UTCTime' from a 'gregorian' date and time-of-day.
--
-- @
-- 'mkUTCTime' yy mm dd h m s ≡ 'utcTime' 'Control.Lens.#' 'UTCView'
--     ('gregorian' 'Control.Lens.#' 'YearMonthDay' yy mm dd)
--     ('Data.Thyme.LocalTime.timeOfDay' 'Control.Lens.#' 'Data.Thyme.LocalTime.TimeOfDay' h m ('fromSeconds' s))
-- @
{-# INLINE mkUTCTime #-}
mkUTCTime :: Year -> Month -> DayOfMonth -> Hour -> Minute -> Double -> UTCTime
mkUTCTime :: Hour -> Hour -> Hour -> Hour -> Hour -> Double -> UTCTime
mkUTCTime Hour
yy Hour
mm Hour
dd Hour
h Hour
m Double
s = Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
Iso' UTCTime UTCView
utcTime Overloaded Reviewed Identity UTCTime UTCTime UTCView UTCView
-> UTCView -> UTCTime
forall s t a b. AReview s t a b -> b -> t
# Day -> DiffTime -> UTCView
UTCView
    (Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
Iso' Day YearMonthDay
gregorian Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
-> YearMonthDay -> Day
forall s t a b. AReview s t a b -> b -> t
# Hour -> Hour -> Hour -> YearMonthDay
YearMonthDay Hour
yy Hour
mm Hour
dd)
    (Hour -> DiffTime
forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds (Hour
3600 Hour -> Hour -> Hour
forall a. Num a => a -> a -> a
* Hour
h Hour -> Hour -> Hour
forall a. Num a => a -> a -> a
+ Hour
60 Hour -> Hour -> Hour
forall a. Num a => a -> a -> a
* Hour
m) DiffTime -> DiffTime -> DiffTime
forall v. AdditiveGroup v => v -> v -> v
^+^ Double -> DiffTime
forall n t. (Real n, TimeDiff t) => n -> t
fromSeconds Double
s)