{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RoleAnnotations #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- |
-- Module      : Data.HodaTime.Period
-- Description : Calendar-relative amounts of time.
--
-- A 'Period' is indexed by the type it can be applied to. Unit constructors
-- constrain that target, so combining date and time units with '<>' infers a
-- target that supports both sets of fields.
--
-- For example, a mixed period can be applied to a 'CalendarDateTime', while
-- either half can also be used independently with a date or time:
--
-- @
-- applyPeriod (months 5 <> hours 2) calendarDateTime
-- applyPeriod (months 5) calendarDate
-- applyPeriod (hours 2) localTime
-- @
--
-- A reusable top-level binding needs either a target annotation or
-- @NoMonomorphismRestriction@. With the latter, GHC generalizes
-- @months 5 <> hours 2@ to a period requiring both 'HasDate' and
-- 'HasLocalTime'.
module Data.HodaTime.Period
(
   Period
  ,years
  ,months
  ,weeks
  ,days
  ,hours
  ,minutes
  ,seconds
  ,nanoseconds
  ,negatePeriod
  ,scalePeriod
  ,ApplyPeriod(..)
)
where

import Data.HodaTime.CalendarDateTime.Internal
  (CalendarDateTime(..), Date, HasDate(..), IsCalendar(..), LocalTime(..))
import Data.HodaTime.LocalTime.Internal (HasLocalTime)

-- | A calendar-relative amount applicable to @target@.
--
-- The constructor is hidden so the constraints introduced by the unit
-- constructors cannot be bypassed.
data Period target = Period
  { forall target. Period target -> Int
periodYears :: !Int
  , forall target. Period target -> Int
periodMonths :: !Int
  , forall target. Period target -> Int
periodWeeks :: !Int
  , forall target. Period target -> Int
periodDays :: !Int
  , forall target. Period target -> Int
periodHours :: !Int
  , forall target. Period target -> Int
periodMinutes :: !Int
  , forall target. Period target -> Int
periodSeconds :: !Int
  , forall target. Period target -> Int
periodNanoseconds :: !Int
  }
  deriving (Period target -> Period target -> Bool
(Period target -> Period target -> Bool)
-> (Period target -> Period target -> Bool) -> Eq (Period target)
forall target. Period target -> Period target -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall target. Period target -> Period target -> Bool
== :: Period target -> Period target -> Bool
$c/= :: forall target. Period target -> Period target -> Bool
/= :: Period target -> Period target -> Bool
Eq, Int -> Period target -> ShowS
[Period target] -> ShowS
Period target -> String
(Int -> Period target -> ShowS)
-> (Period target -> String)
-> ([Period target] -> ShowS)
-> Show (Period target)
forall target. Int -> Period target -> ShowS
forall target. [Period target] -> ShowS
forall target. Period target -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall target. Int -> Period target -> ShowS
showsPrec :: Int -> Period target -> ShowS
$cshow :: forall target. Period target -> String
show :: Period target -> String
$cshowList :: forall target. [Period target] -> ShowS
showList :: [Period target] -> ShowS
Show)

type role Period nominal

instance Semigroup (Period target) where
  Period Int
y1 Int
mo1 Int
w1 Int
d1 Int
h1 Int
mi1 Int
s1 Int
ns1 <> :: Period target -> Period target -> Period target
<> Period Int
y2 Int
mo2 Int
w2 Int
d2 Int
h2 Int
mi2 Int
s2 Int
ns2 =
    Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
forall target.
Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
Period (Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y2) (Int
mo1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mo2) (Int
w1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
w2) (Int
d1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d2)
      (Int
h1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h2) (Int
mi1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
mi2) (Int
s1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
s2) (Int
ns1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ns2)

instance Monoid (Period target) where
  mempty :: Period target
mempty = Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
forall target.
Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
Period Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0 Int
0

-- | Construct a period measured in calendar years.
years, months, weeks, days :: HasDate target => Int -> Period target
years :: forall target. HasDate target => Int -> Period target
years Int
value = Period Any
forall a. Monoid a => a
mempty { periodYears = value }
-- | Construct a period measured in calendar months.
months :: forall target. HasDate target => Int -> Period target
months Int
value = Period Any
forall a. Monoid a => a
mempty { periodMonths = value }
-- | Construct a period measured in seven-day calendar weeks.
weeks :: forall target. HasDate target => Int -> Period target
weeks Int
value = Period Any
forall a. Monoid a => a
mempty { periodWeeks = value }
-- | Construct a period measured in calendar days.
days :: forall target. HasDate target => Int -> Period target
days Int
value = Period Any
forall a. Monoid a => a
mempty { periodDays = value }

-- | Construct a period measured in hours.
hours, minutes, seconds, nanoseconds :: HasLocalTime target => Int -> Period target
hours :: forall target. HasLocalTime target => Int -> Period target
hours Int
value = Period Any
forall a. Monoid a => a
mempty { periodHours = value }
-- | Construct a period measured in minutes.
minutes :: forall target. HasLocalTime target => Int -> Period target
minutes Int
value = Period Any
forall a. Monoid a => a
mempty { periodMinutes = value }
-- | Construct a period measured in seconds.
seconds :: forall target. HasLocalTime target => Int -> Period target
seconds Int
value = Period Any
forall a. Monoid a => a
mempty { periodSeconds = value }
-- | Construct a period measured in nanoseconds.
nanoseconds :: forall target. HasLocalTime target => Int -> Period target
nanoseconds Int
value = Period Any
forall a. Monoid a => a
mempty { periodNanoseconds = value }

-- | Negate every component of a period.
negatePeriod :: Period target -> Period target
negatePeriod :: forall target. Period target -> Period target
negatePeriod = Int -> Period target -> Period target
forall target. Int -> Period target -> Period target
scalePeriod (-Int
1)

-- | Multiply every component of a period by an integer.
scalePeriod :: Int -> Period target -> Period target
scalePeriod :: forall target. Int -> Period target -> Period target
scalePeriod Int
factor (Period Int
y Int
mo Int
w Int
d Int
h Int
mi Int
s Int
ns) =
  Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
forall target.
Int
-> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Period target
Period (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
y) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mo) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
w) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d)
    (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
h) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
mi) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
s) (Int
factor Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ns)

-- | Types to which periods can be applied.
class ApplyPeriod target where
  applyPeriod :: Period target -> target -> target

instance ApplyPeriod LocalTime where
  applyPeriod :: Period LocalTime -> LocalTime -> LocalTime
applyPeriod Period LocalTime
period = (Int, LocalTime) -> LocalTime
forall a b. (a, b) -> b
snd ((Int, LocalTime) -> LocalTime)
-> (LocalTime -> (Int, LocalTime)) -> LocalTime -> LocalTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Period LocalTime -> LocalTime -> (Int, LocalTime)
forall target. Period target -> LocalTime -> (Int, LocalTime)
applyTimePeriod Period LocalTime
period

instance (IsCalendar cal, Enum (Month cal)) => ApplyPeriod (Date cal) where
  applyPeriod :: Period (Date cal) -> Date cal -> Date cal
applyPeriod = Period (Date cal) -> Date cal -> Date cal
forall target periodTarget.
(HasDate target, Enum (MoY target)) =>
Period periodTarget -> target -> target
applyDatePeriod

instance (IsCalendar cal, Enum (Month cal)) => ApplyPeriod (CalendarDateTime cal) where
  applyPeriod :: Period (CalendarDateTime cal)
-> CalendarDateTime cal -> CalendarDateTime cal
applyPeriod Period (CalendarDateTime cal)
period (CalendarDateTime Date cal
date LocalTime
time) =
    Date cal -> LocalTime -> CalendarDateTime cal
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime (Int -> Date cal -> Date cal
forall target. HasDate target => Int -> target -> target
shiftDateByDays Int
carry (Period (CalendarDateTime cal) -> Date cal -> Date cal
forall target periodTarget.
(HasDate target, Enum (MoY target)) =>
Period periodTarget -> target -> target
applyDatePeriod Period (CalendarDateTime cal)
period Date cal
date)) LocalTime
time'
    where
      (Int
carry, LocalTime
time') = Period (CalendarDateTime cal) -> LocalTime -> (Int, LocalTime)
forall target. Period target -> LocalTime -> (Int, LocalTime)
applyTimePeriod Period (CalendarDateTime cal)
period LocalTime
time

-- Noda Time applies period fields from largest to smallest. Keeping year and
-- month as separate operations preserves that behavior when either clamps an
-- end-of-month date.
applyDatePeriod :: (HasDate target, Enum (MoY target)) => Period periodTarget -> target -> target
applyDatePeriod :: forall target periodTarget.
(HasDate target, Enum (MoY target)) =>
Period periodTarget -> target -> target
applyDatePeriod Period periodTarget
period =
    Int -> target -> target
forall target. HasDate target => Int -> target -> target
shiftDateByDays (Period periodTarget -> Int
forall target. Period target -> Int
periodDays Period periodTarget
period)
  (target -> target) -> (target -> target) -> target -> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> target -> target
forall target. HasDate target => Int -> target -> target
shiftDateByDays (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Period periodTarget -> Int
forall target. Period target -> Int
periodWeeks Period periodTarget
period)
  (target -> target) -> (target -> target) -> target -> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
forall target.
(target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
adjustDate (MoY target -> Int
forall a. Enum a => a -> Int
fromEnum (MoY target -> Int) -> (target -> MoY target) -> target -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. target -> MoY target
forall d. HasDate d => d -> MoY d
month) Int -> target -> target
forall target. HasDate target => Int -> target -> target
setMonthIndex (Period periodTarget -> Int
forall target. Period target -> Int
periodMonths Period periodTarget
period)
  (target -> target) -> (target -> target) -> target -> target
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
forall target.
(target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
adjustDate target -> Int
forall d. HasDate d => d -> Int
year Int -> target -> target
forall target. HasDate target => Int -> target -> target
setYear (Period periodTarget -> Int
forall target. Period target -> Int
periodYears Period periodTarget
period)

shiftDateByDays :: HasDate target => Int -> target -> target
shiftDateByDays :: forall target. HasDate target => Int -> target -> target
shiftDateByDays = (target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
forall target.
(target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
adjustDate target -> Int
forall d. HasDate d => d -> Int
day Int -> target -> target
forall target. HasDate target => Int -> target -> target
setDay

adjustDate
  :: (target -> Int)
  -> (Int -> target -> target)
  -> Int
  -> target
  -> target
adjustDate :: forall target.
(target -> Int)
-> (Int -> target -> target) -> Int -> target -> target
adjustDate target -> Int
getter Int -> target -> target
setter Int
amount target
target = Int -> target -> target
setter (target -> Int
getter target
target Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
amount) target
target

applyTimePeriod :: Period target -> LocalTime -> (Int, LocalTime)
applyTimePeriod :: forall target. Period target -> LocalTime -> (Int, LocalTime)
applyTimePeriod Period target
period (LocalTime Word32
currentSeconds Word32
currentNanoseconds) =
  (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
carry, Word32 -> Word32 -> LocalTime
LocalTime (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
secondsOfDay) (Integer -> Word32
forall a. Num a => Integer -> a
fromInteger Integer
nanos))
  where
    nanosPerSecond :: Integer
nanosPerSecond = Integer
1000000000 :: Integer
    nanosPerDay :: Integer
nanosPerDay = Integer
86400 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nanosPerSecond
    current :: Integer
current =
      (Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
currentSeconds Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nanosPerSecond) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Word32 -> Integer
forall a. Integral a => a -> Integer
toInteger Word32
currentNanoseconds
    delta :: Integer
delta =
      (((Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Period target -> Int
forall target. Period target -> Int
periodHours Period target
period) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Period target -> Int
forall target. Period target -> Int
periodMinutes Period target
period)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Period target -> Int
forall target. Period target -> Int
periodSeconds Period target
period)) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
nanosPerSecond)
        Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Period target -> Int
forall target. Period target -> Int
periodNanoseconds Period target
period)
    (Integer
carry, Integer
withinDay) = (Integer
current Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
delta) Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
nanosPerDay
    (Integer
secondsOfDay, Integer
nanos) = Integer
withinDay Integer -> Integer -> (Integer, Integer)
forall a. Integral a => a -> a -> (a, a)
`divMod` Integer
nanosPerSecond