{-# options_haddock prune #-}
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)
class HasDate t d | t -> d where
date :: t -> d
dateToTime :: d -> t
class HasYear t where
year :: t -> Years
class HasMonth t where
month :: t -> Months
class HasDay t where
day :: t -> Days
class HasHour t where
hour :: t -> Hours
class HasMinute t where
minute :: t -> Minutes
class HasSecond t where
second :: t -> Seconds
class HasNanoSecond t where
nanoSecond :: t -> NanoSeconds
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)