{-# OPTIONS -fno-warn-unused-imports #-}
module Data.Time.LocalTime.Internal.TimeOfDay
(
    -- * Time of day
    TimeOfDay(..),midnight,midday,makeTimeOfDayValid,
    timeToDaysAndTimeOfDay,daysAndTimeOfDayToTime,
    utcToLocalTimeOfDay,localToUTCTimeOfDay,
    timeToTimeOfDay,timeOfDayToTime,
    dayFractionToTimeOfDay,timeOfDayToDayFraction
) where

import Control.DeepSeq
import Data.Typeable
import Data.Fixed
import Data.Data
import Data.Time.Clock.Internal.DiffTime
import Data.Time.Clock.Internal.NominalDiffTime
import Data.Time.Calendar.Private
import Data.Time.LocalTime.Internal.TimeZone


-- | Time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day.
data TimeOfDay = TimeOfDay {
    -- | range 0 - 23
    TimeOfDay -> Int
todHour    :: Int,
    -- | range 0 - 59
    TimeOfDay -> Int
todMin     :: Int,
    -- | Note that 0 <= 'todSec' < 61, accomodating leap seconds.
    -- Any local minute may have a leap second, since leap seconds happen in all zones simultaneously
    TimeOfDay -> Pico
todSec     :: Pico
} deriving (TimeOfDay -> TimeOfDay -> Bool
(TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool) -> Eq TimeOfDay
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeOfDay -> TimeOfDay -> Bool
$c/= :: TimeOfDay -> TimeOfDay -> Bool
== :: TimeOfDay -> TimeOfDay -> Bool
$c== :: TimeOfDay -> TimeOfDay -> Bool
Eq,Eq TimeOfDay
Eq TimeOfDay
-> (TimeOfDay -> TimeOfDay -> Ordering)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> Bool)
-> (TimeOfDay -> TimeOfDay -> TimeOfDay)
-> (TimeOfDay -> TimeOfDay -> TimeOfDay)
-> Ord TimeOfDay
TimeOfDay -> TimeOfDay -> Bool
TimeOfDay -> TimeOfDay -> Ordering
TimeOfDay -> TimeOfDay -> TimeOfDay
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeOfDay -> TimeOfDay -> TimeOfDay
$cmin :: TimeOfDay -> TimeOfDay -> TimeOfDay
max :: TimeOfDay -> TimeOfDay -> TimeOfDay
$cmax :: TimeOfDay -> TimeOfDay -> TimeOfDay
>= :: TimeOfDay -> TimeOfDay -> Bool
$c>= :: TimeOfDay -> TimeOfDay -> Bool
> :: TimeOfDay -> TimeOfDay -> Bool
$c> :: TimeOfDay -> TimeOfDay -> Bool
<= :: TimeOfDay -> TimeOfDay -> Bool
$c<= :: TimeOfDay -> TimeOfDay -> Bool
< :: TimeOfDay -> TimeOfDay -> Bool
$c< :: TimeOfDay -> TimeOfDay -> Bool
compare :: TimeOfDay -> TimeOfDay -> Ordering
$ccompare :: TimeOfDay -> TimeOfDay -> Ordering
Ord,Typeable TimeOfDay
Typeable TimeOfDay
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TimeOfDay -> c TimeOfDay)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TimeOfDay)
-> (TimeOfDay -> Constr)
-> (TimeOfDay -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TimeOfDay))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeOfDay))
-> ((forall b. Data b => b -> b) -> TimeOfDay -> TimeOfDay)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r)
-> (forall u. (forall d. Data d => d -> u) -> TimeOfDay -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TimeOfDay -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay)
-> Data TimeOfDay
TimeOfDay -> DataType
TimeOfDay -> Constr
(forall b. Data b => b -> b) -> TimeOfDay -> TimeOfDay
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TimeOfDay -> u
forall u. (forall d. Data d => d -> u) -> TimeOfDay -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeOfDay
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeOfDay -> c TimeOfDay
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeOfDay)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeOfDay)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeOfDay -> m TimeOfDay
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeOfDay -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeOfDay -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> TimeOfDay -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeOfDay -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeOfDay -> r
gmapT :: (forall b. Data b => b -> b) -> TimeOfDay -> TimeOfDay
$cgmapT :: (forall b. Data b => b -> b) -> TimeOfDay -> TimeOfDay
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeOfDay)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeOfDay)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeOfDay)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeOfDay)
dataTypeOf :: TimeOfDay -> DataType
$cdataTypeOf :: TimeOfDay -> DataType
toConstr :: TimeOfDay -> Constr
$ctoConstr :: TimeOfDay -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeOfDay
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeOfDay
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeOfDay -> c TimeOfDay
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeOfDay -> c TimeOfDay
Data, Typeable)

instance NFData TimeOfDay where
    rnf :: TimeOfDay -> ()
rnf (TimeOfDay Int
h Int
m Pico
s) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
h () -> () -> ()
`seq` Int -> ()
forall a. NFData a => a -> ()
rnf Int
m () -> () -> ()
`seq` Pico
s Pico -> () -> ()
`seq` () -- FIXME: Data.Fixed had no NFData instances yet at time of writing

-- | Hour zero
midnight :: TimeOfDay
midnight :: TimeOfDay
midnight = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
0 Int
0 Pico
0

-- | Hour twelve
midday :: TimeOfDay
midday :: TimeOfDay
midday = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
12 Int
0 Pico
0

instance Show TimeOfDay where
    show :: TimeOfDay -> String
show (TimeOfDay Int
h Int
m Pico
s) = (Int -> String
forall t. ShowPadded t => t -> String
show2 Int
h) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Int -> String
forall t. ShowPadded t => t -> String
show2 Int
m) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
":" String -> ShowS
forall a. [a] -> [a] -> [a]
++ (Pico -> String
show2Fixed Pico
s)

makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay
makeTimeOfDayValid Int
h Int
m Pico
s = do
    Int
_ <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
23 Int
h
    Int
_ <- Int -> Int -> Int -> Maybe Int
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Int
0 Int
59 Int
m
    Pico
_ <- Pico -> Pico -> Pico -> Maybe Pico
forall t. Ord t => t -> t -> t -> Maybe t
clipValid Pico
0 Pico
60.999999999999 Pico
s
    TimeOfDay -> Maybe TimeOfDay
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m Pico
s)

-- | Convert a period of time into a count of days and a time of day since midnight.
-- The time of day will never have a leap second.
timeToDaysAndTimeOfDay :: NominalDiffTime -> (Integer,TimeOfDay)
timeToDaysAndTimeOfDay :: NominalDiffTime -> (Integer, TimeOfDay)
timeToDaysAndTimeOfDay NominalDiffTime
dt = let
    s :: Pico
s = NominalDiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
dt
    (Int
m,Pico
ms) = Pico -> Pico -> (Int, Pico)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Pico
s Pico
60
    (Int
h,Int
hm) = Int -> Int -> (Int, Int)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Int
m Int
60
    (Integer
d,Int
dh) = Int -> Int -> (Integer, Int)
forall a b. (Real a, Integral b) => a -> a -> (b, a)
divMod' Int
h Int
24
    in (Integer
d,Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
dh Int
hm Pico
ms)

-- | Convert a count of days and a time of day since midnight into a period of time.
daysAndTimeOfDayToTime :: Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime :: Integer -> TimeOfDay -> NominalDiffTime
daysAndTimeOfDayToTime Integer
d (TimeOfDay Int
dh Int
hm Pico
ms) = NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(+) (Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
ms) (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(*) NominalDiffTime
60 (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(+) (Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
hm) (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(*) NominalDiffTime
60 (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(+) (Int -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Int
dh) (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
(*) NominalDiffTime
24 (NominalDiffTime -> NominalDiffTime)
-> NominalDiffTime -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Integer -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Integer
d

-- | Convert a time of day in UTC to a time of day in some timezone, together with a day adjustment.
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer, TimeOfDay)
utcToLocalTimeOfDay TimeZone
zone (TimeOfDay Int
h Int
m Pico
s) = (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
h' Int
24),Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
h' Int
24) (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
m' Int
60) Pico
s) where
    m' :: Int
m' = Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ TimeZone -> Int
timeZoneMinutes TimeZone
zone
    h' :: Int
h' = Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
m' Int
60)

-- | Convert a time of day in some timezone to a time of day in UTC, together with a day adjustment.
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer, TimeOfDay)
localToUTCTimeOfDay TimeZone
zone = TimeZone -> TimeOfDay -> (Integer, TimeOfDay)
utcToLocalTimeOfDay (Int -> TimeZone
minutesToTimeZone (Int -> Int
forall a. Num a => a -> a
negate (TimeZone -> Int
timeZoneMinutes TimeZone
zone)))

posixDayLength :: DiffTime
posixDayLength :: DiffTime
posixDayLength = Integer -> DiffTime
forall a. Num a => Integer -> a
fromInteger Integer
86400

-- | Get the time of day given a time since midnight.
-- Time more than 24h will be converted to leap-seconds.
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay :: DiffTime -> TimeOfDay
timeToTimeOfDay DiffTime
dt | DiffTime
dt DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
>= DiffTime
posixDayLength = Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
23 Int
59 (Pico
60 Pico -> Pico -> Pico
forall a. Num a => a -> a -> a
+ (DiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac (DiffTime
dt DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
- DiffTime
posixDayLength)))
timeToTimeOfDay DiffTime
dt = Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
h) (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
m) Pico
s where
    s' :: Pico
s' = DiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
dt
    s :: Pico
s = Pico -> Pico -> Pico
forall a. Real a => a -> a -> a
mod' Pico
s' Pico
60
    m' :: Integer
m' = Pico -> Pico -> Integer
forall a b. (Real a, Integral b) => a -> a -> b
div' Pico
s' Pico
60
    m :: Integer
m = Integer -> Integer -> Integer
forall a. Real a => a -> a -> a
mod' Integer
m' Integer
60
    h :: Integer
h = Integer -> Integer -> Integer
forall a b. (Real a, Integral b) => a -> a -> b
div' Integer
m' Integer
60

-- | Get the time since midnight for a given time of day.
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime :: TimeOfDay -> DiffTime
timeOfDayToTime (TimeOfDay Int
h Int
m Pico
s) = ((Int -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ (Int -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m)) DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
* DiffTime
60 DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ (Pico -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Pico
s)

-- | Get the time of day given the fraction of a day since midnight.
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay :: Rational -> TimeOfDay
dayFractionToTimeOfDay Rational
df = DiffTime -> TimeOfDay
timeToTimeOfDay (Rational -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Rational
df Rational -> Rational -> Rational
forall a. Num a => a -> a -> a
* Rational
86400))

-- | Get the fraction of a day since midnight given a time of day.
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction :: TimeOfDay -> Rational
timeOfDayToDayFraction TimeOfDay
tod = DiffTime -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod) Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ DiffTime -> Rational
forall a b. (Real a, Fractional b) => a -> b
realToFrac DiffTime
posixDayLength