# LANGUAGE CPP #
{-# LANGUAGE DeriveDataTypeable #-}
# LANGUAGE DeriveGeneric #
# LANGUAGE FlexibleContexts #
# 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 <>?
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 = (* recip 1000000) . fromIntegral . view 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 = fromSeconds' . toRational

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

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

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

# INLINE fromSecondsRealFrac #
fromSecondsRealFrac :: (RealFrac n, TimeDiff t) => n -> n -> t
fromSecondsRealFrac _ = review microseconds . round . (*) 1000000

# INLINE fromSecondsIntegral #
fromSecondsIntegral :: (Integral n, TimeDiff t) => n -> n -> t
fromSecondsIntegral _ = review microseconds . (*) 1000000 . 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 ) 

   #

"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 '  ' , ' 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 p (DiffTime a) = showsPrec p a . (:) 's'
instance Read DiffTime where
# INLINEABLE readPrec #
    readPrec = return (const . DiffTime) `ap` readPrec `ap` lift (char 's')
#endif

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

instance HasBasis DiffTime where
    type Basis DiffTime = ()
# INLINE basisValue #
    basisValue = \ _ -> DiffTime (basisValue ())
    {-# INLINE decompose #-}
    decompose = \ (DiffTime a) -> decompose a
    {-# INLINE decompose' #-}
    decompose' = \ (DiffTime a) -> decompose' a

instance TimeDiff DiffTime where
# INLINE microseconds #
    microseconds = iso (\ (DiffTime (Micro u)) -> u) (DiffTime . 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 '  ' , ' 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 p (NominalDiffTime a) rest = showsPrec p a ('s' : rest)
instance Read NominalDiffTime where
# INLINEABLE readPrec #
    readPrec = return (const . NominalDiffTime) `ap` readPrec `ap` lift (char 's')
#endif

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

instance HasBasis NominalDiffTime where
    type Basis NominalDiffTime = ()
# INLINE basisValue #
    basisValue = \ _ -> NominalDiffTime (basisValue ())
    {-# INLINE decompose #-}
    decompose = \ (NominalDiffTime a) -> decompose a
    {-# INLINE decompose' #-}
    decompose' = \ (NominalDiffTime a) -> decompose' a

instance TimeDiff NominalDiffTime where
# INLINE microseconds #
    microseconds = iso (\ (NominalDiffTime (Micro u)) -> u) (NominalDiffTime . Micro)

  | The nominal length of a POSIX day : /86400 SI seconds/.
# INLINE posixDayLength #
posixDayLength :: NominalDiffTime
posixDayLength = microseconds # 86400000000

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

-- | The principal form of universal time, namely
-- <#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
-- < 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
-- <#Variants Modified Julian Date epoch>.
# INLINE modJulianDate #
modJulianDate :: Iso' UniversalTime Rational
modJulianDate = iso
    (\ (UniversalRep t) -> toSeconds t / toSeconds posixDayLength)
    (UniversalRep . (*^ posixDayLength))

#if __GLASGOW_HASKELL__ >= 710
pattern UniversalTime :: Rational -> UniversalTime
pattern UniversalTime mjd <- (view modJulianDate -> mjd) where
    UniversalTime mjd = modJulianDate # mjd
#elif __GLASGOW_HASKELL__ >= 708
pattern UniversalTime mjd <- (view modJulianDate -> mjd)
#endif

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

-- | < Coördinated universal time>
-- ('UTCTime') is the most commonly used standard for civil timekeeping. It
-- is synchronised with
-- < TAI>
  ( ' Data . Thyme . Clock .  ' ) and both tick in increments of SI
-- seconds, but UTC includes occasional leap-seconds to keep it close to
-- <#Versions UT1>
-- ('UniversalTime').
--
-- @
  > ' utcTime ' ' Control . Lens . # ' ' UTCView ' ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' 2016 1 15 ) ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 12 34 56.78 )
  2016 - 01 - 15 12:34:56.78 UTC
--
  > ' UTCTime ' ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' 2016 1 15 ) ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 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' < 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
    { utcvDay :: {-# UNPACK #-}!Day
    -- ^ Calendar date.
    , 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 = utcTime . lens utcvDay
    (\ UTCView {..} d -> UTCView d utcvDayTime)

  | ' Lens '' for the time - of - day ' DiffTime ' component of a ' UTCTime ' .
_utctDayTime :: Lens' UTCTime DiffTime
_utctDayTime = utcTime . lens utcvDayTime
    (\ UTCView {..} t -> UTCView utcvDay t)

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

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

instance AffineSpace UTCTime where
    type Diff UTCTime = NominalDiffTime
    {-# INLINE (.-.) #-}
    (.-.) = \ (UTCRep a) (UTCRep b) -> a ^-^ b
    {-# INLINE (.+^) #-}
    (.+^) = \ (UTCRep a) d -> UTCRep (a ^+^ 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 .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 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 toView fromView where
    NominalDiffTime posixDay@(Micro uPosixDay) = posixDayLength

# INLINE toView #
    toView :: UTCTime -> UTCView
    toView (UTCRep (NominalDiffTime a)) = UTCView
            (ModifiedJulianDay mjd) (DiffTime dt) where
        (fromIntegral -> mjd, dt) = microDivMod a posixDay

# INLINE fromView #
    fromView :: UTCView -> UTCTime
    fromView (UTCView (ModifiedJulianDay mjd) (DiffTime dt)) = UTCRep a where
        a = NominalDiffTime (Micro (fromIntegral mjd * uPosixDay) ^+^ dt)

#if __GLASGOW_HASKELL__ >= 710
pattern UTCTime :: Day -> DiffTime -> UTCTime
pattern UTCTime d t <- (view utcTime -> UTCView d t) where
    UTCTime d t = utcTime # UTCView d 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 .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' h m ( ' fromSeconds ' s ) )
-- @
# INLINE mkUTCTime #
mkUTCTime :: Year -> Month -> DayOfMonth -> Hour -> Minute -> Double -> UTCTime
mkUTCTime yy mm dd h m s = utcTime # UTCView
    (gregorian # YearMonthDay yy mm dd)
    (fromSeconds (3600 * h + 60 * m) ^+^ fromSeconds s)


# LANGUAGE DeriveDataTypeable #
# OPTIONS_HADDOCK hide #
 | Hour time-of-day.
 | Minute time-of-day.
 | Time intervals, encompassing both 'DiffTime' and 'NominalDiffTime'.

 ==== Notes

 Still affected by <>?

 @

 @
 | Convert a time interval to some 'Fractional' type.
 | Make a time interval from some 'Real' type.

# INLINE[0] fromSeconds #
 | Type-restricted 'toSeconds' to avoid constraint-defaulting warnings.
# INLINE toSeconds' #
 | Type-restricted 'fromSeconds' to avoid constraint-defaulting warnings.
# INLINE fromSeconds' #
----------------------------------------------------------------------
 not for public consumption
----------------------------------------------------------------------
 | An interval or duration of time, as would be measured by a stopwatch.

 'DiffTime' is an instance of 'AdditiveGroup' as well as 'VectorSpace',
 here. See "Data.Thyme.Docs#spaces" for details.

 @
 @
# INLINE (*^) #
# INLINE decompose #
# INLINE decompose' #
----------------------------------------------------------------------
 | 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
 whether a leap-second took place.

 'NominalDiffTime' is an instance of 'AdditiveGroup' as well as
 here. See "Data.Thyme.Docs#spaces" for details.

 @
 > d
 @

 See also: 'UTCTime'.
# INLINE (*^) #
# INLINE decompose #
# INLINE decompose' #
----------------------------------------------------------------------
 | The principal form of universal time, namely
 <#Versions UT1>.


 The difference between UT1 and UTC is
 < DUT1>.
 | Convert between 'UniversalTime' and the fractional number of days since the
 <#Variants Modified Julian Date epoch>.
----------------------------------------------------------------------
 | < Coördinated universal time>
 ('UTCTime') is the most commonly used standard for civil timekeeping. It
 is synchronised with
 < TAI>
 seconds, but UTC includes occasional leap-seconds to keep it close to
 <#Versions UT1>
 ('UniversalTime').

 @


 @

 "Data.Thyme.Docs#spaces" for details.

 @
 > let dt = t1 '.-.' t0
 > dt
 121s :: 'NominalDiffTime'

 > t1 '.+^' dt

 > t1 '.+^' 3 '*^' dt
 @

 'utcTime'. To convert to a local time zone, see

 ==== Notes

 fast.

 'UTCTime' < cannot represent leap seconds>.
 If leap seconds matter, use 'Data.Thyme.Clock.TAI.AbsoluteTime' from
 'Data.Thyme.Clock.TAI.absoluteTime'' and 'UTCView' for presentation.
 | Unpacked 'UTCTime', partly for compatibility with @time@.

# UNPACK #
 ^ Calendar date.
# UNPACK #
 | 'Lens'' for the calendar 'Day' component of a 'UTCView'.
 | 'Lens'' for the calendar 'Day' component of a 'UTCTime'.
 | Accessor for the calendar 'Day' component of an 'UTCTime'.

 @
 'utctDay' = 'view' '_utctDay'
 @

 @
 'utctDayTime' = 'view' '_utctDayTime'
 @
# INLINE (.-.) #
# INLINE (.+^) #
 | View 'UTCTime' as an 'UTCView', comprising a 'Day' along with

 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'

 @

 # LANGUAGE ViewPatterns # 

 @
 f :: 'UTCTime' -> ('Day', 'DiffTime')
 @
 | Construct a 'UTCTime' from a 'gregorian' date and time-of-day.

 @
 'mkUTCTime' yy mm dd h m s ≡ 'utcTime' 'Control.Lens.#' 'UTCView'
 @
# LANGUAGE CPP #
# LANGUAGE DeriveGeneric #
# LANGUAGE FlexibleContexts #
# LANGUAGE GeneralizedNewtypeDeriving #
# LANGUAGE MultiParamTypeClasses #
#if __GLASGOW_HASKELL__ >= 708
# LANGUAGE PatternSynonyms #
#endif
# LANGUAGE RecordWildCards #
# LANGUAGE StandaloneDeriving #
# LANGUAGE TemplateHaskell #
# LANGUAGE TypeFamilies #
# LANGUAGE ViewPatterns #

#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

type Hour = Int
type Minute = Int

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

# INLINE toSeconds #
toSeconds :: (TimeDiff t, Fractional n) => t -> n
toSeconds = (* recip 1000000) . fromIntegral . view microseconds

  Try to make sure @n@ is one of ' Float ' , ' Double ' , ' Int ' , ' Int64 ' or
  ' Integer ' , for which rewrite @RULES@ have been provided .
fromSeconds :: (Real n, TimeDiff t) => n -> t
fromSeconds = fromSeconds' . toRational

toSeconds' :: (TimeDiff t) => t -> Rational
toSeconds' = (`decompose'` ())

fromSeconds' :: (TimeDiff t) => Rational -> t
fromSeconds' = (*^ basisValue ())


# INLINE fromSecondsRealFrac #
fromSecondsRealFrac :: (RealFrac n, TimeDiff t) => n -> n -> t
fromSecondsRealFrac _ = review microseconds . round . (*) 1000000

# INLINE fromSecondsIntegral #
fromSecondsIntegral :: (Integral n, TimeDiff t) => n -> n -> t
fromSecondsIntegral _ = review microseconds . (*) 1000000 . 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 ) 

   #

"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)

  #-}


  with ' Rational ' as its ' Scalar ' .
  We do not provide '  ' , ' Real ' , ' Fractional ' nor ' RealFrac ' instances
  > ' 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 p (DiffTime a) = showsPrec p a . (:) 's'
instance Read DiffTime where
# INLINEABLE readPrec #
    readPrec = return (const . DiffTime) `ap` readPrec `ap` lift (char 's')
#endif

instance VectorSpace DiffTime where
    type Scalar DiffTime = Rational
    (*^) = \ s (DiffTime t) -> DiffTime (s *^ t)

instance HasBasis DiffTime where
    type Basis DiffTime = ()
# INLINE basisValue #
    basisValue = \ _ -> DiffTime (basisValue ())
    decompose = \ (DiffTime a) -> decompose a
    decompose' = \ (DiffTime a) -> decompose' a

instance TimeDiff DiffTime where
# INLINE microseconds #
    microseconds = iso (\ (DiffTime (Micro u)) -> u) (DiffTime . Micro)


  following day is always 2 seconds of ' NominalDiffTime ' , regardless of
  ' VectorSpace ' , with ' Rational ' as its ' Scalar ' .
  We do not provide '  ' , ' Real ' , ' Fractional ' nor ' RealFrac ' instances
  > let d = ' fromSeconds '' 2 : : ' NominalDiffTime '
  2s
  > d ' ^/ ' 3
  0.666667s
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 p (NominalDiffTime a) rest = showsPrec p a ('s' : rest)
instance Read NominalDiffTime where
# INLINEABLE readPrec #
    readPrec = return (const . NominalDiffTime) `ap` readPrec `ap` lift (char 's')
#endif

instance VectorSpace NominalDiffTime where
    type Scalar NominalDiffTime = Rational
    (*^) = \ s (NominalDiffTime t) -> NominalDiffTime (s *^ t)

instance HasBasis NominalDiffTime where
    type Basis NominalDiffTime = ()
# INLINE basisValue #
    basisValue = \ _ -> NominalDiffTime (basisValue ())
    decompose = \ (NominalDiffTime a) -> decompose a
    decompose' = \ (NominalDiffTime a) -> decompose' a

instance TimeDiff NominalDiffTime where
# INLINE microseconds #
    microseconds = iso (\ (NominalDiffTime (Micro u)) -> u) (NominalDiffTime . Micro)

  | The nominal length of a POSIX day : /86400 SI seconds/.
# INLINE posixDayLength #
posixDayLength :: NominalDiffTime
posixDayLength = microseconds # 86400000000


  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 .
newtype UniversalTime = UniversalRep NominalDiffTime deriving (INSTANCES_MICRO)

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

# INLINE modJulianDate #
modJulianDate :: Iso' UniversalTime Rational
modJulianDate = iso
    (\ (UniversalRep t) -> toSeconds t / toSeconds posixDayLength)
    (UniversalRep . (*^ posixDayLength))

#if __GLASGOW_HASKELL__ >= 710
pattern UniversalTime :: Rational -> UniversalTime
pattern UniversalTime mjd <- (view modJulianDate -> mjd) where
    UniversalTime mjd = modJulianDate # mjd
#elif __GLASGOW_HASKELL__ >= 708
pattern UniversalTime mjd <- (view modJulianDate -> mjd)
#endif


  ( ' Data . Thyme . Clock .  ' ) and both tick in increments of SI
  > ' utcTime ' ' Control . Lens . # ' ' UTCView ' ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' 2016 1 15 ) ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 12 34 56.78 )
  2016 - 01 - 15 12:34:56.78 UTC
  > ' UTCTime ' ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' 2016 1 15 ) ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 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
  > let t0 = ' mkUTCTime ' 2016 1 15   23 59 0
  > let t1 = ' mkUTCTime ' 2016 1 16   00   1 1
  2016 - 01 - 16 00:03:02 UTC
  2016 - 01 - 16 00:07:04 UTC
  To decompose a ' UTCTime ' into a separate ' Day ' and time - of - day , use
  ' Data . Thyme . LocalTime.zonedTime ' or ' Data . Thyme . LocalTime.utcLocalTime ' .
  Internally ' UTCTime ' is just a 64 - bit count of ' microseconds ' since the
  Modified Julian Day epoch , so @('.+^')@ , @('.-.')@ et cetera ought to be
  " Data . Thyme . Clock . TAI " instead , along with
newtype UTCTime = UTCRep NominalDiffTime deriving (INSTANCES_MICRO)

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

  As of GHC 7.10 , you can also use the ' UTCTime ' pattern synonym .
data UTCView = UTCView
  ^ Time elapsed since midnight ; /0/ ≤ ' utcvDayTime ' < /86401s/.
    } deriving (INSTANCES_USUAL, Show)

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

_utctDay :: Lens' UTCTime Day
_utctDay = utcTime . lens utcvDay
    (\ UTCView {..} d -> UTCView d utcvDayTime)

  | ' Lens '' for the time - of - day ' DiffTime ' component of a ' UTCTime ' .
_utctDayTime :: Lens' UTCTime DiffTime
_utctDayTime = utcTime . lens utcvDayTime
    (\ UTCView {..} t -> UTCView utcvDay t)

utctDay :: UTCTime -> Day
utctDay = view _utctDay

  | Accessor for the time - of - day ' DiffTime ' component of an ' UTCTime ' .
utctDayTime :: UTCTime -> DiffTime
utctDayTime = view _utctDayTime

instance AffineSpace UTCTime where
    type Diff UTCTime = NominalDiffTime
    (.-.) = \ (UTCRep a) (UTCRep b) -> a ^-^ b
    (.+^) = \ (UTCRep a) d -> UTCRep (a ^+^ d)

  a ' DiffTime ' offset since midnight .
  ' UTCView ' { ' utcvDay ' = 2016 - 01 - 15 , ' utcvDayTime ' = 49322.287688s }
  > ' utcTime ' ' Control . Lens . # ' ' UTCView ' ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' 2016 1 15 ) ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' 12 34 56.78 )
  2016 - 01 - 15 12:34:56.78 UTC
  f ( ' view ' ' utcTime ' - > ' UTCView ' day dt ) = ( day , dt )
# INLINE utcTime #
utcTime :: Iso' UTCTime UTCView
utcTime = iso toView fromView where
    NominalDiffTime posixDay@(Micro uPosixDay) = posixDayLength

# INLINE toView #
    toView :: UTCTime -> UTCView
    toView (UTCRep (NominalDiffTime a)) = UTCView
            (ModifiedJulianDay mjd) (DiffTime dt) where
        (fromIntegral -> mjd, dt) = microDivMod a posixDay

# INLINE fromView #
    fromView :: UTCView -> UTCTime
    fromView (UTCView (ModifiedJulianDay mjd) (DiffTime dt)) = UTCRep a where
        a = NominalDiffTime (Micro (fromIntegral mjd * uPosixDay) ^+^ dt)

#if __GLASGOW_HASKELL__ >= 710
pattern UTCTime :: Day -> DiffTime -> UTCTime
pattern UTCTime d t <- (view utcTime -> UTCView d t) where
    UTCTime d t = utcTime # UTCView d t
#elif __GLASGOW_HASKELL__ >= 708
pattern UTCTime d t <- (view utcTime -> UTCView d t)
#endif

      ( ' gregorian ' ' Control . Lens . # ' ' YearMonthDay ' yy mm dd )
      ( ' Data . Thyme .  ' ' Control . Lens . # ' ' Data . Thyme . LocalTime .  ' h m ( ' fromSeconds ' s ) )
# INLINE mkUTCTime #
mkUTCTime :: Year -> Month -> DayOfMonth -> Hour -> Minute -> Double -> UTCTime
mkUTCTime yy mm dd h m s = utcTime # UTCView
    (gregorian # YearMonthDay yy mm dd)
    (fromSeconds (3600 * h + 60 * m) ^+^ fromSeconds s)

