{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ViewPatterns #-}
module Data.Thyme.Time.Core
( module Data.Thyme
, module Data.Thyme.Time.Core
) where
import Prelude
import Control.Lens
import Data.AffineSpace
import Data.Int
import Data.Thyme.Internal.Micro
import Data.Ratio
import Data.Thyme
import Data.Thyme.Calendar.OrdinalDate
import Data.Thyme.Calendar.MonthDay
import Data.Thyme.Calendar.WeekDate
import Data.Thyme.Clock.Internal
import Data.Thyme.Clock.POSIX
import Data.Thyme.Clock.TAI
import qualified Data.Time.Calendar as T
import qualified Data.Time.Clock as T
import qualified Data.Time.Clock.TAI as T
import qualified Data.Time.LocalTime as T
import Unsafe.Coerce
class Thyme a b | b -> a where
thyme :: Iso' a b
instance Thyme T.Day Day where
{-# INLINE thyme #-}
thyme :: Overloaded p f Day Day Day Day
thyme = (Day -> Day) -> (Day -> Day) -> Iso' Day Day
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
(Int -> Day
ModifiedJulianDay (Int -> Day) -> (Day -> Int) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Int
forall a. Num a => Integer -> a
fromInteger (Integer -> Int) -> (Day -> Integer) -> Day -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Integer
T.toModifiedJulianDay)
(Integer -> Day
T.ModifiedJulianDay (Integer -> Day) -> (Day -> Integer) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> (Day -> Int) -> Day -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> Int
toModifiedJulianDay)
instance Thyme T.UniversalTime UniversalTime where
{-# INLINE thyme #-}
thyme :: Overloaded
p f UniversalTime UniversalTime UniversalTime UniversalTime
thyme = (UniversalTime -> Rational)
-> (Rational -> UniversalTime)
-> Iso UniversalTime UniversalTime Rational Rational
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso UniversalTime -> Rational
T.getModJulianDate Rational -> UniversalTime
T.ModJulianDate Overloaded p f UniversalTime UniversalTime Rational Rational
-> (p UniversalTime (f UniversalTime) -> p Rational (f Rational))
-> Overloaded
p f UniversalTime UniversalTime UniversalTime UniversalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso UniversalTime UniversalTime Rational Rational
-> Iso Rational Rational UniversalTime UniversalTime
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso UniversalTime UniversalTime Rational Rational
Iso' UniversalTime Rational
modJulianDate
instance Thyme T.DiffTime DiffTime where
{-# INLINE thyme #-}
thyme :: Overloaded p f DiffTime DiffTime DiffTime DiffTime
thyme = (DiffTime -> Integer)
-> (Integer -> DiffTime) -> Iso DiffTime DiffTime Integer Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DiffTime -> Integer
forall a b. a -> b
unsafeCoerce Integer -> DiffTime
forall a b. a -> b
unsafeCoerce Overloaded p f DiffTime DiffTime Integer Integer
-> (p DiffTime (f DiffTime) -> p Integer (f Integer))
-> Overloaded p f DiffTime DiffTime DiffTime DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso DiffTime DiffTime Integer Integer
-> Iso Integer Integer DiffTime DiffTime
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso DiffTime DiffTime Integer Integer
forall t. TimeDiff t => Iso' t Integer
picoseconds
instance Thyme T.NominalDiffTime NominalDiffTime where
{-# INLINE thyme #-}
thyme :: Overloaded
p f NominalDiffTime NominalDiffTime NominalDiffTime NominalDiffTime
thyme = (NominalDiffTime -> Integer)
-> (Integer -> NominalDiffTime)
-> Iso NominalDiffTime NominalDiffTime Integer Integer
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso NominalDiffTime -> Integer
forall a b. a -> b
unsafeCoerce Integer -> NominalDiffTime
forall a b. a -> b
unsafeCoerce Overloaded p f NominalDiffTime NominalDiffTime Integer Integer
-> (p NominalDiffTime (f NominalDiffTime) -> p Integer (f Integer))
-> Overloaded
p f NominalDiffTime NominalDiffTime NominalDiffTime NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso NominalDiffTime NominalDiffTime Integer Integer
-> Iso Integer Integer NominalDiffTime NominalDiffTime
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso NominalDiffTime NominalDiffTime Integer Integer
forall t. TimeDiff t => Iso' t Integer
picoseconds
instance Thyme T.UTCTime UTCView where
{-# INLINE thyme #-}
thyme :: Overloaded p f UTCTime UTCTime UTCView UTCView
thyme = (UTCTime -> UTCView)
-> (UTCView -> UTCTime) -> Iso' UTCTime UTCView
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
(\ (T.UTCTime d :: Day
d t :: DiffTime
t) -> Day -> DiffTime -> UTCView
UTCTime (Day
d Day -> Getting Day Day Day -> Day
forall s a. s -> Getting a s a -> a
^. Getting Day Day Day
forall a b. Thyme a b => Iso' a b
thyme) (DiffTime
t DiffTime -> Getting DiffTime DiffTime DiffTime -> DiffTime
forall s a. s -> Getting a s a -> a
^. Getting DiffTime DiffTime DiffTime
forall a b. Thyme a b => Iso' a b
thyme))
(\ (UTCTime d :: Day
d t :: DiffTime
t) -> Day -> DiffTime -> UTCTime
T.UTCTime (Overloaded Reviewed Identity Day Day Day Day
forall a b. Thyme a b => Iso' a b
thyme Overloaded Reviewed Identity Day Day Day Day -> Day -> Day
forall s t a b. AReview s t a b -> b -> t
# Day
d) (Overloaded Reviewed Identity DiffTime DiffTime DiffTime DiffTime
forall a b. Thyme a b => Iso' a b
thyme Overloaded Reviewed Identity DiffTime DiffTime DiffTime DiffTime
-> DiffTime -> DiffTime
forall s t a b. AReview s t a b -> b -> t
# DiffTime
t))
instance Thyme T.UTCTime UTCTime where
{-# INLINE thyme #-}
thyme :: Overloaded p f UTCTime UTCTime UTCTime UTCTime
thyme = Overloaded p f UTCTime UTCTime UTCView UTCView
forall a b. Thyme a b => Iso' a b
thyme Overloaded p f UTCTime UTCTime UTCView UTCView
-> (p UTCTime (f UTCTime) -> p UTCView (f UTCView))
-> Overloaded p f UTCTime UTCTime UTCTime UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnIso UTCTime UTCTime UTCView UTCView
-> Iso UTCView UTCView UTCTime UTCTime
forall s t a b. AnIso s t a b -> Iso b a t s
from AnIso UTCTime UTCTime UTCView UTCView
Iso' UTCTime UTCView
utcTime
instance Thyme T.AbsoluteTime AbsoluteTime where
{-# INLINE thyme #-}
thyme :: Overloaded p f AbsoluteTime AbsoluteTime AbsoluteTime AbsoluteTime
thyme = (AbsoluteTime -> DiffTime)
-> (DiffTime -> AbsoluteTime)
-> Iso AbsoluteTime AbsoluteTime DiffTime DiffTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (AbsoluteTime -> AbsoluteTime -> DiffTime
`T.diffAbsoluteTime` AbsoluteTime
T.taiEpoch)
(DiffTime -> AbsoluteTime -> AbsoluteTime
`T.addAbsoluteTime` AbsoluteTime
T.taiEpoch)
Overloaded p f AbsoluteTime AbsoluteTime DiffTime DiffTime
-> (p AbsoluteTime (f AbsoluteTime) -> p DiffTime (f DiffTime))
-> Overloaded
p f AbsoluteTime AbsoluteTime AbsoluteTime AbsoluteTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Overloaded p f DiffTime DiffTime DiffTime DiffTime
forall a b. Thyme a b => Iso' a b
thyme Overloaded p f DiffTime DiffTime DiffTime DiffTime
-> (p AbsoluteTime (f AbsoluteTime) -> p DiffTime (f DiffTime))
-> p AbsoluteTime (f AbsoluteTime)
-> p DiffTime (f DiffTime)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DiffTime -> AbsoluteTime)
-> (AbsoluteTime -> DiffTime)
-> Iso DiffTime DiffTime AbsoluteTime AbsoluteTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (AbsoluteTime
taiEpoch AbsoluteTime -> Diff AbsoluteTime -> AbsoluteTime
forall p. AffineSpace p => p -> Diff p -> p
.+^) (AbsoluteTime -> AbsoluteTime -> Diff AbsoluteTime
forall p. AffineSpace p => p -> p -> Diff p
.-. AbsoluteTime
taiEpoch)
instance Thyme T.TimeZone TimeZone where
{-# INLINE thyme #-}
thyme :: Overloaded p f TimeZone TimeZone TimeZone TimeZone
thyme = (TimeZone -> TimeZone)
-> (TimeZone -> TimeZone) -> Iso' TimeZone TimeZone
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (\ T.TimeZone {..} -> $WTimeZone :: Int -> Bool -> String -> TimeZone
TimeZone {..})
(\ TimeZone {..} -> TimeZone :: Int -> Bool -> String -> TimeZone
T.TimeZone {..})
instance Thyme T.TimeOfDay TimeOfDay where
{-# INLINE thyme #-}
thyme :: Overloaded p f TimeOfDay TimeOfDay TimeOfDay TimeOfDay
thyme = (TimeOfDay -> TimeOfDay)
-> (TimeOfDay -> TimeOfDay) -> Iso' TimeOfDay TimeOfDay
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso ( \ (T.TimeOfDay h :: Int
h m :: Int
m s :: Pico
s) -> Int -> Int -> DiffTime -> TimeOfDay
TimeOfDay Int
h Int
m (DiffTime -> TimeOfDay) -> DiffTime -> TimeOfDay
forall a b. (a -> b) -> a -> b
$
Overloaded Reviewed Identity DiffTime DiffTime Int64 Int64
forall t. TimeDiff t => Iso' t Int64
microseconds Overloaded Reviewed Identity DiffTime DiffTime Int64 Int64
-> Int64 -> DiffTime
forall s t a b. AReview s t a b -> b -> t
# Pico -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
round (Pico
s Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
* 1000000) )
( \ (TimeOfDay h :: Int
h m :: Int
m s :: DiffTime
s) -> Int -> Int -> Pico -> TimeOfDay
T.TimeOfDay Int
h Int
m (Pico -> TimeOfDay) -> (Rational -> Pico) -> Rational -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Pico
forall a. Fractional a => Rational -> a
fromRational (Rational -> TimeOfDay) -> Rational -> TimeOfDay
forall a b. (a -> b) -> a -> b
$
Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (DiffTime
s DiffTime -> Getting Int64 DiffTime Int64 -> Int64
forall s a. s -> Getting a s a -> a
^. Getting Int64 DiffTime Int64
forall t. TimeDiff t => Iso' t Int64
microseconds) Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% 1000000 )
instance Thyme T.LocalTime LocalTime where
{-# INLINE thyme #-}
thyme :: Overloaded p f LocalTime LocalTime LocalTime LocalTime
thyme = (LocalTime -> LocalTime)
-> (LocalTime -> LocalTime) -> Iso' LocalTime LocalTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
(\ (T.LocalTime d :: Day
d t :: TimeOfDay
t) -> Day -> TimeOfDay -> LocalTime
LocalTime (Day
d Day -> Getting Day Day Day -> Day
forall s a. s -> Getting a s a -> a
^. Getting Day Day Day
forall a b. Thyme a b => Iso' a b
thyme) (TimeOfDay
t TimeOfDay -> Getting TimeOfDay TimeOfDay TimeOfDay -> TimeOfDay
forall s a. s -> Getting a s a -> a
^. Getting TimeOfDay TimeOfDay TimeOfDay
forall a b. Thyme a b => Iso' a b
thyme))
(\ (LocalTime d :: Day
d t :: TimeOfDay
t) -> Day -> TimeOfDay -> LocalTime
T.LocalTime (Overloaded Reviewed Identity Day Day Day Day
forall a b. Thyme a b => Iso' a b
thyme Overloaded Reviewed Identity Day Day Day Day -> Day -> Day
forall s t a b. AReview s t a b -> b -> t
# Day
d) (Overloaded
Reviewed Identity TimeOfDay TimeOfDay TimeOfDay TimeOfDay
forall a b. Thyme a b => Iso' a b
thyme Overloaded
Reviewed Identity TimeOfDay TimeOfDay TimeOfDay TimeOfDay
-> TimeOfDay -> TimeOfDay
forall s t a b. AReview s t a b -> b -> t
# TimeOfDay
t))
instance Thyme T.ZonedTime ZonedTime where
{-# INLINE thyme #-}
thyme :: Overloaded p f ZonedTime ZonedTime ZonedTime ZonedTime
thyme = (ZonedTime -> ZonedTime)
-> (ZonedTime -> ZonedTime) -> Iso' ZonedTime ZonedTime
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso
(\ (T.ZonedTime t :: LocalTime
t z :: TimeZone
z) -> LocalTime -> TimeZone -> ZonedTime
ZonedTime (LocalTime
t LocalTime -> Getting LocalTime LocalTime LocalTime -> LocalTime
forall s a. s -> Getting a s a -> a
^. Getting LocalTime LocalTime LocalTime
forall a b. Thyme a b => Iso' a b
thyme) (TimeZone
z TimeZone -> Getting TimeZone TimeZone TimeZone -> TimeZone
forall s a. s -> Getting a s a -> a
^. Getting TimeZone TimeZone TimeZone
forall a b. Thyme a b => Iso' a b
thyme))
(\ (ZonedTime t :: LocalTime
t z :: TimeZone
z) -> LocalTime -> TimeZone -> ZonedTime
T.ZonedTime (Overloaded
Reviewed Identity LocalTime LocalTime LocalTime LocalTime
forall a b. Thyme a b => Iso' a b
thyme Overloaded
Reviewed Identity LocalTime LocalTime LocalTime LocalTime
-> LocalTime -> LocalTime
forall s t a b. AReview s t a b -> b -> t
# LocalTime
t) (Overloaded Reviewed Identity TimeZone TimeZone TimeZone TimeZone
forall a b. Thyme a b => Iso' a b
thyme Overloaded Reviewed Identity TimeZone TimeZone TimeZone TimeZone
-> TimeZone -> TimeZone
forall s t a b. AReview s t a b -> b -> t
# TimeZone
z))
{-# INLINE toThyme #-}
toThyme :: (Thyme a b) => a -> b
toThyme :: a -> b
toThyme = Getting b a b -> a -> b
forall a s. Getting a s a -> s -> a
view Getting b a b
forall a b. Thyme a b => Iso' a b
thyme
{-# INLINE fromThyme #-}
fromThyme :: (Thyme a b) => b -> a
fromThyme :: b -> a
fromThyme = AReview a a b b -> b -> a
forall s t a b. AReview s t a b -> b -> t
review AReview a a b b
forall a b. Thyme a b => Iso' a b
thyme
{-# INLINE addDays #-}
addDays :: Days -> Day -> Day
addDays :: Int -> Day -> Day
addDays = (Day -> Int -> Day) -> Int -> Day -> Day
forall a b c. (a -> b -> c) -> b -> a -> c
flip Day -> Int -> Day
forall p. AffineSpace p => p -> Diff p -> p
(.+^)
{-# INLINE diffDays #-}
diffDays :: Day -> Day -> Days
diffDays :: Day -> Day -> Int
diffDays = Day -> Day -> Int
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
{-# INLINE toGregorian #-}
toGregorian :: Day -> (Year, Month, DayOfMonth)
toGregorian :: Day -> (Int, Int, Int)
toGregorian (Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
forall a s. Getting a s a -> s -> a
view Getting YearMonthDay Day YearMonthDay
Iso' Day YearMonthDay
gregorian -> YearMonthDay y :: Int
y m :: Int
m d :: Int
d) = (Int
y, Int
m, Int
d)
{-# INLINE fromGregorian #-}
fromGregorian :: Year -> Month -> DayOfMonth -> Day
fromGregorian :: Int -> Int -> Int -> Day
fromGregorian y :: Int
y m :: Int
m d :: Int
d = 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
# Int -> Int -> Int -> YearMonthDay
YearMonthDay Int
y Int
m Int
d
{-# INLINE fromGregorianValid #-}
fromGregorianValid :: Year -> Month -> DayOfMonth -> Maybe Day
fromGregorianValid :: Int -> Int -> Int -> Maybe Day
fromGregorianValid y :: Int
y m :: Int
m d :: Int
d = YearMonthDay -> Maybe Day
gregorianValid (Int -> Int -> Int -> YearMonthDay
YearMonthDay Int
y Int
m Int
d)
{-# INLINE addGregorianMonthsClip #-}
addGregorianMonthsClip :: Months -> Day -> Day
addGregorianMonthsClip :: Int -> Day -> Day
addGregorianMonthsClip n :: Int
n = Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
-> YearMonthDay -> Day
forall s t a b. AReview s t a b -> b -> t
review Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
Iso' Day YearMonthDay
gregorian
(YearMonthDay -> Day) -> (Day -> YearMonthDay) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YearMonthDay -> YearMonthDay
gregorianMonthsClip Int
n (YearMonthDay -> YearMonthDay)
-> (Day -> YearMonthDay) -> Day -> YearMonthDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
forall a s. Getting a s a -> s -> a
view Getting YearMonthDay Day YearMonthDay
Iso' Day YearMonthDay
gregorian
{-# INLINE addGregorianMonthsRollover #-}
addGregorianMonthsRollover :: Months -> Day -> Day
addGregorianMonthsRollover :: Int -> Day -> Day
addGregorianMonthsRollover n :: Int
n = Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
-> YearMonthDay -> Day
forall s t a b. AReview s t a b -> b -> t
review Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
Iso' Day YearMonthDay
gregorian
(YearMonthDay -> Day) -> (Day -> YearMonthDay) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YearMonthDay -> YearMonthDay
gregorianMonthsRollover Int
n (YearMonthDay -> YearMonthDay)
-> (Day -> YearMonthDay) -> Day -> YearMonthDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
forall a s. Getting a s a -> s -> a
view Getting YearMonthDay Day YearMonthDay
Iso' Day YearMonthDay
gregorian
{-# INLINE addGregorianYearsClip #-}
addGregorianYearsClip :: Years -> Day -> Day
addGregorianYearsClip :: Int -> Day -> Day
addGregorianYearsClip n :: Int
n = Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
-> YearMonthDay -> Day
forall s t a b. AReview s t a b -> b -> t
review Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
Iso' Day YearMonthDay
gregorian
(YearMonthDay -> Day) -> (Day -> YearMonthDay) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YearMonthDay -> YearMonthDay
gregorianYearsClip Int
n (YearMonthDay -> YearMonthDay)
-> (Day -> YearMonthDay) -> Day -> YearMonthDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
forall a s. Getting a s a -> s -> a
view Getting YearMonthDay Day YearMonthDay
Iso' Day YearMonthDay
gregorian
{-# INLINE addGregorianYearsRollover #-}
addGregorianYearsRollover :: Years -> Day -> Day
addGregorianYearsRollover :: Int -> Day -> Day
addGregorianYearsRollover n :: Int
n = Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
-> YearMonthDay -> Day
forall s t a b. AReview s t a b -> b -> t
review Overloaded Reviewed Identity Day Day YearMonthDay YearMonthDay
Iso' Day YearMonthDay
gregorian
(YearMonthDay -> Day) -> (Day -> YearMonthDay) -> Day -> Day
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> YearMonthDay -> YearMonthDay
gregorianYearsRollover Int
n (YearMonthDay -> YearMonthDay)
-> (Day -> YearMonthDay) -> Day -> YearMonthDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting YearMonthDay Day YearMonthDay -> Day -> YearMonthDay
forall a s. Getting a s a -> s -> a
view Getting YearMonthDay Day YearMonthDay
Iso' Day YearMonthDay
gregorian
{-# INLINE dayOfYearToMonthAndDay #-}
dayOfYearToMonthAndDay :: Bool -> DayOfYear -> (Month, DayOfMonth)
dayOfYearToMonthAndDay :: Bool -> Int -> (Int, Int)
dayOfYearToMonthAndDay leap :: Bool
leap (Getting MonthDay Int MonthDay -> Int -> MonthDay
forall a s. Getting a s a -> s -> a
view (Bool -> Iso' Int MonthDay
monthDay Bool
leap) -> MonthDay m :: Int
m d :: Int
d) = (Int
m, Int
d)
{-# INLINE monthAndDayToDayOfYear #-}
monthAndDayToDayOfYear :: Bool -> Month -> DayOfMonth -> DayOfYear
monthAndDayToDayOfYear :: Bool -> Int -> Int -> Int
monthAndDayToDayOfYear leap :: Bool
leap m :: Int
m d :: Int
d = Bool -> Iso' Int MonthDay
monthDay Bool
leap Overloaded Reviewed Identity Int Int MonthDay MonthDay
-> MonthDay -> Int
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> MonthDay
MonthDay Int
m Int
d
{-# INLINE monthAndDayToDayOfYearValid #-}
monthAndDayToDayOfYearValid :: Bool -> Month -> DayOfMonth -> Maybe DayOfYear
monthAndDayToDayOfYearValid :: Bool -> Int -> Int -> Maybe Int
monthAndDayToDayOfYearValid leap :: Bool
leap m :: Int
m d :: Int
d = Bool -> MonthDay -> Maybe Int
monthDayValid Bool
leap (Int -> Int -> MonthDay
MonthDay Int
m Int
d)
{-# INLINE toOrdinalDate #-}
toOrdinalDate :: Day -> (Year, DayOfYear)
toOrdinalDate :: Day -> (Int, Int)
toOrdinalDate (Getting OrdinalDate Day OrdinalDate -> Day -> OrdinalDate
forall a s. Getting a s a -> s -> a
view Getting OrdinalDate Day OrdinalDate
Iso' Day OrdinalDate
ordinalDate -> OrdinalDate y :: Int
y d :: Int
d) = (Int
y, Int
d)
{-# INLINE fromOrdinalDate #-}
fromOrdinalDate :: Year -> DayOfYear -> Day
fromOrdinalDate :: Int -> Int -> Day
fromOrdinalDate y :: Int
y d :: Int
d = Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
Iso' Day OrdinalDate
ordinalDate Overloaded Reviewed Identity Day Day OrdinalDate OrdinalDate
-> OrdinalDate -> Day
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
d
{-# INLINE fromOrdinalDateValid #-}
fromOrdinalDateValid :: Year -> DayOfYear -> Maybe Day
fromOrdinalDateValid :: Int -> Int -> Maybe Day
fromOrdinalDateValid y :: Int
y d :: Int
d = OrdinalDate -> Maybe Day
ordinalDateValid (Int -> Int -> OrdinalDate
OrdinalDate Int
y Int
d)
{-# INLINE sundayStartWeek #-}
sundayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)
sundayStartWeek :: Day -> (Int, Int, Int)
sundayStartWeek (Getting SundayWeek Day SundayWeek -> Day -> SundayWeek
forall a s. Getting a s a -> s -> a
view Getting SundayWeek Day SundayWeek
Iso' Day SundayWeek
sundayWeek -> SundayWeek y :: Int
y w :: Int
w d :: Int
d) = (Int
y, Int
w, Int
d)
{-# INLINE fromSundayStartWeek #-}
fromSundayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day
fromSundayStartWeek :: Int -> Int -> Int -> Day
fromSundayStartWeek y :: Int
y w :: Int
w d :: Int
d = Overloaded Reviewed Identity Day Day SundayWeek SundayWeek
Iso' Day SundayWeek
sundayWeek Overloaded Reviewed Identity Day Day SundayWeek SundayWeek
-> SundayWeek -> Day
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> Int -> SundayWeek
SundayWeek Int
y Int
w Int
d
{-# INLINE fromSundayStartWeekValid #-}
fromSundayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromSundayStartWeekValid :: Int -> Int -> Int -> Maybe Day
fromSundayStartWeekValid y :: Int
y w :: Int
w d :: Int
d = SundayWeek -> Maybe Day
sundayWeekValid (Int -> Int -> Int -> SundayWeek
SundayWeek Int
y Int
w Int
d)
{-# INLINE mondayStartWeek #-}
mondayStartWeek :: Day -> (Year, WeekOfYear, DayOfWeek)
mondayStartWeek :: Day -> (Int, Int, Int)
mondayStartWeek (Getting MondayWeek Day MondayWeek -> Day -> MondayWeek
forall a s. Getting a s a -> s -> a
view Getting MondayWeek Day MondayWeek
Iso' Day MondayWeek
mondayWeek -> MondayWeek y :: Int
y w :: Int
w d :: Int
d) = (Int
y, Int
w, Int
d)
{-# INLINE fromMondayStartWeek #-}
fromMondayStartWeek :: Year -> WeekOfYear -> DayOfWeek -> Day
fromMondayStartWeek :: Int -> Int -> Int -> Day
fromMondayStartWeek y :: Int
y w :: Int
w d :: Int
d = Overloaded Reviewed Identity Day Day MondayWeek MondayWeek
Iso' Day MondayWeek
mondayWeek Overloaded Reviewed Identity Day Day MondayWeek MondayWeek
-> MondayWeek -> Day
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> Int -> MondayWeek
MondayWeek Int
y Int
w Int
d
{-# INLINE fromMondayStartWeekValid #-}
fromMondayStartWeekValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromMondayStartWeekValid :: Int -> Int -> Int -> Maybe Day
fromMondayStartWeekValid y :: Int
y w :: Int
w d :: Int
d = MondayWeek -> Maybe Day
mondayWeekValid (Int -> Int -> Int -> MondayWeek
MondayWeek Int
y Int
w Int
d)
{-# INLINE toWeekDate #-}
toWeekDate :: Day -> (Year, WeekOfYear, DayOfWeek)
toWeekDate :: Day -> (Int, Int, Int)
toWeekDate (Getting WeekDate Day WeekDate -> Day -> WeekDate
forall a s. Getting a s a -> s -> a
view Getting WeekDate Day WeekDate
Iso' Day WeekDate
weekDate -> WeekDate y :: Int
y w :: Int
w d :: Int
d) = (Int
y, Int
w, Int
d)
{-# INLINE fromWeekDate #-}
fromWeekDate :: Year -> WeekOfYear -> DayOfWeek -> Day
fromWeekDate :: Int -> Int -> Int -> Day
fromWeekDate y :: Int
y w :: Int
w d :: Int
d = Overloaded Reviewed Identity Day Day WeekDate WeekDate
Iso' Day WeekDate
weekDate Overloaded Reviewed Identity Day Day WeekDate WeekDate
-> WeekDate -> Day
forall s t a b. AReview s t a b -> b -> t
# Int -> Int -> Int -> WeekDate
WeekDate Int
y Int
w Int
d
{-# INLINE fromWeekDateValid #-}
fromWeekDateValid :: Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromWeekDateValid :: Int -> Int -> Int -> Maybe Day
fromWeekDateValid y :: Int
y w :: Int
w d :: Int
d = WeekDate -> Maybe Day
weekDateValid (Int -> Int -> Int -> WeekDate
WeekDate Int
y Int
w Int
d)
{-# 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
{-# 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
{-# INLINE secondsToDiffTime #-}
secondsToDiffTime :: Int64 -> DiffTime
secondsToDiffTime :: Int64 -> DiffTime
secondsToDiffTime a :: Int64
a = Micro -> DiffTime
DiffTime (Int64 -> Micro
Micro (Int64 -> Micro) -> Int64 -> Micro
forall a b. (a -> b) -> a -> b
$ Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* 1000000)
{-# INLINE picosecondsToDiffTime #-}
picosecondsToDiffTime :: Int64 -> DiffTime
picosecondsToDiffTime :: Int64 -> DiffTime
picosecondsToDiffTime a :: Int64
a = Micro -> DiffTime
DiffTime (Micro -> DiffTime) -> (Int64 -> Micro) -> Int64 -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Micro
Micro (Int64 -> DiffTime) -> Int64 -> DiffTime
forall a b. (a -> b) -> a -> b
$
Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
quot (Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64 -> Int64
forall a. Num a => a -> a
signum Int64
a Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* 500000) 1000000
{-# INLINE mkUTCTime #-}
mkUTCTime :: Day -> DiffTime -> UTCTime
mkUTCTime :: Day -> DiffTime -> UTCTime
mkUTCTime d :: Day
d t :: 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
UTCTime Day
d DiffTime
t
{-# 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
{-# INLINE addUTCTime #-}
addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime
addUTCTime :: NominalDiffTime -> UTCTime -> UTCTime
addUTCTime = (UTCTime -> NominalDiffTime -> UTCTime)
-> NominalDiffTime -> UTCTime -> UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip UTCTime -> NominalDiffTime -> UTCTime
forall p. AffineSpace p => p -> Diff p -> p
(.+^)
{-# INLINE diffUTCTime #-}
diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime :: UTCTime -> UTCTime -> NominalDiffTime
diffUTCTime = UTCTime -> UTCTime -> NominalDiffTime
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
{-# INLINE toMicroseconds #-}
toMicroseconds :: (TimeDiff t) => t -> Int64
toMicroseconds :: 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
microseconds
{-# INLINE fromMicroseconds #-}
fromMicroseconds :: (TimeDiff t) => Int64 -> t
fromMicroseconds :: 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
microseconds
{-# INLINE posixSecondsToUTCTime #-}
posixSecondsToUTCTime :: POSIXTime -> UTCTime
posixSecondsToUTCTime :: NominalDiffTime -> UTCTime
posixSecondsToUTCTime = AReview UTCTime UTCTime NominalDiffTime NominalDiffTime
-> NominalDiffTime -> UTCTime
forall s t a b. AReview s t a b -> b -> t
review AReview UTCTime UTCTime NominalDiffTime NominalDiffTime
Iso' UTCTime NominalDiffTime
posixTime
{-# INLINE utcTimeToPOSIXSeconds #-}
utcTimeToPOSIXSeconds :: UTCTime -> POSIXTime
utcTimeToPOSIXSeconds :: UTCTime -> NominalDiffTime
utcTimeToPOSIXSeconds = Getting NominalDiffTime UTCTime NominalDiffTime
-> UTCTime -> NominalDiffTime
forall a s. Getting a s a -> s -> a
view Getting NominalDiffTime UTCTime NominalDiffTime
Iso' UTCTime NominalDiffTime
posixTime
{-# INLINE addAbsoluteTime #-}
addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime :: DiffTime -> AbsoluteTime -> AbsoluteTime
addAbsoluteTime = (AbsoluteTime -> DiffTime -> AbsoluteTime)
-> DiffTime -> AbsoluteTime -> AbsoluteTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip AbsoluteTime -> DiffTime -> AbsoluteTime
forall p. AffineSpace p => p -> Diff p -> p
(.+^)
{-# INLINE diffAbsoluteTime #-}
diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime :: AbsoluteTime -> AbsoluteTime -> DiffTime
diffAbsoluteTime = AbsoluteTime -> AbsoluteTime -> DiffTime
forall p. AffineSpace p => p -> p -> Diff p
(.-.)
{-# INLINE utcToTAITime #-}
utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime
utcToTAITime :: LeapSecondTable -> UTCTime -> AbsoluteTime
utcToTAITime = Getting AbsoluteTime UTCTime AbsoluteTime
-> UTCTime -> AbsoluteTime
forall a s. Getting a s a -> s -> a
view (Getting AbsoluteTime UTCTime AbsoluteTime
-> UTCTime -> AbsoluteTime)
-> (LeapSecondTable -> Getting AbsoluteTime UTCTime AbsoluteTime)
-> LeapSecondTable
-> UTCTime
-> AbsoluteTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeapSecondTable -> Getting AbsoluteTime UTCTime AbsoluteTime
LeapSecondTable -> Iso' UTCTime AbsoluteTime
absoluteTime
{-# INLINE taiToUTCTime #-}
taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime
taiToUTCTime :: LeapSecondTable -> AbsoluteTime -> UTCTime
taiToUTCTime = AReview UTCTime UTCTime AbsoluteTime AbsoluteTime
-> AbsoluteTime -> UTCTime
forall s t a b. AReview s t a b -> b -> t
review (AReview UTCTime UTCTime AbsoluteTime AbsoluteTime
-> AbsoluteTime -> UTCTime)
-> (LeapSecondTable
-> AReview UTCTime UTCTime AbsoluteTime AbsoluteTime)
-> LeapSecondTable
-> AbsoluteTime
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeapSecondTable
-> AReview UTCTime UTCTime AbsoluteTime AbsoluteTime
LeapSecondTable -> Iso' UTCTime AbsoluteTime
absoluteTime
{-# INLINE utcToLocalTimeOfDay #-}
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Int, TimeOfDay)
utcToLocalTimeOfDay = Int -> TimeOfDay -> (Int, TimeOfDay)
addMinutes (Int -> TimeOfDay -> (Int, TimeOfDay))
-> (TimeZone -> Int) -> TimeZone -> TimeOfDay -> (Int, TimeOfDay)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Int
timeZoneMinutes
{-# INLINE localToUTCTimeOfDay #-}
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Int, TimeOfDay)
localToUTCTimeOfDay = Int -> TimeOfDay -> (Int, TimeOfDay)
addMinutes (Int -> TimeOfDay -> (Int, TimeOfDay))
-> (TimeZone -> Int) -> TimeZone -> TimeOfDay -> (Int, TimeOfDay)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> (TimeZone -> Int) -> TimeZone -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Int
timeZoneMinutes
{-# INLINE timeToTimeOfDay #-}
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay = Getting TimeOfDay DiffTime TimeOfDay -> DiffTime -> TimeOfDay
forall a s. Getting a s a -> s -> a
view Getting TimeOfDay DiffTime TimeOfDay
Iso' DiffTime TimeOfDay
timeOfDay
{-# INLINE timeOfDayToTime #-}
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime = AReview DiffTime DiffTime TimeOfDay TimeOfDay
-> TimeOfDay -> DiffTime
forall s t a b. AReview s t a b -> b -> t
review AReview DiffTime DiffTime TimeOfDay TimeOfDay
Iso' DiffTime TimeOfDay
timeOfDay
{-# INLINE dayFractionToTimeOfDay #-}
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay = AReview TimeOfDay TimeOfDay Rational Rational
-> Rational -> TimeOfDay
forall s t a b. AReview s t a b -> b -> t
review AReview TimeOfDay TimeOfDay Rational Rational
Iso' TimeOfDay Rational
dayFraction
{-# INLINE timeOfDayToDayFraction #-}
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction = Getting Rational TimeOfDay Rational -> TimeOfDay -> Rational
forall a s. Getting a s a -> s -> a
view Getting Rational TimeOfDay Rational
Iso' TimeOfDay Rational
dayFraction
{-# INLINE utcToLocalTime #-}
utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
utcToLocalTime = Getting LocalTime UTCTime LocalTime -> UTCTime -> LocalTime
forall a s. Getting a s a -> s -> a
view (Getting LocalTime UTCTime LocalTime -> UTCTime -> LocalTime)
-> (TimeZone -> Getting LocalTime UTCTime LocalTime)
-> TimeZone
-> UTCTime
-> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> Getting LocalTime UTCTime LocalTime
TimeZone -> Iso' UTCTime LocalTime
utcLocalTime
{-# INLINE localTimeToUTC #-}
localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
localTimeToUTC = AReview UTCTime UTCTime LocalTime LocalTime -> LocalTime -> UTCTime
forall s t a b. AReview s t a b -> b -> t
review (AReview UTCTime UTCTime LocalTime LocalTime
-> LocalTime -> UTCTime)
-> (TimeZone -> AReview UTCTime UTCTime LocalTime LocalTime)
-> TimeZone
-> LocalTime
-> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> AReview UTCTime UTCTime LocalTime LocalTime
TimeZone -> Iso' UTCTime LocalTime
utcLocalTime
{-# INLINE ut1ToLocalTime #-}
ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
ut1ToLocalTime = Getting LocalTime UniversalTime LocalTime
-> UniversalTime -> LocalTime
forall a s. Getting a s a -> s -> a
view (Getting LocalTime UniversalTime LocalTime
-> UniversalTime -> LocalTime)
-> (Rational -> Getting LocalTime UniversalTime LocalTime)
-> Rational
-> UniversalTime
-> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> Getting LocalTime UniversalTime LocalTime
Rational -> Iso' UniversalTime LocalTime
ut1LocalTime
{-# INLINE localTimeToUT1 #-}
localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
localTimeToUT1 = AReview UniversalTime UniversalTime LocalTime LocalTime
-> LocalTime -> UniversalTime
forall s t a b. AReview s t a b -> b -> t
review (AReview UniversalTime UniversalTime LocalTime LocalTime
-> LocalTime -> UniversalTime)
-> (Rational
-> AReview UniversalTime UniversalTime LocalTime LocalTime)
-> Rational
-> LocalTime
-> UniversalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> AReview UniversalTime UniversalTime LocalTime LocalTime
Rational -> Iso' UniversalTime LocalTime
ut1LocalTime
{-# INLINE utcToZonedTime #-}
utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime
utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime
utcToZonedTime z :: TimeZone
z t :: UTCTime
t = Getting ZonedTime (TimeZone, UTCTime) ZonedTime
-> (TimeZone, UTCTime) -> ZonedTime
forall a s. Getting a s a -> s -> a
view Getting ZonedTime (TimeZone, UTCTime) ZonedTime
Iso' (TimeZone, UTCTime) ZonedTime
zonedTime (TimeZone
z, UTCTime
t)
{-# INLINE zonedTimeToUTC #-}
zonedTimeToUTC :: ZonedTime -> UTCTime
zonedTimeToUTC :: ZonedTime -> UTCTime
zonedTimeToUTC = (TimeZone, UTCTime) -> UTCTime
forall a b. (a, b) -> b
snd ((TimeZone, UTCTime) -> UTCTime)
-> (ZonedTime -> (TimeZone, UTCTime)) -> ZonedTime -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AReview (TimeZone, UTCTime) (TimeZone, UTCTime) ZonedTime ZonedTime
-> ZonedTime -> (TimeZone, UTCTime)
forall s t a b. AReview s t a b -> b -> t
review AReview (TimeZone, UTCTime) (TimeZone, UTCTime) ZonedTime ZonedTime
Iso' (TimeZone, UTCTime) ZonedTime
zonedTime