module Data.Duration (
    Duration, Days(..),
    toDuration, fixTime, zellerCongruence, assemble,
    addDays, addWeeks, addMonths, addYears
    ) where
import Data.DateTime

type Duration = (DateTime -> DateTime)

-- |Used as values for 'toDuration'
data Days = Day | Week | Month | Year deriving (Eq, Show, Ord)

-- |Creates a duration for the number of periods of days specified
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

-- |Increments a DateTime to be on the weekday (0-6) given
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

-- |Given year, month and day, gives the (0 based) day of the week
zellerCongruence :: Integer -> Int -> Int -> Integer
zellerCongruence y m d = (toInteger d+a) `mod` 7 where
    (y',m') = if m <= 2 then (y-1, 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)

-- |Creates a list of DateTimes given a start date, an interval duration, and an end duration from the start date
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