{-# 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 -> (Integer, Int, Int)
toGregorian -> (Integer
y, Int
_, Int
_)) =
    Integer -> Years
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y

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

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

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

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

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

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

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

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

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

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

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

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

instance HasNanoSecond DiffTime where
  nanoSecond :: DiffTime -> NanoSeconds
nanoSecond =
    TimeOfDay -> NanoSeconds
forall t. HasNanoSecond t => t -> NanoSeconds
nanoSecond (TimeOfDay -> NanoSeconds)
-> (DiffTime -> TimeOfDay) -> DiffTime -> NanoSeconds
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 =
    Integer -> Int -> Int -> Day
fromGregorian (Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
y) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (Int64 -> Int
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 (Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
h) (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
m) (Int64 -> Pico
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)