-- |
-- Module        : Control.Antikythera.Unit.Time
-- Copyright     : Gautier DI FOLCO
-- License       : ISC
--
-- Maintainer    : Gautier DI FOLCO <gautier.difolco@gmail.com>
-- Stability     : Stable
-- Portability   : Portable
--
-- Every time-'Unit' classes/instances
--
-- > every 5 minute
module Control.Antikythera.Unit.Time
  ( -- * Units
    HasMinute (..),
    HasHour (..),
    HasWeekDay (..),
    HasMonthDay (..),
    HasMonth (..),
    HasYear (..),

    -- * Helpers
    ZonedTimeWrapped (..),
  )
where

import Control.Antikythera.Unit.Unit
import Data.Function (on)
import Data.List (find)
import Data.Time
import Data.Time.Calendar.Month
import Data.Time.Format.ISO8601 (ISO8601)

-- * Units

-- | Every type with minutes
--
-- > every 5 minute
class HasMinute a where
  minute :: Unit Int a

instance HasMinute TimeOfDay where
  minute :: Unit Int TimeOfDay
minute =
    Unit
      { $sel:extract:Unit :: TimeOfDay -> Int
extract = TimeOfDay -> Int
todMin,
        $sel:nextUnitWith:Unit :: Int -> TimeOfDay -> Maybe TimeOfDay
nextUnitWith = \Int
n TimeOfDay
x ->
          let m :: Int
m = Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
60
           in TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay ((TimeOfDay
x.todHour Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= TimeOfDay
x.todMin then Int
1 else Int
0)) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
24) Int
m Pico
0
      }

instance HasMinute LocalTime where
  minute :: Unit Int LocalTime
minute =
    Unit
      { $sel:extract:Unit :: LocalTime -> Int
extract = Unit Int TimeOfDay
forall a. HasMinute a => Unit Int a
minute.extract (TimeOfDay -> Int) -> (LocalTime -> TimeOfDay) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> TimeOfDay
localTimeOfDay,
        $sel:nextUnitWith:Unit :: Int -> LocalTime -> Maybe LocalTime
nextUnitWith = \Int
n LocalTime
x ->
          ((TimeOfDay -> LocalTime) -> Maybe TimeOfDay -> Maybe LocalTime)
-> Maybe TimeOfDay -> (TimeOfDay -> LocalTime) -> Maybe LocalTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TimeOfDay -> LocalTime) -> Maybe TimeOfDay -> Maybe LocalTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit Int TimeOfDay
forall a. HasMinute a => Unit Int a
minute.nextUnitWith Int
n LocalTime
x.localTimeOfDay) ((TimeOfDay -> LocalTime) -> Maybe LocalTime)
-> (TimeOfDay -> LocalTime) -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ \TimeOfDay
tod ->
            Day -> TimeOfDay -> LocalTime
LocalTime ((if TimeOfDay
tod TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
<= LocalTime
x.localTimeOfDay then Day -> Day
forall a. Enum a => a -> a
succ else Day -> Day
forall a. a -> a
id) LocalTime
x.localDay) TimeOfDay
tod
      }

instance HasMinute UTCTime where
  minute :: Unit Int UTCTime
minute =
    Unit
      { $sel:extract:Unit :: UTCTime -> Int
extract = Unit Int TimeOfDay
forall a. HasMinute a => Unit Int a
minute.extract (TimeOfDay -> Int) -> (UTCTime -> TimeOfDay) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay)
-> (UTCTime -> DiffTime) -> UTCTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> DiffTime
utctDayTime,
        $sel:nextUnitWith:Unit :: Int -> UTCTime -> Maybe UTCTime
nextUnitWith = \Int
n UTCTime
x ->
          ((TimeOfDay -> UTCTime) -> Maybe TimeOfDay -> Maybe UTCTime)
-> Maybe TimeOfDay -> (TimeOfDay -> UTCTime) -> Maybe UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TimeOfDay -> UTCTime) -> Maybe TimeOfDay -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit Int TimeOfDay
forall a. HasMinute a => Unit Int a
minute.nextUnitWith Int
n (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ DiffTime -> TimeOfDay
timeToTimeOfDay UTCTime
x.utctDayTime) ((TimeOfDay -> UTCTime) -> Maybe UTCTime)
-> (TimeOfDay -> UTCTime) -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ \TimeOfDay
tod ->
            Day -> DiffTime -> UTCTime
UTCTime ((if TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
x.utctDayTime then Day -> Day
forall a. Enum a => a -> a
succ else Day -> Day
forall a. a -> a
id) UTCTime
x.utctDay) (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
      }

instance HasMinute ZonedTime where
  minute :: Unit Int ZonedTime
minute =
    Unit
      { $sel:extract:Unit :: ZonedTime -> Int
extract = Unit Int LocalTime
forall a. HasMinute a => Unit Int a
minute.extract (LocalTime -> Int) -> (ZonedTime -> LocalTime) -> ZonedTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: Int -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \Int
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMinute a => Unit Int a
minute.nextUnitWith Int
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasMinute UniversalTime where
  minute :: Unit Int UniversalTime
minute =
    Unit
      { $sel:extract:Unit :: UniversalTime -> Int
extract = Unit Int LocalTime
forall a. HasMinute a => Unit Int a
minute.extract (LocalTime -> Int)
-> (UniversalTime -> LocalTime) -> UniversalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: Int -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \Int
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMinute a => Unit Int a
minute.nextUnitWith Int
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- | Every type with hours
--
-- > every 5 hour
class HasHour a where
  hour :: Unit Int a

instance HasHour TimeOfDay where
  hour :: Unit Int TimeOfDay
hour =
    Unit
      { $sel:extract:Unit :: TimeOfDay -> Int
extract = TimeOfDay -> Int
todHour,
        $sel:nextUnitWith:Unit :: Int -> TimeOfDay -> Maybe TimeOfDay
nextUnitWith = \Int
n TimeOfDay
_ ->
          TimeOfDay -> Maybe TimeOfDay
forall a. a -> Maybe a
Just (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
24) Int
0 Pico
0
      }

instance HasHour LocalTime where
  hour :: Unit Int LocalTime
hour =
    Unit
      { $sel:extract:Unit :: LocalTime -> Int
extract = Unit Int TimeOfDay
forall a. HasHour a => Unit Int a
hour.extract (TimeOfDay -> Int) -> (LocalTime -> TimeOfDay) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> TimeOfDay
localTimeOfDay,
        $sel:nextUnitWith:Unit :: Int -> LocalTime -> Maybe LocalTime
nextUnitWith = \Int
n LocalTime
x ->
          ((TimeOfDay -> LocalTime) -> Maybe TimeOfDay -> Maybe LocalTime)
-> Maybe TimeOfDay -> (TimeOfDay -> LocalTime) -> Maybe LocalTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TimeOfDay -> LocalTime) -> Maybe TimeOfDay -> Maybe LocalTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit Int TimeOfDay
forall a. HasHour a => Unit Int a
hour.nextUnitWith Int
n LocalTime
x.localTimeOfDay) ((TimeOfDay -> LocalTime) -> Maybe LocalTime)
-> (TimeOfDay -> LocalTime) -> Maybe LocalTime
forall a b. (a -> b) -> a -> b
$ \TimeOfDay
tod ->
            Day -> TimeOfDay -> LocalTime
LocalTime ((if TimeOfDay
tod TimeOfDay -> TimeOfDay -> Bool
forall a. Ord a => a -> a -> Bool
<= LocalTime
x.localTimeOfDay then Day -> Day
forall a. Enum a => a -> a
succ else Day -> Day
forall a. a -> a
id) LocalTime
x.localDay) TimeOfDay
tod
      }

instance HasHour UTCTime where
  hour :: Unit Int UTCTime
hour =
    Unit
      { $sel:extract:Unit :: UTCTime -> Int
extract = Unit Int TimeOfDay
forall a. HasHour a => Unit Int a
hour.extract (TimeOfDay -> Int) -> (UTCTime -> TimeOfDay) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> TimeOfDay
timeToTimeOfDay (DiffTime -> TimeOfDay)
-> (UTCTime -> DiffTime) -> UTCTime -> TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> DiffTime
utctDayTime,
        $sel:nextUnitWith:Unit :: Int -> UTCTime -> Maybe UTCTime
nextUnitWith = \Int
n UTCTime
x ->
          ((TimeOfDay -> UTCTime) -> Maybe TimeOfDay -> Maybe UTCTime)
-> Maybe TimeOfDay -> (TimeOfDay -> UTCTime) -> Maybe UTCTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip (TimeOfDay -> UTCTime) -> Maybe TimeOfDay -> Maybe UTCTime
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Unit Int TimeOfDay
forall a. HasHour a => Unit Int a
hour.nextUnitWith Int
n (TimeOfDay -> Maybe TimeOfDay) -> TimeOfDay -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ DiffTime -> TimeOfDay
timeToTimeOfDay UTCTime
x.utctDayTime) ((TimeOfDay -> UTCTime) -> Maybe UTCTime)
-> (TimeOfDay -> UTCTime) -> Maybe UTCTime
forall a b. (a -> b) -> a -> b
$ \TimeOfDay
tod ->
            Day -> DiffTime -> UTCTime
UTCTime ((if TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod DiffTime -> DiffTime -> Bool
forall a. Ord a => a -> a -> Bool
<= UTCTime
x.utctDayTime then Day -> Day
forall a. Enum a => a -> a
succ else Day -> Day
forall a. a -> a
id) UTCTime
x.utctDay) (TimeOfDay -> DiffTime
timeOfDayToTime TimeOfDay
tod)
      }

instance HasHour ZonedTime where
  hour :: Unit Int ZonedTime
hour =
    Unit
      { $sel:extract:Unit :: ZonedTime -> Int
extract = Unit Int LocalTime
forall a. HasHour a => Unit Int a
hour.extract (LocalTime -> Int) -> (ZonedTime -> LocalTime) -> ZonedTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: Int -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \Int
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasHour a => Unit Int a
hour.nextUnitWith Int
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasHour UniversalTime where
  hour :: Unit Int UniversalTime
hour =
    Unit
      { $sel:extract:Unit :: UniversalTime -> Int
extract = Unit Int LocalTime
forall a. HasHour a => Unit Int a
hour.extract (LocalTime -> Int)
-> (UniversalTime -> LocalTime) -> UniversalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: Int -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \Int
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasHour a => Unit Int a
hour.nextUnitWith Int
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- | Every type with week days (Mon - Sun)
--
-- > every 5 weekDay
class HasWeekDay a where
  weekDay :: Unit DayOfWeek a

instance HasWeekDay DayOfWeek where
  weekDay :: Unit DayOfWeek DayOfWeek
weekDay =
    Unit
      { $sel:extract:Unit :: DayOfWeek -> DayOfWeek
extract = DayOfWeek -> DayOfWeek
forall a. a -> a
id,
        $sel:nextUnitWith:Unit :: DayOfWeek -> DayOfWeek -> Maybe DayOfWeek
nextUnitWith = Maybe DayOfWeek -> DayOfWeek -> Maybe DayOfWeek
forall a b. a -> b -> a
const (Maybe DayOfWeek -> DayOfWeek -> Maybe DayOfWeek)
-> (DayOfWeek -> Maybe DayOfWeek)
-> DayOfWeek
-> DayOfWeek
-> Maybe DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek -> Maybe DayOfWeek
forall a. a -> Maybe a
Just
      }

instance HasWeekDay Day where
  weekDay :: Unit DayOfWeek Day
weekDay =
    Unit
      { $sel:extract:Unit :: Day -> DayOfWeek
extract = Unit DayOfWeek DayOfWeek
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.extract (DayOfWeek -> DayOfWeek) -> (Day -> DayOfWeek) -> Day -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Day -> DayOfWeek
dayOfWeek,
        $sel:nextUnitWith:Unit :: DayOfWeek -> Day -> Maybe Day
nextUnitWith = \DayOfWeek
n Day
x ->
          let wd :: DayOfWeek
wd = Day -> DayOfWeek
dayOfWeek (Day -> DayOfWeek) -> Day -> DayOfWeek
forall a b. (a -> b) -> a -> b
$ Day -> Day
forall a. Enum a => a -> a
succ Day
x
           in (\DayOfWeek
wd' -> Integer -> Day -> Day
addDays (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff DayOfWeek
wd' DayOfWeek
wd) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1) Day
x) (DayOfWeek -> Day) -> Maybe DayOfWeek -> Maybe Day
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit DayOfWeek DayOfWeek
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.nextUnitWith DayOfWeek
n DayOfWeek
wd
      }

instance HasWeekDay LocalTime where
  weekDay :: Unit DayOfWeek LocalTime
weekDay =
    Unit
      { $sel:extract:Unit :: LocalTime -> DayOfWeek
extract = Unit DayOfWeek Day
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.extract (Day -> DayOfWeek) -> (LocalTime -> Day) -> LocalTime -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay,
        $sel:nextUnitWith:Unit :: DayOfWeek -> LocalTime -> Maybe LocalTime
nextUnitWith = \DayOfWeek
n LocalTime
x ->
          (Day -> TimeOfDay -> LocalTime
`LocalTime` TimeOfDay
midnight) (Day -> LocalTime) -> Maybe Day -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit DayOfWeek Day
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.nextUnitWith DayOfWeek
n (LocalTime -> Day
localDay LocalTime
x)
      }

instance HasWeekDay UTCTime where
  weekDay :: Unit DayOfWeek UTCTime
weekDay =
    Unit
      { $sel:extract:Unit :: UTCTime -> DayOfWeek
extract = Unit DayOfWeek Day
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.extract (Day -> DayOfWeek) -> (UTCTime -> Day) -> UTCTime -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay,
        $sel:nextUnitWith:Unit :: DayOfWeek -> UTCTime -> Maybe UTCTime
nextUnitWith = \DayOfWeek
n UTCTime
x ->
          (Day -> DiffTime -> UTCTime
`UTCTime` DiffTime
0) (Day -> UTCTime) -> Maybe Day -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit DayOfWeek Day
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.nextUnitWith DayOfWeek
n (UTCTime -> Day
utctDay UTCTime
x)
      }

instance HasWeekDay ZonedTime where
  weekDay :: Unit DayOfWeek ZonedTime
weekDay =
    Unit
      { $sel:extract:Unit :: ZonedTime -> DayOfWeek
extract = Unit DayOfWeek LocalTime
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.extract (LocalTime -> DayOfWeek)
-> (ZonedTime -> LocalTime) -> ZonedTime -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: DayOfWeek -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \DayOfWeek
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit DayOfWeek LocalTime
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.nextUnitWith DayOfWeek
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasWeekDay UniversalTime where
  weekDay :: Unit DayOfWeek UniversalTime
weekDay =
    Unit
      { $sel:extract:Unit :: UniversalTime -> DayOfWeek
extract = Unit DayOfWeek LocalTime
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.extract (LocalTime -> DayOfWeek)
-> (UniversalTime -> LocalTime) -> UniversalTime -> DayOfWeek
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: DayOfWeek -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \DayOfWeek
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit DayOfWeek LocalTime
forall a. HasWeekDay a => Unit DayOfWeek a
weekDay.nextUnitWith DayOfWeek
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- | Every type with month days (1-31)
--
-- > every 5 monthDay
class HasMonthDay a where
  -- | 0 == Monday
  monthDay :: Unit Int a

instance HasMonthDay Day where
  monthDay :: Unit Int Day
monthDay =
    Unit
      { $sel:extract:Unit :: Day -> Int
extract = \(MonthDay Month
_ Int
d) -> Int
d,
        $sel:nextUnitWith:Unit :: Int -> Day -> Maybe Day
nextUnitWith = \Int
n x :: Day
x@(MonthDay Month
m Int
_) ->
          let td :: Int
td = if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
31 then Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
32) else Int
n
           in (Day -> Bool) -> [Day] -> Maybe Day
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\x' :: Day
x'@(MonthDay Month
_ Int
d') -> Int
d' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
td Bool -> Bool -> Bool
&& Day
x' Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
> Day
x) ([Day] -> Maybe Day) -> [Day] -> Maybe Day
forall a b. (a -> b) -> a -> b
$ (Month -> Day) -> [Month] -> [Day]
forall a b. (a -> b) -> [a] -> [b]
map (Month -> Int -> Day
`MonthDay` Int
td) [Month
m ..]
      }

instance HasMonthDay LocalTime where
  monthDay :: Unit Int LocalTime
monthDay =
    Unit
      { $sel:extract:Unit :: LocalTime -> Int
extract = Unit Int Day
forall a. HasMonthDay a => Unit Int a
monthDay.extract (Day -> Int) -> (LocalTime -> Day) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay,
        $sel:nextUnitWith:Unit :: Int -> LocalTime -> Maybe LocalTime
nextUnitWith = \Int
n LocalTime
x ->
          (Day -> TimeOfDay -> LocalTime
`LocalTime` TimeOfDay
midnight) (Day -> LocalTime) -> Maybe Day -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int Day
forall a. HasMonthDay a => Unit Int a
monthDay.nextUnitWith Int
n (LocalTime -> Day
localDay LocalTime
x)
      }

instance HasMonthDay UTCTime where
  monthDay :: Unit Int UTCTime
monthDay =
    Unit
      { $sel:extract:Unit :: UTCTime -> Int
extract = Unit Int Day
forall a. HasMonthDay a => Unit Int a
monthDay.extract (Day -> Int) -> (UTCTime -> Day) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay,
        $sel:nextUnitWith:Unit :: Int -> UTCTime -> Maybe UTCTime
nextUnitWith = \Int
n UTCTime
x ->
          (Day -> DiffTime -> UTCTime
`UTCTime` DiffTime
0) (Day -> UTCTime) -> Maybe Day -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int Day
forall a. HasMonthDay a => Unit Int a
monthDay.nextUnitWith Int
n (UTCTime -> Day
utctDay UTCTime
x)
      }

instance HasMonthDay ZonedTime where
  monthDay :: Unit Int ZonedTime
monthDay =
    Unit
      { $sel:extract:Unit :: ZonedTime -> Int
extract = Unit Int LocalTime
forall a. HasMonthDay a => Unit Int a
monthDay.extract (LocalTime -> Int) -> (ZonedTime -> LocalTime) -> ZonedTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: Int -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \Int
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMonthDay a => Unit Int a
monthDay.nextUnitWith Int
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasMonthDay UniversalTime where
  monthDay :: Unit Int UniversalTime
monthDay =
    Unit
      { $sel:extract:Unit :: UniversalTime -> Int
extract = Unit Int LocalTime
forall a. HasMonthDay a => Unit Int a
monthDay.extract (LocalTime -> Int)
-> (UniversalTime -> LocalTime) -> UniversalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: Int -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \Int
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMonthDay a => Unit Int a
monthDay.nextUnitWith Int
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- | Every type with months
--
-- > every 5 month
class HasMonth a where
  month :: Unit Int a

instance HasMonth Day where
  month :: Unit Int Day
month =
    Unit
      { $sel:extract:Unit :: Day -> Int
extract = \(MonthDay (YearMonth Integer
_ Int
m) Int
_) -> Int
m,
        $sel:nextUnitWith:Unit :: Int -> Day -> Maybe Day
nextUnitWith = \Int
n (MonthDay (YearMonth Integer
y Int
m) Int
_) ->
          let (Integer
ty, Int
tm)
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12 Bool -> Bool -> Bool
&& Int
mm Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m = (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Int
mm)
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
12 = (Integer
y, Int
mm)
                | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m = (Integer
y Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Int
n)
                | Bool
otherwise = (Integer
y, Int
n)
              mm :: Int
mm = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
n Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
13)
           in Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Month -> Int -> Day
MonthDay (Integer -> Int -> Month
YearMonth Integer
ty Int
tm) Int
1
      }

instance HasMonth LocalTime where
  month :: Unit Int LocalTime
month =
    Unit
      { $sel:extract:Unit :: LocalTime -> Int
extract = Unit Int Day
forall a. HasMonth a => Unit Int a
month.extract (Day -> Int) -> (LocalTime -> Day) -> LocalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay,
        $sel:nextUnitWith:Unit :: Int -> LocalTime -> Maybe LocalTime
nextUnitWith = \Int
n LocalTime
x ->
          (Day -> TimeOfDay -> LocalTime
`LocalTime` TimeOfDay
midnight) (Day -> LocalTime) -> Maybe Day -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int Day
forall a. HasMonth a => Unit Int a
month.nextUnitWith Int
n (LocalTime -> Day
localDay LocalTime
x)
      }

instance HasMonth UTCTime where
  month :: Unit Int UTCTime
month =
    Unit
      { $sel:extract:Unit :: UTCTime -> Int
extract = Unit Int Day
forall a. HasMonth a => Unit Int a
month.extract (Day -> Int) -> (UTCTime -> Day) -> UTCTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay,
        $sel:nextUnitWith:Unit :: Int -> UTCTime -> Maybe UTCTime
nextUnitWith = \Int
n UTCTime
x ->
          (Day -> DiffTime -> UTCTime
`UTCTime` DiffTime
0) (Day -> UTCTime) -> Maybe Day -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int Day
forall a. HasMonth a => Unit Int a
month.nextUnitWith Int
n (UTCTime -> Day
utctDay UTCTime
x)
      }

instance HasMonth ZonedTime where
  month :: Unit Int ZonedTime
month =
    Unit
      { $sel:extract:Unit :: ZonedTime -> Int
extract = Unit Int LocalTime
forall a. HasMonth a => Unit Int a
month.extract (LocalTime -> Int) -> (ZonedTime -> LocalTime) -> ZonedTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: Int -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \Int
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMonth a => Unit Int a
month.nextUnitWith Int
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasMonth UniversalTime where
  month :: Unit Int UniversalTime
month =
    Unit
      { $sel:extract:Unit :: UniversalTime -> Int
extract = Unit Int LocalTime
forall a. HasMonth a => Unit Int a
month.extract (LocalTime -> Int)
-> (UniversalTime -> LocalTime) -> UniversalTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: Int -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \Int
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Int LocalTime
forall a. HasMonth a => Unit Int a
month.nextUnitWith Int
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- | Every type with years
--
-- > every 5 year
class HasYear a where
  year :: Unit Integer a

instance HasYear Day where
  year :: Unit Integer Day
year =
    Unit
      { $sel:extract:Unit :: Day -> Integer
extract = \(MonthDay (YearMonth Integer
y Int
_) Int
_) -> Integer
y,
        $sel:nextUnitWith:Unit :: Integer -> Day -> Maybe Day
nextUnitWith = \Integer
n Day
_ -> Day -> Maybe Day
forall a. a -> Maybe a
Just (Day -> Maybe Day) -> Day -> Maybe Day
forall a b. (a -> b) -> a -> b
$ Month -> Int -> Day
MonthDay (Integer -> Int -> Month
YearMonth Integer
n Int
1) Int
1
      }

instance HasYear LocalTime where
  year :: Unit Integer LocalTime
year =
    Unit
      { $sel:extract:Unit :: LocalTime -> Integer
extract = Unit Integer Day
forall a. HasYear a => Unit Integer a
year.extract (Day -> Integer) -> (LocalTime -> Day) -> LocalTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalTime -> Day
localDay,
        $sel:nextUnitWith:Unit :: Integer -> LocalTime -> Maybe LocalTime
nextUnitWith = \Integer
n LocalTime
x ->
          (Day -> TimeOfDay -> LocalTime
`LocalTime` TimeOfDay
midnight) (Day -> LocalTime) -> Maybe Day -> Maybe LocalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Integer Day
forall a. HasYear a => Unit Integer a
year.nextUnitWith Integer
n (LocalTime -> Day
localDay LocalTime
x)
      }

instance HasYear UTCTime where
  year :: Unit Integer UTCTime
year =
    Unit
      { $sel:extract:Unit :: UTCTime -> Integer
extract = Unit Integer Day
forall a. HasYear a => Unit Integer a
year.extract (Day -> Integer) -> (UTCTime -> Day) -> UTCTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UTCTime -> Day
utctDay,
        $sel:nextUnitWith:Unit :: Integer -> UTCTime -> Maybe UTCTime
nextUnitWith = \Integer
n UTCTime
x ->
          (Day -> DiffTime -> UTCTime
`UTCTime` DiffTime
0) (Day -> UTCTime) -> Maybe Day -> Maybe UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Integer Day
forall a. HasYear a => Unit Integer a
year.nextUnitWith Integer
n (UTCTime -> Day
utctDay UTCTime
x)
      }

instance HasYear ZonedTime where
  year :: Unit Integer ZonedTime
year =
    Unit
      { $sel:extract:Unit :: ZonedTime -> Integer
extract = Unit Integer LocalTime
forall a. HasYear a => Unit Integer a
year.extract (LocalTime -> Integer)
-> (ZonedTime -> LocalTime) -> ZonedTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTime -> LocalTime
zonedTimeToLocalTime,
        $sel:nextUnitWith:Unit :: Integer -> ZonedTime -> Maybe ZonedTime
nextUnitWith = \Integer
n ZonedTime
x ->
          (LocalTime -> TimeZone -> ZonedTime)
-> TimeZone -> LocalTime -> ZonedTime
forall a b c. (a -> b -> c) -> b -> a -> c
flip LocalTime -> TimeZone -> ZonedTime
ZonedTime (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
x) (LocalTime -> ZonedTime) -> Maybe LocalTime -> Maybe ZonedTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Integer LocalTime
forall a. HasYear a => Unit Integer a
year.nextUnitWith Integer
n (ZonedTime -> LocalTime
zonedTimeToLocalTime ZonedTime
x)
      }

instance HasYear UniversalTime where
  year :: Unit Integer UniversalTime
year =
    Unit
      { $sel:extract:Unit :: UniversalTime -> Integer
extract = Unit Integer LocalTime
forall a. HasYear a => Unit Integer a
year.extract (LocalTime -> Integer)
-> (UniversalTime -> LocalTime) -> UniversalTime -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0,
        $sel:nextUnitWith:Unit :: Integer -> UniversalTime -> Maybe UniversalTime
nextUnitWith = \Integer
n UniversalTime
x ->
          Rational -> LocalTime -> UniversalTime
localTimeToUT1 Rational
0 (LocalTime -> UniversalTime)
-> Maybe LocalTime -> Maybe UniversalTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Unit Integer LocalTime
forall a. HasYear a => Unit Integer a
year.nextUnitWith Integer
n (Rational -> UniversalTime -> LocalTime
ut1ToLocalTime Rational
0 UniversalTime
x)
      }

-- * Helpers

-- | 'ZonedTime' with 'Eq' and `Ord` instances via 'UTCTime'
newtype ZonedTimeWrapped = ZonedTimeWrapped {ZonedTimeWrapped -> ZonedTime
unwrapZonedTime :: ZonedTime}
  deriving newtype (Int -> ZonedTimeWrapped -> ShowS
[ZonedTimeWrapped] -> ShowS
ZonedTimeWrapped -> String
(Int -> ZonedTimeWrapped -> ShowS)
-> (ZonedTimeWrapped -> String)
-> ([ZonedTimeWrapped] -> ShowS)
-> Show ZonedTimeWrapped
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ZonedTimeWrapped -> ShowS
showsPrec :: Int -> ZonedTimeWrapped -> ShowS
$cshow :: ZonedTimeWrapped -> String
show :: ZonedTimeWrapped -> String
$cshowList :: [ZonedTimeWrapped] -> ShowS
showList :: [ZonedTimeWrapped] -> ShowS
Show, ReadPrec [ZonedTimeWrapped]
ReadPrec ZonedTimeWrapped
Int -> ReadS ZonedTimeWrapped
ReadS [ZonedTimeWrapped]
(Int -> ReadS ZonedTimeWrapped)
-> ReadS [ZonedTimeWrapped]
-> ReadPrec ZonedTimeWrapped
-> ReadPrec [ZonedTimeWrapped]
-> Read ZonedTimeWrapped
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ZonedTimeWrapped
readsPrec :: Int -> ReadS ZonedTimeWrapped
$creadList :: ReadS [ZonedTimeWrapped]
readList :: ReadS [ZonedTimeWrapped]
$creadPrec :: ReadPrec ZonedTimeWrapped
readPrec :: ReadPrec ZonedTimeWrapped
$creadListPrec :: ReadPrec [ZonedTimeWrapped]
readListPrec :: ReadPrec [ZonedTimeWrapped]
Read, Unit Int ZonedTimeWrapped
Unit Int ZonedTimeWrapped -> HasMinute ZonedTimeWrapped
forall a. Unit Int a -> HasMinute a
$cminute :: Unit Int ZonedTimeWrapped
minute :: Unit Int ZonedTimeWrapped
HasMinute, Unit Int ZonedTimeWrapped
Unit Int ZonedTimeWrapped -> HasHour ZonedTimeWrapped
forall a. Unit Int a -> HasHour a
$chour :: Unit Int ZonedTimeWrapped
hour :: Unit Int ZonedTimeWrapped
HasHour, Unit DayOfWeek ZonedTimeWrapped
Unit DayOfWeek ZonedTimeWrapped -> HasWeekDay ZonedTimeWrapped
forall a. Unit DayOfWeek a -> HasWeekDay a
$cweekDay :: Unit DayOfWeek ZonedTimeWrapped
weekDay :: Unit DayOfWeek ZonedTimeWrapped
HasWeekDay, Unit Int ZonedTimeWrapped
Unit Int ZonedTimeWrapped -> HasMonthDay ZonedTimeWrapped
forall a. Unit Int a -> HasMonthDay a
$cmonthDay :: Unit Int ZonedTimeWrapped
monthDay :: Unit Int ZonedTimeWrapped
HasMonthDay, Unit Int ZonedTimeWrapped
Unit Int ZonedTimeWrapped -> HasMonth ZonedTimeWrapped
forall a. Unit Int a -> HasMonth a
$cmonth :: Unit Int ZonedTimeWrapped
month :: Unit Int ZonedTimeWrapped
HasMonth, Unit Integer ZonedTimeWrapped
Unit Integer ZonedTimeWrapped -> HasYear ZonedTimeWrapped
forall a. Unit Integer a -> HasYear a
$cyear :: Unit Integer ZonedTimeWrapped
year :: Unit Integer ZonedTimeWrapped
HasYear, Format ZonedTimeWrapped
Format ZonedTimeWrapped -> ISO8601 ZonedTimeWrapped
forall t. Format t -> ISO8601 t
$ciso8601Format :: Format ZonedTimeWrapped
iso8601Format :: Format ZonedTimeWrapped
ISO8601)

instance Eq ZonedTimeWrapped where
  == :: ZonedTimeWrapped -> ZonedTimeWrapped -> Bool
(==) = UTCTime -> UTCTime -> Bool
forall a. Eq a => a -> a -> Bool
(==) (UTCTime -> UTCTime -> Bool)
-> (ZonedTimeWrapped -> UTCTime)
-> ZonedTimeWrapped
-> ZonedTimeWrapped
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime)
-> (ZonedTimeWrapped -> ZonedTime) -> ZonedTimeWrapped -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTimeWrapped -> ZonedTime
unwrapZonedTime

instance Ord ZonedTimeWrapped where
  compare :: ZonedTimeWrapped -> ZonedTimeWrapped -> Ordering
compare = UTCTime -> UTCTime -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (UTCTime -> UTCTime -> Ordering)
-> (ZonedTimeWrapped -> UTCTime)
-> ZonedTimeWrapped
-> ZonedTimeWrapped
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` ZonedTime -> UTCTime
zonedTimeToUTC (ZonedTime -> UTCTime)
-> (ZonedTimeWrapped -> ZonedTime) -> ZonedTimeWrapped -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ZonedTimeWrapped -> ZonedTime
unwrapZonedTime