{-# options_haddock prune #-}

-- |Classes for constructing datetime values and extracting time components, Internal
module Polysemy.Time.Calendar where

import Data.Time (
  Day,
  DiffTime,
  TimeOfDay (TimeOfDay),
  UTCTime (UTCTime),
  fromGregorian,
  timeOfDayToTime,
  timeToTimeOfDay,
  toGregorian,
  utctDay,
  )
import Prelude hiding (second)

import Polysemy.Time.Data.TimeUnit (Days, Hours, Minutes, Months, NanoSeconds, Seconds, Years, convert)

-- |Utility for 'Polysemy.Time.At.interpretTimeAtWithStart'.
class HasDate t d | t -> d where
  date :: t -> d
  dateToTime :: d -> t

-- |Extract the year component from a date.
class HasYear t where
  year :: t -> Years

-- |Extract the month component from a date.
class HasMonth t where
  month :: t -> Months

-- |Extract the day component from a date.
class HasDay t where
  day :: t -> Days

-- |Extract the hour component from a datetime or time.
class HasHour t where
  hour :: t -> Hours

-- |Extract the minute component from a datetime or time.
class HasMinute t where
  minute :: t -> Minutes

-- |Extract the second component from a datetime or time.
class HasSecond t where
  second :: t -> Seconds

-- |Extract the nanosecond component from a datetime or time.
class HasNanoSecond t where
  nanoSecond :: t -> NanoSeconds

-- |Construct datetimes, dates or times from integers.
class Calendar dt where
  type CalendarDate dt :: Type
  type CalendarTime dt :: Type
  mkDate :: Int64 -> Int64 -> Int64 -> CalendarDate dt
  mkTime :: Int64 -> Int64 -> Int64 -> CalendarTime dt
  mkDatetime :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> dt

instance HasDate UTCTime Day where
  date :: UTCTime -> Day
date =
    UTCTime -> Day
utctDay
  dateToTime :: Day -> UTCTime
dateToTime Day
d =
    Day -> DiffTime -> UTCTime
UTCTime Day
d DiffTime
0

instance HasYear Day where
  year :: Day -> Years
year (Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian -> (Year
y, MonthOfYear
_, MonthOfYear
_)) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral Year
y

instance HasYear UTCTime where
  year :: UTCTime -> Years
year =
    forall t. HasYear t => t -> Years
year forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay

instance HasMonth Day where
  month :: Day -> Months
month (Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian -> (Year
_, MonthOfYear
m, MonthOfYear
_)) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
m

instance HasMonth UTCTime where
  month :: UTCTime -> Months
month =
    forall t. HasMonth t => t -> Months
month forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay

instance HasDay Day where
  day :: Day -> Days
day (Day -> (Year, MonthOfYear, MonthOfYear)
toGregorian -> (Year
_, MonthOfYear
_, MonthOfYear
d)) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
d

instance HasDay UTCTime where
  day :: UTCTime -> Days
day =
    forall t. HasDay t => t -> Days
day forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay

instance HasHour TimeOfDay where
  hour :: TimeOfDay -> Hours
hour (TimeOfDay MonthOfYear
h MonthOfYear
_ Pico
_) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
h

instance HasHour DiffTime where
  hour :: DiffTime -> Hours
hour =
    forall t. HasHour t => t -> Hours
hour forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay

instance HasMinute TimeOfDay where
  minute :: TimeOfDay -> Minutes
minute (TimeOfDay MonthOfYear
_ MonthOfYear
m Pico
_) =
    forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
m

instance HasMinute DiffTime where
  minute :: DiffTime -> Minutes
minute =
    forall t. HasMinute t => t -> Minutes
minute forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay

instance HasSecond TimeOfDay where
  second :: TimeOfDay -> Seconds
second (TimeOfDay MonthOfYear
_ MonthOfYear
_ Pico
s) =
    forall a b. (RealFrac a, Integral b) => a -> b
truncate Pico
s

instance HasSecond DiffTime where
  second :: DiffTime -> Seconds
second =
    forall t. HasSecond t => t -> Seconds
second forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay

instance HasNanoSecond TimeOfDay where
  nanoSecond :: TimeOfDay -> NanoSeconds
nanoSecond TimeOfDay
t =
    forall a b. (TimeUnit a, TimeUnit b) => a -> b
convert (forall t. HasSecond t => t -> Seconds
second TimeOfDay
t)

instance HasNanoSecond DiffTime where
  nanoSecond :: DiffTime -> NanoSeconds
nanoSecond =
    forall t. HasNanoSecond t => t -> NanoSeconds
nanoSecond forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay

instance Calendar UTCTime where
  type CalendarDate UTCTime = Day
  type CalendarTime UTCTime = DiffTime
  mkDate :: Int64 -> Int64 -> Int64 -> CalendarDate UTCTime
mkDate Int64
y Int64
m Int64
d =
    Year -> MonthOfYear -> MonthOfYear -> Day
fromGregorian (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
y) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
d)
  mkTime :: Int64 -> Int64 -> Int64 -> CalendarTime UTCTime
mkTime Int64
h Int64
m Int64
s =
    TimeOfDay -> DiffTime
timeOfDayToTime (MonthOfYear -> MonthOfYear -> Pico -> 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) (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
s))
  mkDatetime :: Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> Int64 -> UTCTime
mkDatetime Int64
y Int64
mo Int64
d Int64
h Int64
mi Int64
s =
    Day -> DiffTime -> UTCTime
UTCTime (forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> CalendarDate dt
mkDate @UTCTime Int64
y Int64
mo Int64
d) (forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> CalendarTime dt
mkTime @UTCTime Int64
h Int64
mi Int64
s)