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 CalendarTime dt :: *
  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 d :: Day
d =
    Day -> DiffTime -> UTCTime
UTCTime Day
d 0

instance HasYear Day where
  year :: Day -> Years
year (Day -> (Integer, Int, Int)
toGregorian -> (y :: Integer
y, _, _)) =
    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 -> (_, m :: Int
m, _)) =
    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 -> (_, _, d :: 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 h :: Int
h _ _) =
    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 _ m :: Int
m _) =
    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 _ _ s :: 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 t :: 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 y :: Int64
y m :: Int64
m d :: 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 h :: Int64
h m :: Int64
m s :: 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 y :: Int64
y mo :: Int64
mo d :: Int64
d h :: Int64
h mi :: Int64
mi s :: Int64
s =
    Day -> DiffTime -> UTCTime
UTCTime (Int64 -> Int64 -> Int64 -> CalendarDate UTCTime
forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> CalendarDate dt
mkDate @UTCTime Int64
y Int64
mo Int64
d) (Int64 -> Int64 -> Int64 -> CalendarTime UTCTime
forall dt.
Calendar dt =>
Int64 -> Int64 -> Int64 -> CalendarTime dt
mkTime @UTCTime Int64
h Int64
mi Int64
s)