module Data.Hourglass.Calendar
( isLeapYear
, getWeekDay
, getDayOfTheYear
, daysInMonth
, dateToUnixEpoch
, dateFromUnixEpoch
, todToSeconds
, dateTimeToUnixEpoch
, dateTimeFromUnixEpoch
, dateTimeFromUnixEpochP
) where
import Data.Hourglass.Types
import Data.Hourglass.Internal
isLeapYear :: Int -> Bool
isLeapYear year
| year `mod` 4 /= 0 = False
| year `mod` 100 /= 0 = True
| year `mod` 400 == 0 = True
| otherwise = False
getWeekDay :: Date -> WeekDay
getWeekDay date = toEnum (d `mod` 7)
where d = daysOfDate date
daysUntilMonth :: Int -> Month -> Int
daysUntilMonth y m
| isLeapYear y = leapYears !! fromEnum m
| otherwise = normalYears !! fromEnum m
where normalYears = [ 0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365 ]
leapYears = [ 0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366 ]
daysInMonth :: Int -> Month -> Int
daysInMonth y m
| m == February && isLeapYear y = 29
| otherwise = days !! fromEnum m
where days = [31,28,31,30,31,30,31,31,30,31,30,31]
getDayOfTheYear :: Date -> Int
getDayOfTheYear (Date y m d) = daysUntilMonth y m + d
daysBeforeYear :: Int -> Int
daysBeforeYear year = y * 365 + (y `div` 4) - (y `div` 100) + (y `div` 400)
where y = year - 1
daysOfDate :: Date -> Int
daysOfDate (Date y m d) = daysBeforeYear y + daysUntilMonth y m + d
dateToUnixEpoch :: Date -> Elapsed
dateToUnixEpoch date = Elapsed $ Seconds (fromIntegral (daysOfDate date - epochDays) * secondsPerDay)
where epochDays = 719163
secondsPerDay = 86400
dateFromUnixEpoch :: Elapsed -> Date
dateFromUnixEpoch e = dtDate $ dateTimeFromUnixEpoch e
todToSeconds :: TimeOfDay -> Seconds
todToSeconds (TimeOfDay h m s _) = toSeconds h + toSeconds m + s
dateTimeToUnixEpoch :: DateTime -> Elapsed
dateTimeToUnixEpoch (DateTime d t) = dateToUnixEpoch d + Elapsed (todToSeconds t)