{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

#include "thyme.h"
#if HLINT
#include "cabal_macros.h"
#endif

-- | Local time and time zones.
module Data.Thyme.LocalTime
    ( Hour, Minute
    , module Data.Thyme.LocalTime
    ) where

import Prelude hiding ((.))
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative
#endif
import Control.Arrow
import Control.Category hiding (id)
import Control.DeepSeq
import Control.Lens
import Control.Monad
import Data.AffineSpace
import Data.Bits
import Data.Data
import Data.Hashable
import Data.Int
import Data.Thyme.Internal.Micro
import Data.Thyme.Calendar
import Data.Thyme.Calendar.Internal
import Data.Thyme.Clock
import Data.Thyme.Clock.Internal
import Data.Thyme.Format.Internal
import qualified Data.Time as T
#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 hiding ((.&.))

-- | Hours duration.
type Hours = Int
-- | Minutes duration.
type Minutes = Int

------------------------------------------------------------------------
-- * Time Zones

-- | Description of one time zone.
--
-- A 'TimeZone' is a whole number of minutes offset from UTC, together with
-- a name and a ‘summer time’ flag.
data TimeZone = TimeZone
    { TimeZone -> Minutes
timeZoneMinutes :: {-# UNPACK #-}!Minutes
    -- ^ The number of minutes offset from UTC.
    , TimeZone -> Bool
timeZoneSummerOnly :: !Bool
    -- ^ Is this a summer-only (i.e. daylight savings) time zone?
    , TimeZone -> String
timeZoneName :: String
    -- ^ The name of the zone, typically a three- or four-letter acronym.
    } deriving (INSTANCES_USUAL)

LENS(TimeZone,timeZoneMinutes,Minutes)
LENS(TimeZone,timeZoneSummerOnly,Bool)
LENS(TimeZone,timeZoneName,String)

instance Hashable TimeZone
instance NFData TimeZone

#if SHOW_INTERNAL
deriving instance Show TimeZone
#else
instance Show TimeZone where
    show :: TimeZone -> String
show tz :: TimeZone
tz@TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneMinutes :: TimeZone -> Minutes
..} = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
timeZoneName
        then TimeZone -> String
timeZoneOffsetString TimeZone
tz else String
timeZoneName
#endif

instance Bounded TimeZone where
    minBound :: TimeZone
minBound = Minutes -> Bool -> String -> TimeZone
TimeZone (-Minutes
12 forall a. Num a => a -> a -> a
* Minutes
60) forall a. Bounded a => a
minBound String
"AAAA"
    maxBound :: TimeZone
maxBound = Minutes -> Bool -> String -> TimeZone
TimeZone (Minutes
13 forall a. Num a => a -> a -> a
* Minutes
60) forall a. Bounded a => a
maxBound String
"ZZZZ"

instance Random TimeZone where
    randomR :: forall g. RandomGen g => (TimeZone, TimeZone) -> g -> (TimeZone, g)
randomR (TimeZone
l, TimeZone
u) g
g0 = (Minutes -> Bool -> String -> TimeZone
TimeZone Minutes
minutes Bool
summer String
name, g
g3) where
        (Minutes
minutes, g
g1) = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (TimeZone -> Minutes
timeZoneMinutes TimeZone
l, TimeZone -> Minutes
timeZoneMinutes TimeZone
u) g
g0
        (Bool
summer, g
g2) = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (TimeZone -> Bool
timeZoneSummerOnly TimeZone
l, TimeZone -> Bool
timeZoneSummerOnly TimeZone
u) g
g1
        -- slightly dubious interpretation of ‘range’
        (String
name, g
g3) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {g}.
(Random a, RandomGen g) =>
(a, a) -> ([a], g) -> ([a], g)
randChar ([], g
g2) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Minutes -> [a] -> [a]
take Minutes
4 forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip
            (TimeZone -> String
timeZoneName TimeZone
l forall a. [a] -> [a] -> [a]
++ String
"AAAA") (TimeZone -> String
timeZoneName TimeZone
u forall a. [a] -> [a] -> [a]
++ String
"ZZZZ")
        randChar :: (a, a) -> ([a], g) -> ([a], g)
randChar (a, a)
nR ([a]
ns, g
g) = (forall a. a -> [a] -> [a]
: [a]
ns) forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
`first` forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (a, a)
nR g
g
    random :: forall g. RandomGen g => g -> (TimeZone, g)
random = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)

instance Arbitrary TimeZone where
    arbitrary :: Gen TimeZone
arbitrary = forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
    shrink :: TimeZone -> [TimeZone]
shrink tz :: TimeZone
tz@TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneMinutes :: TimeZone -> Minutes
..}
        = [ TimeZone
tz {timeZoneSummerOnly :: Bool
timeZoneSummerOnly = Bool
s} | Bool
s <- forall a. Arbitrary a => a -> [a]
shrink Bool
timeZoneSummerOnly ]
        forall a. [a] -> [a] -> [a]
++ [ TimeZone
tz {timeZoneMinutes :: Minutes
timeZoneMinutes = Minutes
m} | Minutes
m <- forall a. Arbitrary a => a -> [a]
shrink Minutes
timeZoneMinutes ]
        forall a. [a] -> [a] -> [a]
++ [ TimeZone
tz {timeZoneName :: String
timeZoneName = String
n} | String
n <- forall a. Arbitrary a => a -> [a]
shrink String
timeZoneName ]

instance CoArbitrary TimeZone where
    coarbitrary :: forall b. TimeZone -> Gen b -> Gen b
coarbitrary (TimeZone Minutes
m Bool
s String
n)
        = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Minutes
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Bool
s forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary String
n

-- | Text representing the offset of this timezone, e.g. \"-0800\" or
-- \"+0400\" (like @%z@ in 'Data.Thyme.Format.formatTime')
{-# INLINEABLE timeZoneOffsetString #-}
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneMinutes :: TimeZone -> Minutes
..} = Char
sign forall a. a -> [a] -> [a]
: (Minutes -> ShowS
shows02 Minutes
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Minutes -> ShowS
shows02 Minutes
m) String
"" where
    (Minutes
h, Minutes
m) = forall a. Integral a => a -> a -> (a, a)
divMod Minutes
offset Minutes
60
    (Char
sign, Minutes
offset) = if Minutes
timeZoneMinutes forall a. Ord a => a -> a -> Bool
< Minutes
0
        then (Char
'-', forall a. Num a => a -> a
negate Minutes
timeZoneMinutes) else (Char
'+', Minutes
timeZoneMinutes)

-- | Text representing the offset of this timezone in ISO 8601 style,
-- e.g. \"-08:00\" or
-- \"+04:00\" (like @%N@ in 'Data.Thyme.Format.formatTime')
{-# INLINEABLE timeZoneOffsetStringColon #-}
timeZoneOffsetStringColon :: TimeZone -> String
timeZoneOffsetStringColon :: TimeZone -> String
timeZoneOffsetStringColon TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneMinutes :: TimeZone -> Minutes
..} =
    Char
sign forall a. a -> [a] -> [a]
: (Minutes -> ShowS
shows02 Minutes
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) Char
':' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Minutes -> ShowS
shows02 Minutes
m) String
"" where
    (Minutes
h, Minutes
m) = forall a. Integral a => a -> a -> (a, a)
divMod Minutes
offset Minutes
60
    (Char
sign, Minutes
offset) = if Minutes
timeZoneMinutes forall a. Ord a => a -> a -> Bool
< Minutes
0
        then (Char
'-', forall a. Num a => a -> a
negate Minutes
timeZoneMinutes) else (Char
'+', Minutes
timeZoneMinutes)

-- | Create a nameless non-summer timezone for this number of minutes
minutesToTimeZone :: Minutes -> TimeZone
minutesToTimeZone :: Minutes -> TimeZone
minutesToTimeZone Minutes
m = Minutes -> Bool -> String -> TimeZone
TimeZone Minutes
m Bool
False String
""

-- | Create a nameless non-summer timezone for this number of hours
hoursToTimeZone :: Hours -> TimeZone
hoursToTimeZone :: Minutes -> TimeZone
hoursToTimeZone Minutes
i = Minutes -> TimeZone
minutesToTimeZone (Minutes
60 forall a. Num a => a -> a -> a
* Minutes
i)

-- | The UTC (Zulu) time zone.
--
-- @
-- 'utc' = 'TimeZone' 0 'False' \"UTC\"
-- @
utc :: TimeZone
utc :: TimeZone
utc = Minutes -> Bool -> String -> TimeZone
TimeZone Minutes
0 Bool
False String
"UTC"

-- | Get the local time zone at the given time, varying as per summer time
-- adjustments.
--
-- Performed by
-- <https://www.gnu.org/software/libc/manual/html_node/Broken_002ddown-Time.html localtime_r>
-- or a similar call.
{-# INLINEABLE getTimeZone #-}
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone UTCTime
t = TimeZone -> TimeZone
thyme forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` UTCTime -> IO TimeZone
T.getTimeZone (Day -> DiffTime -> UTCTime
T.UTCTime Day
day forall a b. (a -> b) -> a -> b
$ forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds DiffTime
dt) where
    day :: Day
day = Integer -> Day
T.ModifiedJulianDay (forall a. Integral a => a -> Integer
toInteger Minutes
mjd)
    UTCView (ModifiedJulianDay Minutes
mjd) DiffTime
dt = UTCTime
t forall s a. s -> Getting a s a -> a
^. Iso' UTCTime UTCView
utcTime
    thyme :: TimeZone -> TimeZone
thyme T.TimeZone {Bool
Minutes
String
timeZoneMinutes :: TimeZone -> Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
..} = TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
..}

-- | Get the current local time zone.
--
-- @
-- 'getCurrentTimeZone' = 'getCurrentTime' >>= 'getTimeZone'
-- @
--
-- @
-- > 'getCurrentTimeZone'
-- JST
-- @
{-# INLINE getCurrentTimeZone #-}
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone = IO UTCTime
getCurrentTime forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTCTime -> IO TimeZone
getTimeZone

------------------------------------------------------------------------
-- * Time of Day

-- | Time of day in hour, minute, second.
data TimeOfDay = TimeOfDay
    { TimeOfDay -> Minutes
todHour :: {-# UNPACK #-}!Hour
    , TimeOfDay -> Minutes
todMin :: {-# UNPACK #-}!Minute
    , TimeOfDay -> DiffTime
todSec :: {-# UNPACK #-}!DiffTime -- ^ Second.
    } deriving (INSTANCES_USUAL)

LENS(TimeOfDay,todHour,Hour)
LENS(TimeOfDay,todMin,Minute)
LENS(TimeOfDay,todSec,DiffTime)

derivingUnbox "TimeOfDay" [t| TimeOfDay -> Int64 |]
    [| \ TimeOfDay {..} -> fromIntegral (todHour .|. shiftL todMin 8)
        .|. shiftL (todSec ^. microseconds) 16 |]
    [| \ n -> TimeOfDay (fromIntegral $ n .&. 0xff)
        (fromIntegral $ shiftR n 8 .&. 0xff) (microseconds # shiftR n 16) |]

instance Hashable TimeOfDay
instance NFData TimeOfDay

#if SHOW_INTERNAL
deriving instance Show TimeOfDay
#else
instance Show TimeOfDay where
    showsPrec :: Minutes -> TimeOfDay -> ShowS
showsPrec Minutes
_ (TimeOfDay Minutes
h Minutes
m (DiffTime Micro
s))
            = Minutes -> ShowS
shows02 Minutes
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) Char
':' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Minutes -> ShowS
shows02 Minutes
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) Char
':'
            forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Minutes -> ShowS
shows02 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
si) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShowS
frac where
        (Int64
si, Micro Int64
su) = Micro -> Micro -> (Int64, Micro)
microQuotRem Micro
s (Int64 -> Micro
Micro Int64
1000000)
        frac :: ShowS
frac = if Int64
su forall a. Eq a => a -> a -> Bool
== Int64
0 then forall a. a -> a
id else (:) Char
'.' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> ShowS
fills06 Int64
su forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> ShowS
drops0 Int64
su
#endif

instance Bounded TimeOfDay where
    minBound :: TimeOfDay
minBound = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
0 Minutes
0 forall v. AdditiveGroup v => v
zeroV
    maxBound :: TimeOfDay
maxBound = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
23 Minutes
59 (forall t. TimeDiff t => Iso' t Int64
microseconds forall s t a b. AReview s t a b -> b -> t
# Int64
60999999)

instance Random TimeOfDay where
    randomR :: forall g.
RandomGen g =>
(TimeOfDay, TimeOfDay) -> g -> (TimeOfDay, g)
randomR = forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR Iso' DiffTime TimeOfDay
timeOfDay
    random :: forall g. RandomGen g => g -> (TimeOfDay, g)
random = forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall s a. s -> Getting a s a -> a
^. Iso' DiffTime TimeOfDay
timeOfDay) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a g. (Random a, RandomGen g) => g -> (a, g)
random

instance Arbitrary TimeOfDay where
    arbitrary :: Gen TimeOfDay
arbitrary = do
        Minutes
h <- forall a. Random a => (a, a) -> Gen a
choose (Minutes
0, Minutes
23)
        Minutes
m <- forall a. Random a => (a, a) -> Gen a
choose (Minutes
0, Minutes
59)
        let DiffTime Micro
ml = Minutes -> Minutes -> DiffTime
minuteLength Minutes
h Minutes
m
        Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
h Minutes
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Micro -> DiffTime
DiffTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (forall v. AdditiveGroup v => v
zeroV, forall a. Enum a => a -> a
pred Micro
ml)
    shrink :: TimeOfDay -> [TimeOfDay]
shrink TimeOfDay
tod = forall a s. Getting a s a -> s -> a
view Iso' DiffTime TimeOfDay
timeOfDay forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall v. AdditiveGroup v => v -> v -> v
(^+^) DiffTime
noon
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => a -> [a]
shrink (Iso' DiffTime TimeOfDay
timeOfDay forall s t a b. AReview s t a b -> b -> t
# TimeOfDay
tod forall v. AdditiveGroup v => v -> v -> v
^-^ DiffTime
noon) where
        noon :: DiffTime
noon = Iso' DiffTime TimeOfDay
timeOfDay forall s t a b. AReview s t a b -> b -> t
# TimeOfDay
midday -- shrink towards midday

instance CoArbitrary TimeOfDay where
    coarbitrary :: forall b. TimeOfDay -> Gen b -> Gen b
coarbitrary (TimeOfDay Minutes
h Minutes
m DiffTime
s)
        = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Minutes
h forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Minutes
m forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary DiffTime
s

-- | The maximum possible length of a minute. Always /60s/, except at
-- /23:59/ due to leap seconds.
--
-- @
-- 'minuteLength' 23 59 = 'fromSeconds'' 61
-- 'minuteLength' _  _  = 'fromSeconds'' 60
-- @
{-# INLINE minuteLength #-}
minuteLength :: Hour -> Minute -> DiffTime
minuteLength :: Minutes -> Minutes -> DiffTime
minuteLength Minutes
23 Minutes
59 = forall t. TimeDiff t => Rational -> t
fromSeconds' Rational
61
minuteLength Minutes
_  Minutes
_  = forall t. TimeDiff t => Rational -> t
fromSeconds' Rational
60

-- | Hour zero, midnight.
--
-- @
-- 'midnight' = 'TimeOfDay' 0 0 'zeroV'
-- @
midnight :: TimeOfDay
midnight :: TimeOfDay
midnight = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
0 Minutes
0 forall v. AdditiveGroup v => v
zeroV

-- | Hour twelve, noon.
--
-- @
-- 'midday' = 'TimeOfDay' 12 0 'zeroV'
-- @
midday :: TimeOfDay
midday :: TimeOfDay
midday = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
12 Minutes
0 forall v. AdditiveGroup v => v
zeroV

-- | Construct a 'TimeOfDay' from the hour, minute, and second.
--
-- Returns 'Nothing' if these constraints are not satisfied:
--
-- * /0 ≤ @hour@ ≤ 23/
-- * /0 ≤ @minute@ ≤ 59/
-- * /0 ≤ @second@ < 'minuteLength' @hour@ @minute@/
{-# INLINE makeTimeOfDayValid #-}
makeTimeOfDayValid :: Hour -> Minute -> DiffTime -> Maybe TimeOfDay
makeTimeOfDayValid :: Minutes -> Minutes -> DiffTime -> Maybe TimeOfDay
makeTimeOfDayValid Minutes
h Minutes
m DiffTime
s = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
h Minutes
m DiffTime
s
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Minutes
0 forall a. Ord a => a -> a -> Bool
<= Minutes
h Bool -> Bool -> Bool
&& Minutes
h forall a. Ord a => a -> a -> Bool
<= Minutes
23 Bool -> Bool -> Bool
&& Minutes
0 forall a. Ord a => a -> a -> Bool
<= Minutes
m Bool -> Bool -> Bool
&& Minutes
m forall a. Ord a => a -> a -> Bool
<= Minutes
59)
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (f :: * -> *). Alternative f => Bool -> f ()
guard (forall v. AdditiveGroup v => v
zeroV forall a. Ord a => a -> a -> Bool
<= DiffTime
s Bool -> Bool -> Bool
&& DiffTime
s forall a. Ord a => a -> a -> Bool
< Minutes -> Minutes -> DiffTime
minuteLength Minutes
h Minutes
m)

-- | Conversion between 'DiffTime' and 'TimeOfDay'.
--
-- @
-- > 'fromSeconds'' 100 '^.' 'timeOfDay'
-- 00:01:40
--
-- > 'timeOfDay' 'Control.Lens.#' 'TimeOfDay' 0 1 40
-- 100s
-- @
{-# INLINE timeOfDay #-}
timeOfDay :: Iso' DiffTime TimeOfDay
timeOfDay :: Iso' DiffTime TimeOfDay
timeOfDay = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DiffTime -> TimeOfDay
fromDiff TimeOfDay -> DiffTime
toDiff where

    {-# INLINEABLE fromDiff #-}
    fromDiff :: DiffTime -> TimeOfDay
    fromDiff :: DiffTime -> TimeOfDay
fromDiff (DiffTime Micro
t) = Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay
            (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (Micro -> DiffTime
DiffTime Micro
s) where
        (Int64
h, Micro
ms) = Micro -> Micro -> (Int64, Micro)
microQuotRem Micro
t (Int64 -> Micro
Micro Int64
3600000000)
        (Int64
m, Micro
s) = Micro -> Micro -> (Int64, Micro)
microQuotRem Micro
ms (Int64 -> Micro
Micro Int64
60000000)

    {-# INLINEABLE toDiff #-}
    toDiff :: TimeOfDay -> DiffTime
    toDiff :: TimeOfDay -> DiffTime
toDiff (TimeOfDay Minutes
h Minutes
m DiffTime
s) = DiffTime
s
        forall v. AdditiveGroup v => v -> v -> v
^+^ forall a b. (Integral a, Num b) => a -> b
fromIntegral Minutes
m forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro -> DiffTime
DiffTime (Int64 -> Micro
Micro Int64
60000000)
        forall v. AdditiveGroup v => v -> v -> v
^+^ forall a b. (Integral a, Num b) => a -> b
fromIntegral Minutes
h forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro -> DiffTime
DiffTime (Int64 -> Micro
Micro Int64
3600000000)

-- | Add some minutes to a 'TimeOfDay'; the result includes a day adjustment.
--
-- @
-- > 'addMinutes' 10 ('TimeOfDay' 23 55 0)
-- (1,00:05:00)
-- @
{-# INLINE addMinutes #-}
addMinutes :: Minutes -> TimeOfDay -> (Days, TimeOfDay)
addMinutes :: Minutes -> TimeOfDay -> (Minutes, TimeOfDay)
addMinutes Minutes
dm (TimeOfDay Minutes
h Minutes
m DiffTime
s) = (Minutes
dd, Minutes -> Minutes -> DiffTime -> TimeOfDay
TimeOfDay Minutes
h' Minutes
m' DiffTime
s) where
    (Minutes
dd, Minutes
h') = forall a. Integral a => a -> a -> (a, a)
divMod (Minutes
h forall a. Num a => a -> a -> a
+ Minutes
dh) Minutes
24
    (Minutes
dh, Minutes
m') = forall a. Integral a => a -> a -> (a, a)
divMod (Minutes
m forall a. Num a => a -> a -> a
+ Minutes
dm) Minutes
60

-- | Conversion between 'TimeOfDay' and the fraction of a day.
--
-- @
-- > 'TimeOfDay' 6 0 0 '^.' 'dayFraction'
-- 1 % 4
-- > 'TimeOfDay' 8 0 0 '^.' 'dayFraction'
-- 1 % 3
--
-- > 'dayFraction' 'Control.Lens.#' (1 / 4)
-- 06:00:00
-- > 'dayFraction' 'Control.Lens.#' (1 / 3)
-- 08:00:00
-- @
{-# INLINE dayFraction #-}
dayFraction :: Iso' TimeOfDay Rational
dayFraction :: Iso' TimeOfDay Rational
dayFraction = forall s t a b. AnIso s t a b -> Iso b a t s
from Iso' DiffTime TimeOfDay
timeOfDay forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso DiffTime -> Rational
toRatio Rational -> DiffTime
fromRatio where

    {-# INLINEABLE toRatio #-}
    toRatio :: DiffTime -> Rational
    toRatio :: DiffTime -> Rational
toRatio DiffTime
t = forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds DiffTime
t forall a. Fractional a => a -> a -> a
/ forall t n. (TimeDiff t, Fractional n) => t -> n
toSeconds NominalDiffTime
posixDayLength

    {-# INLINEABLE fromRatio #-}
    fromRatio :: Rational -> DiffTime
    fromRatio :: Rational -> DiffTime
fromRatio ((forall v. VectorSpace v => Scalar v -> v -> v
*^ NominalDiffTime
posixDayLength) -> NominalDiffTime Micro
r) = Micro -> DiffTime
DiffTime Micro
r

------------------------------------------------------------------------
-- * Local Time

-- | Local calendar date and time-of-day.
--
-- This type is appropriate for inputting from and outputting to the
-- outside world.
--
-- To actually perform logic and arithmetic on local date-times, a 'LocalTime'
-- should first be converted to a 'UTCTime' by the 'utcLocalTime' Iso.
--
-- See also: 'ZonedTime'.
data LocalTime = LocalTime
    { LocalTime -> Day
localDay :: {-# UNPACK #-}!Day
    -- ^ Local calendar date.
    , LocalTime -> TimeOfDay
localTimeOfDay :: {-only 3 words…-} {-# UNPACK #-}!TimeOfDay
    -- ^ Local time-of-day.
    } deriving (INSTANCES_USUAL)

LENS(LocalTime,localDay,Day)
LENS(LocalTime,localTimeOfDay,TimeOfDay)

derivingUnbox "LocalTime" [t| LocalTime -> (Day, TimeOfDay) |]
    [| \ LocalTime {..} -> (localDay, localTimeOfDay) |]
    [| \ (localDay, localTimeOfDay) -> LocalTime {..} |]

instance Hashable LocalTime
instance NFData LocalTime

#if SHOW_INTERNAL
deriving instance Show LocalTime
#else
instance Show LocalTime where
    showsPrec :: Minutes -> LocalTime -> ShowS
showsPrec Minutes
p (LocalTime Day
d TimeOfDay
t) = forall a. Show a => Minutes -> a -> ShowS
showsPrec Minutes
p Day
d forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) Char
' ' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => Minutes -> a -> ShowS
showsPrec Minutes
p TimeOfDay
t
#endif

instance Bounded LocalTime where
    minBound :: LocalTime
minBound = forall a. Bounded a => a
minBound forall s a. s -> Getting a s a -> a
^. TimeZone -> Iso' UTCTime LocalTime
utcLocalTime forall a. Bounded a => a
maxBound
    maxBound :: LocalTime
maxBound = forall a. Bounded a => a
maxBound forall s a. s -> Getting a s a -> a
^. TimeZone -> Iso' UTCTime LocalTime
utcLocalTime forall a. Bounded a => a
minBound

instance Random LocalTime where
    randomR :: forall g.
RandomGen g =>
(LocalTime, LocalTime) -> g -> (LocalTime, g)
randomR = forall s g a.
(Random s, RandomGen g) =>
Iso' s a -> (a, a) -> g -> (a, g)
randomIsoR (TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone
utc)
    random :: forall g. RandomGen g => g -> (LocalTime, g)
random = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)

instance Arbitrary LocalTime where
    arbitrary :: Gen LocalTime
arbitrary = forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
    shrink :: LocalTime -> [LocalTime]
shrink lt :: LocalTime
lt@LocalTime {Day
TimeOfDay
localTimeOfDay :: TimeOfDay
localDay :: Day
localTimeOfDay :: LocalTime -> TimeOfDay
localDay :: LocalTime -> Day
..}
        = [ LocalTime
lt {localDay :: Day
localDay = Day
d} | Day
d <- forall a. Arbitrary a => a -> [a]
shrink Day
localDay ]
        forall a. [a] -> [a] -> [a]
++ [ LocalTime
lt {localTimeOfDay :: TimeOfDay
localTimeOfDay = TimeOfDay
d} | TimeOfDay
d <- forall a. Arbitrary a => a -> [a]
shrink TimeOfDay
localTimeOfDay ]

instance CoArbitrary LocalTime where
    coarbitrary :: forall b. LocalTime -> Gen b -> Gen b
coarbitrary (LocalTime Day
d TimeOfDay
t) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary Day
d forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary TimeOfDay
t

-- | Conversion between 'UTCTime' and 'LocalTime'.
--
-- @
-- > tz <- 'getCurrentTimeZone'
--
-- > 'timeZoneName' tz
-- \"JST\"
--
-- > 'timeZoneOffsetString' tz
-- \"+0900\"
--
-- > now <- 'getCurrentTime'
-- > now
-- 2016-04-23 02:00:00.000000 UTC
--
-- > let local = now '^.' 'utcLocalTime' tz
-- > local
-- 2016-04-23 11:00:00.000000
--
-- > 'utcLocalTime' tz 'Control.Lens.#' local
-- 2016-04-23 02:00:00.000000 UTC
-- @
--
-- See also: 'zonedTime'.
{-# INLINE utcLocalTime #-}
utcLocalTime :: TimeZone -> Iso' UTCTime LocalTime
utcLocalTime :: TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone {Bool
Minutes
String
timeZoneName :: String
timeZoneSummerOnly :: Bool
timeZoneMinutes :: Minutes
timeZoneName :: TimeZone -> String
timeZoneSummerOnly :: TimeZone -> Bool
timeZoneMinutes :: TimeZone -> Minutes
..} = Iso' UTCTime UTCView
utcTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso UTCView -> LocalTime
localise LocalTime -> UTCView
globalise where

    {-# INLINEABLE localise #-}
    localise :: UTCView -> LocalTime
    localise :: UTCView -> LocalTime
localise (UTCView Day
day DiffTime
dt) = Day -> TimeOfDay -> LocalTime
LocalTime (Day
day forall p. AffineSpace p => p -> Diff p -> p
.+^ Minutes
dd) TimeOfDay
tod where
        (Minutes
dd, TimeOfDay
tod) = Minutes -> TimeOfDay -> (Minutes, TimeOfDay)
addMinutes Minutes
timeZoneMinutes (DiffTime
dt forall s a. s -> Getting a s a -> a
^. Iso' DiffTime TimeOfDay
timeOfDay)

    {-# INLINEABLE globalise #-}
    globalise :: LocalTime -> UTCView
    globalise :: LocalTime -> UTCView
globalise (LocalTime Day
day TimeOfDay
tod) = Day -> DiffTime -> UTCView
UTCView (Day
day forall p. AffineSpace p => p -> Diff p -> p
.+^ Minutes
dd)
            (Iso' DiffTime TimeOfDay
timeOfDay forall s t a b. AReview s t a b -> b -> t
# TimeOfDay
utcToD) where
        (Minutes
dd, TimeOfDay
utcToD) = Minutes -> TimeOfDay -> (Minutes, TimeOfDay)
addMinutes (forall a. Num a => a -> a
negate Minutes
timeZoneMinutes) TimeOfDay
tod

-- | Conversion between 'UniversalTime' and 'LocalTime'.
{-# INLINE ut1LocalTime #-}
ut1LocalTime :: Rational -> Iso' UniversalTime LocalTime
ut1LocalTime :: Rational -> Iso' UniversalTime LocalTime
ut1LocalTime Rational
long = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso UniversalTime -> LocalTime
localise LocalTime -> UniversalTime
globalise where
    NominalDiffTime posixDay :: Micro
posixDay@(Micro Int64
usDay) = NominalDiffTime
posixDayLength

    {-# INLINEABLE localise #-}
    localise :: UniversalTime -> LocalTime
    localise :: UniversalTime -> LocalTime
localise (UniversalRep (NominalDiffTime Micro
t)) = Day -> TimeOfDay -> LocalTime
LocalTime
            (Minutes -> Day
ModifiedJulianDay forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
day)
            (Micro -> DiffTime
DiffTime Micro
dt forall s a. s -> Getting a s a -> a
^. Iso' DiffTime TimeOfDay
timeOfDay) where
        (Int64
day, Micro
dt) = Micro -> Micro -> (Int64, Micro)
microDivMod (Micro
t forall v. AdditiveGroup v => v -> v -> v
^+^ (Rational
long forall a. Fractional a => a -> a -> a
/ Rational
360) forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro
posixDay) Micro
posixDay

    {-# INLINEABLE globalise #-}
    globalise :: LocalTime -> UniversalTime
    globalise :: LocalTime -> UniversalTime
globalise (LocalTime Day
day TimeOfDay
tod) = NominalDiffTime -> UniversalTime
UniversalRep forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Micro -> NominalDiffTime
NominalDiffTime forall a b. (a -> b) -> a -> b
$
            Int64 -> Micro
Micro (Int64
mjd forall a. Num a => a -> a -> a
* Int64
usDay) forall v. AdditiveGroup v => v -> v -> v
^+^ Micro
dt forall v. AdditiveGroup v => v -> v -> v
^-^ (Rational
long forall a. Fractional a => a -> a -> a
/ Rational
360) forall v. VectorSpace v => Scalar v -> v -> v
*^ Micro
posixDay where
        ModifiedJulianDay (forall a b. (Integral a, Num b) => a -> b
fromIntegral -> Int64
mjd) = Day
day
        DiffTime Micro
dt = Iso' DiffTime TimeOfDay
timeOfDay forall s t a b. AReview s t a b -> b -> t
# TimeOfDay
tod

------------------------------------------------------------------------
-- * Zoned Time

-- | A 'LocalTime' and its 'TimeZone'.
--
-- This type is appropriate for inputting from and outputting to the
-- outside world.
--
-- To actually perform logic and arithmetic on local date-times, a 'ZonedTime'
-- should first be converted to a 'UTCTime' by the 'zonedTime' Iso.
data ZonedTime = ZonedTime
    { ZonedTime -> LocalTime
zonedTimeToLocalTime :: {-only 4 words…-} {-# UNPACK #-}!LocalTime
    , ZonedTime -> TimeZone
zonedTimeZone :: !TimeZone
    } deriving (INSTANCES_USUAL)

LENS(ZonedTime,zonedTimeToLocalTime,LocalTime)
LENS(ZonedTime,zonedTimeZone,TimeZone)

instance Hashable ZonedTime
instance NFData ZonedTime where
    rnf :: ZonedTime -> ()
rnf ZonedTime {TimeZone
LocalTime
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
..} = forall a. NFData a => a -> ()
rnf TimeZone
zonedTimeZone

instance Bounded ZonedTime where
    minBound :: ZonedTime
minBound = LocalTime -> TimeZone -> ZonedTime
ZonedTime forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound
    maxBound :: ZonedTime
maxBound = LocalTime -> TimeZone -> ZonedTime
ZonedTime forall a. Bounded a => a
maxBound forall a. Bounded a => a
minBound

instance Random ZonedTime where
    randomR :: forall g.
RandomGen g =>
(ZonedTime, ZonedTime) -> g -> (ZonedTime, g)
randomR (ZonedTime
l, ZonedTime
u) g
g0 = (forall a s. Getting a s a -> s -> a
view Iso' (TimeZone, UTCTime) ZonedTime
zonedTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (,) TimeZone
tz)
            forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
`first` forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (UTCTime
l', UTCTime
u') g
g1 where
        (TimeZone
tz, g
g1) = forall a g. (Random a, RandomGen g) => g -> (a, g)
random g
g0 -- ignore TimeZone from l and u
        l' :: UTCTime
l' = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Iso' (TimeZone, UTCTime) ZonedTime
zonedTime forall s t a b. AReview s t a b -> b -> t
# ZonedTime
l
        u' :: UTCTime
u' = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ Iso' (TimeZone, UTCTime) ZonedTime
zonedTime forall s t a b. AReview s t a b -> b -> t
# ZonedTime
u
    random :: forall g. RandomGen g => g -> (ZonedTime, g)
random = forall a g. (Random a, RandomGen g) => (a, a) -> g -> (a, g)
randomR (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)

instance Arbitrary ZonedTime where
    arbitrary :: Gen ZonedTime
arbitrary = forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
    shrink :: ZonedTime -> [ZonedTime]
shrink zt :: ZonedTime
zt@ZonedTime {TimeZone
LocalTime
zonedTimeZone :: TimeZone
zonedTimeToLocalTime :: LocalTime
zonedTimeZone :: ZonedTime -> TimeZone
zonedTimeToLocalTime :: ZonedTime -> LocalTime
..}
        = [ ZonedTime
zt {zonedTimeToLocalTime :: LocalTime
zonedTimeToLocalTime = LocalTime
lt} | LocalTime
lt <- forall a. Arbitrary a => a -> [a]
shrink LocalTime
zonedTimeToLocalTime ]
        forall a. [a] -> [a] -> [a]
++ [ ZonedTime
zt {zonedTimeZone :: TimeZone
zonedTimeZone = TimeZone
tz} | TimeZone
tz <- forall a. Arbitrary a => a -> [a]
shrink TimeZone
zonedTimeZone ]

instance CoArbitrary ZonedTime where
    coarbitrary :: forall b. ZonedTime -> Gen b -> Gen b
coarbitrary (ZonedTime LocalTime
lt TimeZone
tz) = forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary LocalTime
lt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a b. CoArbitrary a => a -> Gen b -> Gen b
coarbitrary TimeZone
tz

-- | Conversion between ('TimeZone', 'UTCTime') and 'ZonedTime'.
--
-- @
-- > now <- 'getZonedTime'
-- > now
-- 2016-04-04 16:00:00.000000 JST
--
-- > 'zonedTime' 'Control.Lens.#' now
-- (JST,2016-04-04 07:00:00.000000 UTC)
--
-- > ('zonedTime' 'Control.Lens.#' now) '^.' 'zonedTime'
-- 2016-04-04 16:00:00.000000 JST
-- @
--
-- See also: 'utcLocalTime'.
{-# INLINE zonedTime #-}
zonedTime :: Iso' (TimeZone, UTCTime) ZonedTime
zonedTime :: Iso' (TimeZone, UTCTime) ZonedTime
zonedTime = forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso (TimeZone, UTCTime) -> ZonedTime
toZoned ZonedTime -> (TimeZone, UTCTime)
fromZoned where

    {-# INLINE toZoned #-}
    toZoned :: (TimeZone, UTCTime) -> ZonedTime
    toZoned :: (TimeZone, UTCTime) -> ZonedTime
toZoned (TimeZone
tz, UTCTime
time) = LocalTime -> TimeZone -> ZonedTime
ZonedTime (UTCTime
time forall s a. s -> Getting a s a -> a
^. TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone
tz) TimeZone
tz

    {-# INLINE fromZoned #-}
    fromZoned :: ZonedTime -> (TimeZone, UTCTime)
    fromZoned :: ZonedTime -> (TimeZone, UTCTime)
fromZoned (ZonedTime LocalTime
lt TimeZone
tz) = (TimeZone
tz, TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone
tz forall s t a b. AReview s t a b -> b -> t
# LocalTime
lt)

#if SHOW_INTERNAL
deriving instance Show ZonedTime
instance Show UTCTime where
    showsPrec p = showsPrec p . view utcTime
#else
instance Show ZonedTime where
    showsPrec :: Minutes -> ZonedTime -> ShowS
showsPrec Minutes
p (ZonedTime LocalTime
lt TimeZone
tz) = forall a. Show a => Minutes -> a -> ShowS
showsPrec Minutes
p LocalTime
lt forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (:) Char
' ' forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Show a => Minutes -> a -> ShowS
showsPrec Minutes
p TimeZone
tz
instance Show UTCTime where
    showsPrec :: Minutes -> UTCTime -> ShowS
showsPrec Minutes
p = forall a. Show a => Minutes -> a -> ShowS
showsPrec Minutes
p forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a s. Getting a s a -> s -> a
view Iso' (TimeZone, UTCTime) ZonedTime
zonedTime forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (,) TimeZone
utc
#endif

-- | Get the current local date, time, and time zone.
--
-- @
-- > 'getZonedTime'
-- 2016-04-23 11:57:22.516064 JST
-- @
--
-- See also: 'getCurrentTime', 'Data.Thyme.Clock.POSIX.getPOSIXTime'.
{-# INLINE getZonedTime #-}
getZonedTime :: IO ZonedTime
getZonedTime :: IO ZonedTime
getZonedTime = UTCTime -> IO ZonedTime
utcToLocalZonedTime forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO UTCTime
getCurrentTime

-- | Convert a 'UTCTime' to a 'ZonedTime' according to the local time zone
-- returned by 'getTimeZone'.
--
-- See also: 'zonedTime'.
{-# INLINEABLE utcToLocalZonedTime #-}
utcToLocalZonedTime :: UTCTime -> IO ZonedTime
utcToLocalZonedTime :: UTCTime -> IO ZonedTime
utcToLocalZonedTime UTCTime
time = do
    TimeZone
tz <- UTCTime -> IO TimeZone
getTimeZone UTCTime
time
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (TimeZone
tz, UTCTime
time) forall s a. s -> Getting a s a -> a
^. Iso' (TimeZone, UTCTime) ZonedTime
zonedTime

-- * Compatibility

-- | Convert a UTC 'TimeOfDay' to a 'TimeOfDay' in some timezone, together
-- with a day adjustment.
--
-- @
-- 'utcToLocalTimeOfDay' = 'addMinutes' '.' 'timeZoneMinutes'
-- @
{-# INLINE utcToLocalTimeOfDay #-}
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Minutes, TimeOfDay)
utcToLocalTimeOfDay = Minutes -> TimeOfDay -> (Minutes, TimeOfDay)
addMinutes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeZone -> Minutes
timeZoneMinutes

-- | Convert a 'TimeOfDay' in some timezone to a UTC 'TimeOfDay', together
-- with a day adjustment.
--
-- @
-- 'localToUTCTimeOfDay' = 'addMinutes' '.' 'negate' '.' 'timeZoneMinutes'
-- @
{-# INLINE localToUTCTimeOfDay #-}
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Days, TimeOfDay)
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Minutes, TimeOfDay)
localToUTCTimeOfDay = Minutes -> TimeOfDay -> (Minutes, TimeOfDay)
addMinutes forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. Num a => a -> a
negate forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. TimeZone -> Minutes
timeZoneMinutes

-- | Convert a 'DiffTime' of the duration since midnight to a 'TimeOfDay'.
-- Durations exceeding 24 hours will be treated as leap-seconds.
--
-- @
-- 'timeToTimeOfDay' = 'view' 'timeOfDay'
-- 'timeToTimeOfDay' d ≡ d '^.' 'timeOfDay'
-- @
{-# INLINE timeToTimeOfDay #-}
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay = forall a s. Getting a s a -> s -> a
view Iso' DiffTime TimeOfDay
timeOfDay

-- | Convert a 'TimeOfDay' to a 'DiffTime' of the duration since midnight.
-- 'TimeOfDay' greater than 24 hours will be treated as leap-seconds.
--
-- @
-- 'timeOfDayToTime' = 'review' 'timeOfDay'
-- 'timeOfDayToTime' tod ≡ 'timeOfDay' 'Control.Lens.#' tod
-- @
{-# INLINE timeOfDayToTime #-}
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime = forall s t a b. AReview s t a b -> b -> t
review Iso' DiffTime TimeOfDay
timeOfDay

-- | Convert a fraction of a day since midnight to a 'TimeOfDay'.
--
-- @
-- 'dayFractionToTimeOfDay' = 'review' 'dayFraction'
-- @
{-# INLINE dayFractionToTimeOfDay #-}
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay = forall s t a b. AReview s t a b -> b -> t
review Iso' TimeOfDay Rational
dayFraction

-- | Convert a 'TimeOfDay' to a fraction of a day since midnight.
--
-- @
-- 'timeOfDayToDayFraction' = 'view' 'dayFraction'
-- @
{-# INLINE timeOfDayToDayFraction #-}
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction = forall a s. Getting a s a -> s -> a
view Iso' TimeOfDay Rational
dayFraction

-- | Convert a 'UTCTime' to a 'LocalTime' in the given 'TimeZone'.
--
-- @
-- 'utcToLocalTime' = 'view' '.' 'utcLocalTime'
-- @
{-# INLINE utcToLocalTime #-}
utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
utcToLocalTime :: TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
tz = forall a s. Getting a s a -> s -> a
view (TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone
tz)

-- | Convert a 'LocalTime' in the given 'TimeZone' to a 'UTCTime'.
--
-- @
-- 'localTimeToUTC' = 'review' '.' 'utcLocalTime'
-- @
{-# INLINE localTimeToUTC #-}
localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
localTimeToUTC :: TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
tz = forall s t a b. AReview s t a b -> b -> t
review (TimeZone -> Iso' UTCTime LocalTime
utcLocalTime TimeZone
tz)

-- | Convert a 'UniversalTime' to a 'LocalTime' at the given medidian in
-- degrees East.
--
-- @
-- 'ut1ToLocalTime' = 'view' '.' 'ut1LocalTime'
-- @
{-# INLINE ut1ToLocalTime #-}
ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
ut1ToLocalTime :: Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
l = forall a s. Getting a s a -> s -> a
view (Rational -> Iso' UniversalTime LocalTime
ut1LocalTime Rational
l)

-- | Convert a 'LocalTime' at the given meridian in degrees East to
-- a 'UniversalTime'.
--
-- @
-- 'localTimeToUT1' = 'review' '.' 'ut1LocalTime'
-- @
{-# INLINE localTimeToUT1 #-}
localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
localTimeToUT1 :: Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
l = forall s t a b. AReview s t a b -> b -> t
review (Rational -> Iso' UniversalTime LocalTime
ut1LocalTime Rational
l)

-- | Convert a 'UTCTime' and the given 'TimeZone' into a 'ZonedTime'.
--
-- @
-- 'utcToZonedTime' z t = 'view' 'zonedTime' (z, t)
-- @
{-# INLINE utcToZonedTime #-}
utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime
utcToZonedTime :: TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
z UTCTime
t = forall a s. Getting a s a -> s -> a
view Iso' (TimeZone, UTCTime) ZonedTime
zonedTime (TimeZone
z, UTCTime
t)

-- | Converts a 'ZonedTime' to a 'UTCTime'.
--
-- @
-- 'zonedTimeToUTC' = 'snd' '.' 'review' 'zonedTime'
-- @
{-# INLINE zonedTimeToUTC #-}
zonedTimeToUTC :: ZonedTime -> UTCTime
zonedTimeToUTC :: ZonedTime -> UTCTime
zonedTimeToUTC = forall a b. (a, b) -> b
snd forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall s t a b. AReview s t a b -> b -> t
review Iso' (TimeZone, UTCTime) ZonedTime
zonedTime