module Data.Duration (
Duration, Days(..),
toDuration, fixTime, zellerCongruence, assemble,
addDays, addWeeks, addMonths, addYears
) where
import Data.DateTime
type Duration = (DateTime -> DateTime)
data Days = Day | Week | Month | Year deriving (Eq, Show, Ord)
toDuration :: Integer -> Days -> Duration
toDuration amount days start =
case days of
Month -> let (y,m,d) = toGregorian' start
(y',m') = divMod (toInteger m + amount) 12
in fromGregorian' (y+y') (m + fromInteger m') d
Year -> let (y,m,d) = toGregorian' start
in fromGregorian' (y+amount) m d
Week -> toDuration (7*amount) Day start
Day -> addMinutes (1440*amount) start
fixTime :: DateTime -> Int -> DateTime
fixTime d s = addDays (if s'>=n then (s'n) else (s'n+7)) d where
(yi,mi,di) = toGregorian' d
n = zellerCongruence yi mi di
s' = toInteger s
zellerCongruence :: Integer -> Int -> Int -> Integer
zellerCongruence y m d = (toInteger d+a) `mod` 7 where
(y',m') = if m <= 2 then (y1, m+12) else (y, m)
a = y' + (y' `div` 4) (y' `div` 100) + (y' `div` 400) + toInteger (div ((m'+1)*3) 5) + toInteger (2*m'+ 1)
assemble :: DateTime -> Duration -> Maybe Duration -> [DateTime]
assemble date intDur endDur =
maybe id (\x-> (takeWhile (<= (x date)))) endDur $ iterate intDur date
addYears :: Integer -> DateTime -> DateTime
addYears x = toDuration x Year
addWeeks :: Integer -> DateTime -> DateTime
addWeeks x = toDuration x Week
addMonths :: Integer -> DateTime -> DateTime
addMonths x = toDuration x Month
addDays :: Integer -> DateTime -> DateTime
addDays x = toDuration x Day