{-|
Module: Data.Astro.Time.GregorianCalendar
Description: Gregorian Calendar
Copyright: Alexander Ignatyev, 2016


Gregorian Calendar was introduced by Pope Gregory XIII.
He abolished the days 1582-10-05 to 1582-10-14 inclusive to bring back civil and tropical years back to line.
-}

module Data.Astro.Time.GregorianCalendar
(
  isLeapYear
  , dayNumber
  , easterDayInYear
  , gregorianDateAdjustment
)

where

import Data.Time.Calendar (Day(..), fromGregorian, toGregorian)

-- Date after 15 October 1582 belongs to Gregorian Calendar

-- Before this date - to Julian Calendar

isGregorianDate :: Integer -> Int -> Int -> Bool
isGregorianDate :: Integer -> Int -> Int -> Bool
isGregorianDate Integer
y Int
m Int
d = Integer
y Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
gyear
  Bool -> Bool -> Bool
|| (Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
gyear Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
gmonth)
  Bool -> Bool -> Bool
|| (Integer
y Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
gyear Bool -> Bool -> Bool
&& Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
gmonth Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
gday)
  where gyear :: Integer
gyear = Integer
1582
        gmonth :: Int
gmonth = Int
10
        gday :: Int
gday = Int
15


gregorianDateAdjustment :: Integer -> Int ->Int -> Int
gregorianDateAdjustment :: Integer -> Int -> Int -> Int
gregorianDateAdjustment Integer
year Int
month Int
day =
  if Integer -> Int -> Int -> Bool
isGregorianDate Integer
year Int
month Int
day
  then let y :: Integer
y = if Int
month Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 then Integer
year Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1 else Integer
year
           y' :: Double
y' = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
y
           a :: Int
a = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
y' Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
       in Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
a Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate(Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
aDouble -> Double -> Double
forall a. Fractional a => a -> a -> a
/Double
4)
  else Int
0


-- | Check Gregorian calendar leap year

isLeapYear :: Integer -> Bool
isLeapYear :: Integer -> Bool
isLeapYear Integer
year =
  Integer
year Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
4 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0
  Bool -> Bool -> Bool
&& (Integer
year Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
100 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0 Bool -> Bool -> Bool
|| Integer
year Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
400 Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0)


-- | Day Number in a year

dayNumber :: Day -> Int
dayNumber :: Day -> Int
dayNumber Day
date =
  (Integer -> Int -> Int
daysBeforeMonth Integer
year Int
month) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
day
  where (Integer
year, Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian Day
date


-- | Get Easter date

-- function uses absolutely crazy Butcher's algorithm

easterDayInYear :: Int -> Day
easterDayInYear :: Int -> Day
easterDayInYear Int
year =
  let  a :: Int
a = Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
19
       b :: Int
b = Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
       c :: Int
c = Int
year Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100
       d :: Int
d = Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
       e :: Int
e = Int
b Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4
       f :: Int
f = (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
8) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
25
       g :: Int
g = (Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
fInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
3
       h :: Int
h = (Int
19Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
bInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
gInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
15) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
30
       i :: Int
i = Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4
       k :: Int
k = Int
c Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4
       l :: Int
l = (Int
32Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
eInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7
       m :: Int
m = (Int
aInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
11Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
22Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
l) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
451
       n' :: Int
n' = (Int
hInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
lInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
7Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
mInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
114)
       n :: Int
n = Int
n' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
31
       p :: Int
p = Int
n' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
31
  in Integer -> Int -> Int -> Day
fromGregorian (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
year) Int
n (Int
pInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)


daysBeforeMonth :: Integer -> Int -> Int
daysBeforeMonth :: Integer -> Int -> Int
daysBeforeMonth Integer
year Int
month =
  let a :: Double
a = if Integer -> Bool
isLeapYear Integer
year then Double
62 else Double
63
      month' :: Double
month' = (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
month) :: Double
  in if Int
month Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2 then
    Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ ((Double
month' Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1.0) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
30.6) Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a
  else Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ (Double
month' Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
1.0)Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
aDouble -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.5