{- |
Module      : Time.Calendar
License     : BSD-style
Copyright   : (c) 2014 Vincent Hanquez <vincent@snarc.org>
Stability   : experimental
Portability : unknown

Miscellaneous calendar functions.
-}

module Time.Calendar
  ( isLeapYear
  , getWeekDay
  , getDayOfTheYear
  , daysInMonth
  , dateToUnixEpoch
  , dateFromUnixEpoch
  , todToSeconds
  , dateTimeToUnixEpoch
  , dateTimeFromUnixEpoch
  , dateTimeFromUnixEpochP
  ) where

import           Time.Internal
                   ( dateTimeFromUnixEpoch, dateTimeFromUnixEpochP )
import           Time.Types
                   ( Date (..), DateTime (..), Elapsed (..), Month (..)
                   , Seconds (..), TimeInterval (..), TimeOfDay (..), WeekDay
                   )

-- | For the given year in the Gregorian calendar, is it a leap year (366 days

-- long)?

isLeapYear ::
     Int
     -- ^ Year.

  -> Bool
isLeapYear :: Int -> Bool
isLeapYear Int
year
  | Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0   = Bool
False
  | Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = Bool
True
  | Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
400 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Bool
True
  | Bool
otherwise           = Bool
False

-- | For the given date in the proleptic Gregorian calendar, yield the day of

-- the week it falls on.

getWeekDay :: Date -> WeekDay
getWeekDay :: Date -> WeekDay
getWeekDay Date
date = Int -> WeekDay
forall a. Enum a => Int -> a
toEnum (Int
d Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7)
 where
  d :: Int
d = Date -> Int
daysOfDate Date
date

-- | For the given year and month in the proleptic Gregorian calendar, yield the

-- number of days from the start of the year to the start of the month.

daysUntilMonth ::
     Int
     -- ^ Year.

  -> Month
  -> Int
daysUntilMonth :: Int -> Month -> Int
daysUntilMonth Int
y Month
m
  | Int -> Bool
isLeapYear Int
y = [Int]
leapYears [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Month -> Int
forall a. Enum a => a -> Int
fromEnum Month
m
  | Bool
otherwise    = [Int]
normalYears [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Month -> Int
forall a. Enum a => a -> Int
fromEnum Month
m
 where
  normalYears :: [Int]
normalYears = [ Int
0, Int
31, Int
59, Int
90, Int
120, Int
151, Int
181, Int
212, Int
243, Int
273, Int
304, Int
334, Int
365 ]
  leapYears :: [Int]
leapYears   = [ Int
0, Int
31, Int
60, Int
91, Int
121, Int
152, Int
182, Int
213, Int
244, Int
274, Int
305, Int
335, Int
366 ]

-- | For the given year and month in the proleptic Gregorian calendar, yield the

-- number of days in the month.

daysInMonth ::
     Int
     -- ^ Year.

  -> Month
  -> Int
daysInMonth :: Int -> Month -> Int
daysInMonth Int
y Month
m
  | Month
m Month -> Month -> Bool
forall a. Eq a => a -> a -> Bool
== Month
February Bool -> Bool -> Bool
&& Int -> Bool
isLeapYear Int
y = Int
29
  | Bool
otherwise                     = [Int]
days [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Month -> Int
forall a. Enum a => a -> Int
fromEnum Month
m
 where
  days :: [Int]
days = [ Int
31, Int
28, Int
31, Int
30, Int
31, Int
30, Int
31, Int
31, Int
30, Int
31, Int
30, Int
31 ]

-- | For the given date in the proleptic Gregorian calendar, yield the number of

-- days before the date in the same year. For example, there are @0@ days before

-- 1st January.

getDayOfTheYear :: Date -> Int
getDayOfTheYear :: Date -> Int
getDayOfTheYear (Date Int
y Month
m Int
d) = Int -> Month -> Int
daysUntilMonth Int
y Month
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d

-- | For the given year in the proleptic Gregorian calendar, yield the number of

-- days before 1st January of the year and since 1st January 1 CE.

daysBeforeYear :: Int -> Int
daysBeforeYear :: Int -> Int
daysBeforeYear Int
year = Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
365 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
400)
 where
  y :: Int
y = Int
year Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | For the given date in the proleptic Gregorian calendar, yield the number of

-- days since 1st January 1 CE.

daysOfDate :: Date -> Int
daysOfDate :: Date -> Int
daysOfDate (Date Int
y Month
m Int
d) = Int -> Int
daysBeforeYear Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Month -> Int
daysUntilMonth Int
y Month
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d

-- | For the given date in the proleptic Gregorian calendar, and assuming a time

-- of 00:00:00 UTC, yield the number of seconds since the start of the Unix

-- epoch (1970-01-01 00:00:00 UTC). This assumes each day is 24 hours long.

dateToUnixEpoch :: Date -> Elapsed
dateToUnixEpoch :: Date -> Elapsed
dateToUnixEpoch Date
date =
  Seconds -> Elapsed
Elapsed (Seconds -> Elapsed) -> Seconds -> Elapsed
forall a b. (a -> b) -> a -> b
$ Int64 -> Seconds
Seconds (Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Date -> Int
daysOfDate Date
date Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
epochDays) Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
secondsPerDay)
 where
  epochDays :: Int
epochDays     = Int
719163
  secondsPerDay :: Int64
secondsPerDay = Int64
86400 -- Julian day is 24h


-- | For the given period of time since the start of the Unix epoch

-- (1970-01-01 00:00:00 UTC), yield the corresponding date.

dateFromUnixEpoch :: Elapsed -> Date
dateFromUnixEpoch :: Elapsed -> Date
dateFromUnixEpoch Elapsed
e = DateTime -> Date
dtDate (DateTime -> Date) -> DateTime -> Date
forall a b. (a -> b) -> a -> b
$ Elapsed -> DateTime
dateTimeFromUnixEpoch Elapsed
e

-- | For the given time of day, yield the number of seconds since the start of

-- the day.

todToSeconds :: TimeOfDay -> Seconds
todToSeconds :: TimeOfDay -> Seconds
todToSeconds (TimeOfDay Hours
h Minutes
m Seconds
s NanoSeconds
_) = Hours -> Seconds
forall i. TimeInterval i => i -> Seconds
toSeconds Hours
h Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
+ Minutes -> Seconds
forall i. TimeInterval i => i -> Seconds
toSeconds Minutes
m Seconds -> Seconds -> Seconds
forall a. Num a => a -> a -> a
+ Seconds
s

-- | For the given date (in the proleptic Gregorian calendar) and time (in UTC),

-- yield the number of seconds that have elapsed since the start of the Unix

-- epoch.

dateTimeToUnixEpoch :: DateTime -> Elapsed
dateTimeToUnixEpoch :: DateTime -> Elapsed
dateTimeToUnixEpoch (DateTime Date
d TimeOfDay
t) =
  Date -> Elapsed
dateToUnixEpoch Date
d Elapsed -> Elapsed -> Elapsed
forall a. Num a => a -> a -> a
+ Seconds -> Elapsed
Elapsed (TimeOfDay -> Seconds
todToSeconds TimeOfDay
t)