{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
module Data.HodaTime.Calendar.Gregorian.Internal
(
   daysToYearMonthDay
  ,fromWeekDate
  ,Gregorian
  ,Month(..)
  ,DayOfWeek(..)
  ,invalidDayThresh
  ,epochDayOfWeek
  ,maxDaysInMonth
  ,yearMonthDayToDays
  ,nthDayToDayOfMonth
  ,dayOfWeekFromDays
  ,instantToYearMonthDay
  ,yearMonthDayToCycleCenturyDays
  ,gregorianFromYmd
  ,gregorianToDays
  ,daysToGregorian
  ,gregorianToYearMonthDay
)
where

import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), IsCalendarDateTime(..), DayOfMonth, Year, WeekNumber, CalendarDateTime(..), LocalTime(..), Date)
import Data.HodaTime.Calendar.Gregorian.CacheTable (DTCacheTable(..), decodeMonth, decodeYear, decodeDay, cacheTable)
import Data.HodaTime.Calendar.Internal (mkCommonMonthSetter, mkYearSetter, mkFromWeekDate, dayOfWeekFromDays, commonMonthDayOffsets, borders, daysPerStandardYear, daysPerCentury)
import Data.HodaTime.Instant.Internal (Instant(..))
import Control.Arrow ((>>>), (&&&), (***), first)
import Data.Int (Int32, Int8)
import Data.Word (Word8, Word32)
import Data.Array.Unboxed ((!))
import Control.DeepSeq (NFData(..))
import Data.Hashable (Hashable(..))

-- Constants

yearsPerCycle :: Num a => a
yearsPerCycle :: forall a. Num a => a
yearsPerCycle = a
400

daysPerCycle :: Num a => a      -- NOTE: A "cycle" is 400 years
daysPerCycle :: forall a. Num a => a
daysPerCycle = a
146097

invalidDayThresh :: Integral a => a
invalidDayThresh :: forall a. Integral a => a
invalidDayThresh = -a
152445      -- NOTE: 14.Oct.1582, one day before Gregorian calendar came into effect

firstGregDayTuple :: (Integral a, Integral b, Integral c) => (a, b, c)
firstGregDayTuple :: forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstGregDayTuple = (a
1582, b
9, c
15)
    
epochDayOfWeek :: DayOfWeek Gregorian
epochDayOfWeek :: DayOfWeek Gregorian
epochDayOfWeek = DayOfWeek Gregorian
Wednesday

-- types
    
data Gregorian
    
instance IsCalendar Gregorian where
  data Date Gregorian = GregorianDate {-# UNPACK #-} !Int8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word32
    deriving (Date Gregorian -> Date Gregorian -> Bool
(Date Gregorian -> Date Gregorian -> Bool)
-> (Date Gregorian -> Date Gregorian -> Bool)
-> Eq (Date Gregorian)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date Gregorian -> Date Gregorian -> Bool
== :: Date Gregorian -> Date Gregorian -> Bool
$c/= :: Date Gregorian -> Date Gregorian -> Bool
/= :: Date Gregorian -> Date Gregorian -> Bool
Eq, Eq (Date Gregorian)
Eq (Date Gregorian) =>
(Date Gregorian -> Date Gregorian -> Ordering)
-> (Date Gregorian -> Date Gregorian -> Bool)
-> (Date Gregorian -> Date Gregorian -> Bool)
-> (Date Gregorian -> Date Gregorian -> Bool)
-> (Date Gregorian -> Date Gregorian -> Bool)
-> (Date Gregorian -> Date Gregorian -> Date Gregorian)
-> (Date Gregorian -> Date Gregorian -> Date Gregorian)
-> Ord (Date Gregorian)
Date Gregorian -> Date Gregorian -> Bool
Date Gregorian -> Date Gregorian -> Ordering
Date Gregorian -> Date Gregorian -> Date Gregorian
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Date Gregorian -> Date Gregorian -> Ordering
compare :: Date Gregorian -> Date Gregorian -> Ordering
$c< :: Date Gregorian -> Date Gregorian -> Bool
< :: Date Gregorian -> Date Gregorian -> Bool
$c<= :: Date Gregorian -> Date Gregorian -> Bool
<= :: Date Gregorian -> Date Gregorian -> Bool
$c> :: Date Gregorian -> Date Gregorian -> Bool
> :: Date Gregorian -> Date Gregorian -> Bool
$c>= :: Date Gregorian -> Date Gregorian -> Bool
>= :: Date Gregorian -> Date Gregorian -> Bool
$cmax :: Date Gregorian -> Date Gregorian -> Date Gregorian
max :: Date Gregorian -> Date Gregorian -> Date Gregorian
$cmin :: Date Gregorian -> Date Gregorian -> Date Gregorian
min :: Date Gregorian -> Date Gregorian -> Date Gregorian
Ord)

  data DayOfWeek Gregorian = Sunday | Monday | Tuesday | Wednesday | Thursday | Friday | Saturday
    deriving (Int -> DayOfWeek Gregorian -> ShowS
[DayOfWeek Gregorian] -> ShowS
DayOfWeek Gregorian -> String
(Int -> DayOfWeek Gregorian -> ShowS)
-> (DayOfWeek Gregorian -> String)
-> ([DayOfWeek Gregorian] -> ShowS)
-> Show (DayOfWeek Gregorian)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DayOfWeek Gregorian -> ShowS
showsPrec :: Int -> DayOfWeek Gregorian -> ShowS
$cshow :: DayOfWeek Gregorian -> String
show :: DayOfWeek Gregorian -> String
$cshowList :: [DayOfWeek Gregorian] -> ShowS
showList :: [DayOfWeek Gregorian] -> ShowS
Show, ReadPrec [DayOfWeek Gregorian]
ReadPrec (DayOfWeek Gregorian)
Int -> ReadS (DayOfWeek Gregorian)
ReadS [DayOfWeek Gregorian]
(Int -> ReadS (DayOfWeek Gregorian))
-> ReadS [DayOfWeek Gregorian]
-> ReadPrec (DayOfWeek Gregorian)
-> ReadPrec [DayOfWeek Gregorian]
-> Read (DayOfWeek Gregorian)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS (DayOfWeek Gregorian)
readsPrec :: Int -> ReadS (DayOfWeek Gregorian)
$creadList :: ReadS [DayOfWeek Gregorian]
readList :: ReadS [DayOfWeek Gregorian]
$creadPrec :: ReadPrec (DayOfWeek Gregorian)
readPrec :: ReadPrec (DayOfWeek Gregorian)
$creadListPrec :: ReadPrec [DayOfWeek Gregorian]
readListPrec :: ReadPrec [DayOfWeek Gregorian]
Read, DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
(DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> Eq (DayOfWeek Gregorian)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
== :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
$c/= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
/= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
Eq, Eq (DayOfWeek Gregorian)
Eq (DayOfWeek Gregorian) =>
(DayOfWeek Gregorian -> DayOfWeek Gregorian -> Ordering)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool)
-> (DayOfWeek Gregorian
    -> DayOfWeek Gregorian -> DayOfWeek Gregorian)
-> (DayOfWeek Gregorian
    -> DayOfWeek Gregorian -> DayOfWeek Gregorian)
-> Ord (DayOfWeek Gregorian)
DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
DayOfWeek Gregorian -> DayOfWeek Gregorian -> Ordering
DayOfWeek Gregorian -> DayOfWeek Gregorian -> DayOfWeek Gregorian
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Ordering
compare :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Ordering
$c< :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
< :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
$c<= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
<= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
$c> :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
> :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
$c>= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
>= :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> Bool
$cmax :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> DayOfWeek Gregorian
max :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> DayOfWeek Gregorian
$cmin :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> DayOfWeek Gregorian
min :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> DayOfWeek Gregorian
Ord, Int -> DayOfWeek Gregorian
DayOfWeek Gregorian -> Int
DayOfWeek Gregorian -> [DayOfWeek Gregorian]
DayOfWeek Gregorian -> DayOfWeek Gregorian
DayOfWeek Gregorian -> DayOfWeek Gregorian -> [DayOfWeek Gregorian]
DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> [DayOfWeek Gregorian]
(DayOfWeek Gregorian -> DayOfWeek Gregorian)
-> (DayOfWeek Gregorian -> DayOfWeek Gregorian)
-> (Int -> DayOfWeek Gregorian)
-> (DayOfWeek Gregorian -> Int)
-> (DayOfWeek Gregorian -> [DayOfWeek Gregorian])
-> (DayOfWeek Gregorian
    -> DayOfWeek Gregorian -> [DayOfWeek Gregorian])
-> (DayOfWeek Gregorian
    -> DayOfWeek Gregorian -> [DayOfWeek Gregorian])
-> (DayOfWeek Gregorian
    -> DayOfWeek Gregorian
    -> DayOfWeek Gregorian
    -> [DayOfWeek Gregorian])
-> Enum (DayOfWeek Gregorian)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: DayOfWeek Gregorian -> DayOfWeek Gregorian
succ :: DayOfWeek Gregorian -> DayOfWeek Gregorian
$cpred :: DayOfWeek Gregorian -> DayOfWeek Gregorian
pred :: DayOfWeek Gregorian -> DayOfWeek Gregorian
$ctoEnum :: Int -> DayOfWeek Gregorian
toEnum :: Int -> DayOfWeek Gregorian
$cfromEnum :: DayOfWeek Gregorian -> Int
fromEnum :: DayOfWeek Gregorian -> Int
$cenumFrom :: DayOfWeek Gregorian -> [DayOfWeek Gregorian]
enumFrom :: DayOfWeek Gregorian -> [DayOfWeek Gregorian]
$cenumFromThen :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> [DayOfWeek Gregorian]
enumFromThen :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> [DayOfWeek Gregorian]
$cenumFromTo :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> [DayOfWeek Gregorian]
enumFromTo :: DayOfWeek Gregorian -> DayOfWeek Gregorian -> [DayOfWeek Gregorian]
$cenumFromThenTo :: DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> [DayOfWeek Gregorian]
enumFromThenTo :: DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> DayOfWeek Gregorian
-> [DayOfWeek Gregorian]
Enum, DayOfWeek Gregorian
DayOfWeek Gregorian
-> DayOfWeek Gregorian -> Bounded (DayOfWeek Gregorian)
forall a. a -> a -> Bounded a
$cminBound :: DayOfWeek Gregorian
minBound :: DayOfWeek Gregorian
$cmaxBound :: DayOfWeek Gregorian
maxBound :: DayOfWeek Gregorian
Bounded)

  data Month Gregorian = January | February | March | April | May | June | July | August | September | October | November | December
    deriving (Int -> Month Gregorian -> ShowS
[Month Gregorian] -> ShowS
Month Gregorian -> String
(Int -> Month Gregorian -> ShowS)
-> (Month Gregorian -> String)
-> ([Month Gregorian] -> ShowS)
-> Show (Month Gregorian)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Month Gregorian -> ShowS
showsPrec :: Int -> Month Gregorian -> ShowS
$cshow :: Month Gregorian -> String
show :: Month Gregorian -> String
$cshowList :: [Month Gregorian] -> ShowS
showList :: [Month Gregorian] -> ShowS
Show, ReadPrec [Month Gregorian]
ReadPrec (Month Gregorian)
Int -> ReadS (Month Gregorian)
ReadS [Month Gregorian]
(Int -> ReadS (Month Gregorian))
-> ReadS [Month Gregorian]
-> ReadPrec (Month Gregorian)
-> ReadPrec [Month Gregorian]
-> Read (Month Gregorian)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS (Month Gregorian)
readsPrec :: Int -> ReadS (Month Gregorian)
$creadList :: ReadS [Month Gregorian]
readList :: ReadS [Month Gregorian]
$creadPrec :: ReadPrec (Month Gregorian)
readPrec :: ReadPrec (Month Gregorian)
$creadListPrec :: ReadPrec [Month Gregorian]
readListPrec :: ReadPrec [Month Gregorian]
Read, Month Gregorian -> Month Gregorian -> Bool
(Month Gregorian -> Month Gregorian -> Bool)
-> (Month Gregorian -> Month Gregorian -> Bool)
-> Eq (Month Gregorian)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Month Gregorian -> Month Gregorian -> Bool
== :: Month Gregorian -> Month Gregorian -> Bool
$c/= :: Month Gregorian -> Month Gregorian -> Bool
/= :: Month Gregorian -> Month Gregorian -> Bool
Eq, Eq (Month Gregorian)
Eq (Month Gregorian) =>
(Month Gregorian -> Month Gregorian -> Ordering)
-> (Month Gregorian -> Month Gregorian -> Bool)
-> (Month Gregorian -> Month Gregorian -> Bool)
-> (Month Gregorian -> Month Gregorian -> Bool)
-> (Month Gregorian -> Month Gregorian -> Bool)
-> (Month Gregorian -> Month Gregorian -> Month Gregorian)
-> (Month Gregorian -> Month Gregorian -> Month Gregorian)
-> Ord (Month Gregorian)
Month Gregorian -> Month Gregorian -> Bool
Month Gregorian -> Month Gregorian -> Ordering
Month Gregorian -> Month Gregorian -> Month Gregorian
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Month Gregorian -> Month Gregorian -> Ordering
compare :: Month Gregorian -> Month Gregorian -> Ordering
$c< :: Month Gregorian -> Month Gregorian -> Bool
< :: Month Gregorian -> Month Gregorian -> Bool
$c<= :: Month Gregorian -> Month Gregorian -> Bool
<= :: Month Gregorian -> Month Gregorian -> Bool
$c> :: Month Gregorian -> Month Gregorian -> Bool
> :: Month Gregorian -> Month Gregorian -> Bool
$c>= :: Month Gregorian -> Month Gregorian -> Bool
>= :: Month Gregorian -> Month Gregorian -> Bool
$cmax :: Month Gregorian -> Month Gregorian -> Month Gregorian
max :: Month Gregorian -> Month Gregorian -> Month Gregorian
$cmin :: Month Gregorian -> Month Gregorian -> Month Gregorian
min :: Month Gregorian -> Month Gregorian -> Month Gregorian
Ord, Int -> Month Gregorian
Month Gregorian -> Int
Month Gregorian -> [Month Gregorian]
Month Gregorian -> Month Gregorian
Month Gregorian -> Month Gregorian -> [Month Gregorian]
Month Gregorian
-> Month Gregorian -> Month Gregorian -> [Month Gregorian]
(Month Gregorian -> Month Gregorian)
-> (Month Gregorian -> Month Gregorian)
-> (Int -> Month Gregorian)
-> (Month Gregorian -> Int)
-> (Month Gregorian -> [Month Gregorian])
-> (Month Gregorian -> Month Gregorian -> [Month Gregorian])
-> (Month Gregorian -> Month Gregorian -> [Month Gregorian])
-> (Month Gregorian
    -> Month Gregorian -> Month Gregorian -> [Month Gregorian])
-> Enum (Month Gregorian)
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Month Gregorian -> Month Gregorian
succ :: Month Gregorian -> Month Gregorian
$cpred :: Month Gregorian -> Month Gregorian
pred :: Month Gregorian -> Month Gregorian
$ctoEnum :: Int -> Month Gregorian
toEnum :: Int -> Month Gregorian
$cfromEnum :: Month Gregorian -> Int
fromEnum :: Month Gregorian -> Int
$cenumFrom :: Month Gregorian -> [Month Gregorian]
enumFrom :: Month Gregorian -> [Month Gregorian]
$cenumFromThen :: Month Gregorian -> Month Gregorian -> [Month Gregorian]
enumFromThen :: Month Gregorian -> Month Gregorian -> [Month Gregorian]
$cenumFromTo :: Month Gregorian -> Month Gregorian -> [Month Gregorian]
enumFromTo :: Month Gregorian -> Month Gregorian -> [Month Gregorian]
$cenumFromThenTo :: Month Gregorian
-> Month Gregorian -> Month Gregorian -> [Month Gregorian]
enumFromThenTo :: Month Gregorian
-> Month Gregorian -> Month Gregorian -> [Month Gregorian]
Enum, Month Gregorian
Month Gregorian -> Month Gregorian -> Bounded (Month Gregorian)
forall a. a -> a -> Bounded a
$cminBound :: Month Gregorian
minBound :: Month Gregorian
$cmaxBound :: Month Gregorian
maxBound :: Month Gregorian
Bounded)

  fromDays :: Int32 -> Date Gregorian
fromDays = Int32 -> Date Gregorian
daysToGregorian
  toDays :: Date Gregorian -> Int32
toDays = Date Gregorian -> Int32
gregorianToDays
  toYmd :: Date Gregorian -> (Int32, Word8, Word8)
toYmd = Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay
  calendarName :: Date Gregorian -> String
calendarName Date Gregorian
_ = String
"Gregorian"

  -- Fast path: shift only the day-in-century, leaving cycle\/century untouched when we stay in-century.
  day' :: Date Gregorian -> Int
day' Date Gregorian
gd = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
    where (Int32
_, Word8
_, Word8
d) = Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Date Gregorian
gd

  setDay' :: Int -> Date Gregorian -> Date Gregorian
setDay' Int
newDay Date Gregorian
gd = (Int32 -> Int32) -> Int -> Date Gregorian -> Date Gregorian
shiftDaysWith Int32 -> Int32
clampToValid (Int
newDay Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d) Date Gregorian
gd
    where
      (Int32
_, Word8
_, Word8
d) = Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Date Gregorian
gd

  month' :: Date Gregorian -> Month Gregorian
month' Date Gregorian
gd = Int -> Month Gregorian
forall a. Enum a => Int -> a
toEnum (Int -> Month Gregorian)
-> (Word8 -> Int) -> Word8 -> Month Gregorian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month Gregorian) -> Word8 -> Month Gregorian
forall a b. (a -> b) -> a -> b
$ Word8
m
    where (Int32
_, Word8
m, Word8
_) = Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Date Gregorian
gd
  setMonthIndex' :: Int -> Date Gregorian -> Date Gregorian
setMonthIndex' = Int
-> (Int, Int, Word8)
-> (Month Gregorian -> Int -> Int)
-> (Int -> Month Gregorian -> Int -> Int)
-> (Date Gregorian -> (Int32, Word8, Word8))
-> (Int32 -> Date Gregorian)
-> Int
-> Date Gregorian
-> Date Gregorian
forall mon d.
Enum mon =>
Int
-> (Int, Int, Word8)
-> (mon -> Int -> Int)
-> (Int -> mon -> Int -> Int)
-> (d -> (Int32, Word8, Word8))
-> (Int32 -> d)
-> Int
-> d
-> d
mkCommonMonthSetter Int
12 (Int, Int, Word8)
forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstGregDayTuple Month Gregorian -> Int -> Int
maxDaysInMonth Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Int32 -> Date Gregorian
daysToGregorian
  {-# INLINE month' #-}

  year' :: Date Gregorian -> Int
year' Date Gregorian
gd = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y
    where (Int32
y, Word8
_, Word8
_) = Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Date Gregorian
gd

  setYear' :: Int -> Date Gregorian -> Date Gregorian
setYear' = (Int, Word8, Word8)
-> (Month Gregorian -> Int -> Int)
-> (Int -> Month Gregorian -> Int -> Int)
-> (Date Gregorian -> (Int32, Word8, Word8))
-> (Int32 -> Date Gregorian)
-> Int
-> Date Gregorian
-> Date Gregorian
forall mon d.
Enum mon =>
(Int, Word8, Word8)
-> (mon -> Int -> Int)
-> (Int -> mon -> Int -> Int)
-> (d -> (Int32, Word8, Word8))
-> (Int32 -> d)
-> Int
-> d
-> d
mkYearSetter (Int, Word8, Word8)
forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstGregDayTuple Month Gregorian -> Int -> Int
maxDaysInMonth Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay Int32 -> Date Gregorian
daysToGregorian
  {-# INLINE year' #-}

  dayOfWeek' :: Date Gregorian -> DayOfWeek Gregorian
dayOfWeek' (GregorianDate Int8
_ Word8
century Word32
dic) = Int -> DayOfWeek Gregorian
forall a. Enum a => Int -> a
toEnum (Int -> DayOfWeek Gregorian)
-> (Int -> Int) -> Int -> DayOfWeek Gregorian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek Gregorian -> Int -> Int
forall dow. Enum dow => dow -> Int -> Int
dayOfWeekFromDays DayOfWeek Gregorian
epochDayOfWeek (Int -> DayOfWeek Gregorian) -> Int -> DayOfWeek Gregorian
forall a b. (a -> b) -> a -> b
$ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
century Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dic

  next' :: Int -> DayOfWeek Gregorian -> Date Gregorian -> Date Gregorian
next' Int
n DayOfWeek Gregorian
dow gd :: Date Gregorian
gd@(GregorianDate Int8
_ Word8
century Word32
dic) = (Int32 -> Int32) -> Int -> Date Gregorian -> Date Gregorian
shiftDaysWith Int32 -> Int32
forall a. a -> a
id (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
targetDow Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
currentDoW) Date Gregorian
gd
    where
      currentDoW :: Int
currentDoW = DayOfWeek Gregorian -> Int -> Int
forall dow. Enum dow => dow -> Int -> Int
dayOfWeekFromDays DayOfWeek Gregorian
epochDayOfWeek (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
century Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dic
      targetDow :: Int
targetDow = DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek Gregorian
dow
      n' :: Int
n' = if Int
targetDow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
currentDoW then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
n

  previous' :: Int -> DayOfWeek Gregorian -> Date Gregorian -> Date Gregorian
previous' Int
n DayOfWeek Gregorian
dow gd :: Date Gregorian
gd@(GregorianDate Int8
_ Word8
century Word32
dic) = (Int32 -> Int32) -> Int -> Date Gregorian -> Date Gregorian
shiftDaysWith Int32 -> Int32
forall a. a -> a
id (Int -> Int
forall a. Num a => a -> a
negate (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
currentDoW Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
targetDow) Date Gregorian
gd
    where
      currentDoW :: Int
currentDoW = DayOfWeek Gregorian -> Int -> Int
forall dow. Enum dow => dow -> Int -> Int
dayOfWeekFromDays DayOfWeek Gregorian
epochDayOfWeek (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
century Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dic
      targetDow :: Int
targetDow = DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek Gregorian
dow
      n' :: Int
n' = if Int
targetDow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
currentDoW then Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
n

instance NFData (Date Gregorian) where
  rnf :: Date Gregorian -> ()
rnf (GregorianDate Int8
cyc Word8
century Word32
dic) = Int8 -> ()
forall a. NFData a => a -> ()
rnf Int8
cyc () -> () -> ()
forall a b. a -> b -> b
`seq` Word8 -> ()
forall a. NFData a => a -> ()
rnf Word8
century () -> () -> ()
forall a b. a -> b -> b
`seq` Word32 -> ()
forall a. NFData a => a -> ()
rnf Word32
dic

instance Hashable (Date Gregorian) where
  hashWithSalt :: Int -> Date Gregorian -> Int
hashWithSalt Int
s (GregorianDate Int8
cyc Word8
century Word32
dic) = Int
s Int -> Int8 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int8
cyc Int -> Word8 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word8
century Int -> Word32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word32
dic

instance NFData (Month Gregorian) where
  rnf :: Month Gregorian -> ()
rnf Month Gregorian
m = Month Gregorian
m Month Gregorian -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance Hashable (Month Gregorian) where
  hashWithSalt :: Int -> Month Gregorian -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int) -> (Month Gregorian -> Int) -> Month Gregorian -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum

instance NFData (DayOfWeek Gregorian) where
  rnf :: DayOfWeek Gregorian -> ()
rnf DayOfWeek Gregorian
d = DayOfWeek Gregorian
d DayOfWeek Gregorian -> () -> ()
forall a b. a -> b -> b
`seq` ()

instance Hashable (DayOfWeek Gregorian) where
  hashWithSalt :: Int -> DayOfWeek Gregorian -> Int
hashWithSalt Int
s = Int -> Int -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (Int -> Int)
-> (DayOfWeek Gregorian -> Int) -> DayOfWeek Gregorian -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum

instance IsCalendarDateTime Gregorian where
  fromAdjustedInstant :: Instant -> CalendarDateTime Gregorian
fromAdjustedInstant (Instant Int32
days Word32
secs Word32
nsecs) = Date Gregorian -> LocalTime -> CalendarDateTime Gregorian
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime (Int32 -> Date Gregorian
daysToGregorian Int32
days) (Word32 -> Word32 -> LocalTime
LocalTime Word32
secs Word32
nsecs)
  toUnadjustedInstant :: CalendarDateTime Gregorian -> Instant
toUnadjustedInstant (CalendarDateTime Date Gregorian
gd (LocalTime Word32
secs Word32
nsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant (Date Gregorian -> Int32
gregorianToDays Date Gregorian
gd) Word32
secs Word32
nsecs

-- constructors

fromWeekDate :: Int -> DayOfWeek Gregorian -> WeekNumber -> DayOfWeek Gregorian -> Year -> Maybe (Date Gregorian)
fromWeekDate :: Int
-> DayOfWeek Gregorian
-> Int
-> DayOfWeek Gregorian
-> Int
-> Maybe (Date Gregorian)
fromWeekDate = Int
-> DayOfWeek Gregorian
-> (Int -> Month Gregorian -> Int -> Int)
-> (Int32 -> Date Gregorian)
-> Int
-> DayOfWeek Gregorian
-> Int
-> DayOfWeek Gregorian
-> Int
-> Maybe (Date Gregorian)
forall mon dow d.
(Enum mon, Enum dow) =>
Int
-> dow
-> (Int -> mon -> Int -> Int)
-> (Int32 -> d)
-> Int
-> dow
-> Int
-> dow
-> Int
-> Maybe d
mkFromWeekDate Int
forall a. Integral a => a
invalidDayThresh DayOfWeek Gregorian
epochDayOfWeek Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Int32 -> Date Gregorian
daysToGregorian

-- helper functions

nthDayToDayOfMonth :: Int -> Int -> Month Gregorian -> Int -> Int
nthDayToDayOfMonth :: Int -> Int -> Month Gregorian -> Int -> Int
nthDayToDayOfMonth Int
nth Int
day Month Gregorian
month Int
y
  | Int
nth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0   = Int
mdm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
backwardDist Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
nth Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)      -- NOTE: "from last" (POSIX week 5 -> nth -1) counts back from the last day, so the final weekday is not missed when the month ends exactly on it
  | Bool
otherwise = Int
1   Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forwardDist  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
nth
  where
    mdm :: Int
mdm = Month Gregorian -> Int -> Int
maxDaysInMonth Month Gregorian
month Int
y
    forwardDist :: Int
forwardDist  = (Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
dowOf Int
1)   Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7
    backwardDist :: Int
backwardDist = (Int -> Int
dowOf Int
mdm Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
day) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7
    dowOf :: Int -> Int
dowOf Int
dom = (Int
dom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
13 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yrhs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
yrhs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
ylhs Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ylhs) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
7
    m :: Int
m = Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
month
    (Int
m', Int
y') = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2 then (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
11, Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) else (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
y)
    yrhs :: Int
yrhs = Int
y' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100
    ylhs :: Int
ylhs = Int
y' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100

maxDaysInMonth :: Month Gregorian -> Year -> Int
maxDaysInMonth :: Month Gregorian -> Int -> Int
maxDaysInMonth Month Gregorian
R:MonthGregorian
February Int
y
  | Bool
isLeap                                = Int
29
  | Bool
otherwise                             = Int
28
  where
    isLeap :: Bool
isLeap
      | Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
100                  = Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
400
      | Bool
otherwise                         = Int
0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4
maxDaysInMonth Month Gregorian
m Int
_
  | Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Gregorian
April Bool -> Bool -> Bool
|| Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Gregorian
June Bool -> Bool -> Bool
|| Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Gregorian
September Bool -> Bool -> Bool
|| Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Gregorian
November  = Int
30
  | Bool
otherwise                                                   = Int
31

-- | Construct the (cycle, century, day-in-century) triple directly from a year\/month\/day, without first
--   computing the flat day count and dividing it back down.  Within a cycle each century is exactly 36524 days
--   (4*36524 = 146097 - 1, the missing day being the cycle's extra leap day), and within a century the leap rule
--   reduces to a plain \/4 (the \/100 and \/400 corrections vanish for year-offsets 0..99).  This naturally yields
--   representation (ii): 'century' is always in [0,3] and the extra leap day falls out as day 36524 of the last century.
yearMonthDayToCycleCenturyDays :: Year -> Month Gregorian -> DayOfMonth -> (Int, Int, Int)
yearMonthDayToCycleCenturyDays :: Int -> Month Gregorian -> Int -> (Int, Int, Int)
yearMonthDayToCycleCenturyDays Int
y Month Gregorian
m Int
d = (Int
cyc, Int
century, Int
dic)
  where
    years :: Int
years = if Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Ord a => a -> a -> Bool
< Month Gregorian
March then Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2001 else Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2000
    (Int
cyc, Int
yearInCycle) = Int
years Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
forall a. Num a => a
yearsPerCycle
    (Int
century, Int
yoc) = Int
yearInCycle Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
100
    m' :: Int
m' = if Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Ord a => a -> a -> Bool
> Month Gregorian
February then Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 else Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
    dic :: Int
dic = Int
yoc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
daysPerStandardYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yoc Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int]
forall a. Num a => [a]
commonMonthDayOffsets [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1

-- | Build a 'Date' 'Gregorian' directly from a year\/month\/day via 'yearMonthDayToCycleCenturyDays' (keeping the
--   'GregorianDate' constructor internal to this module).  No validity checking is performed here.
gregorianFromYmd :: Year -> Month Gregorian -> DayOfMonth -> Date Gregorian
gregorianFromYmd :: Int -> Month Gregorian -> Int -> Date Gregorian
gregorianFromYmd Int
y Month Gregorian
m Int
d = Int8 -> Word8 -> Word32 -> Date Gregorian
GregorianDate (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cyc) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
century) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dic)
  where (Int
cyc, Int
century, Int
dic) = Int -> Month Gregorian -> Int -> (Int, Int, Int)
yearMonthDayToCycleCenturyDays Int
y Month Gregorian
m Int
d

-- NOTE: Epoch is March 1 2000 because that has nicest properties that is near our current time.  Because the year is
-- NOTE: shifted to start in March, January and February belong to the /previous/ shifted year (years = y - 2001), so
-- NOTE: the leap-day terms (div 4 \/ 100 \/ 400) naturally count Feb 29 only once it has actually occurred.  Verified
-- NOTE: against proleptic Gregorian arithmetic for every date in years 1-9999 (all century boundaries and negatives).
yearMonthDayToDays :: Year -> Month Gregorian -> DayOfMonth -> Int
yearMonthDayToDays :: Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Int
y Month Gregorian
m Int
d = Int
days
  where
    m' :: Int
m' = if Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Ord a => a -> a -> Bool
> Month Gregorian
February then Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 else Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
    years :: Int
years = if Month Gregorian
m Month Gregorian -> Month Gregorian -> Bool
forall a. Ord a => a -> a -> Bool
< Month Gregorian
March then Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2001 else Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2000
    yearDays :: Int
yearDays = Int
years Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
daysPerStandardYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
years Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
years Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
400 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
years Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100
    days :: Int
days = Int
yearDays Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int]
forall a. Num a => [a]
commonMonthDayOffsets [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Int
m' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
  
-- | Count up centuries, plus remaining days and determine if this is a special extra cycle day.  NOTE: This
--   function would be more accurate if it only took absolute values, but it does end up coming up with the correct answer even on negatives.  It just
--   ends up doing extra calculations with negatives (e.g. year comes back as -100 and entry is +100, which ends up being right but it could have been 0 and the +0 entry)
calculateCenturyDays :: Int32 -> (Int32, Int32, Bool)
calculateCenturyDays :: Int32 -> (Int32, Int32, Bool)
calculateCenturyDays Int32
days = (Int32
y, Int32
centuryDays, Bool
isExtraCycleDay)
  where
    (Int32
cycleYears, (Int32
cycleDays, Bool
isExtraCycleDay)) = (Int32 -> Int32 -> (Int32, Int32))
-> Int32 -> Int32 -> (Int32, Int32)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
divMod Int32
forall a. Num a => a
daysPerCycle (Int32 -> (Int32, Int32))
-> ((Int32, Int32) -> (Int32, (Int32, Bool)))
-> Int32
-> (Int32, (Int32, Bool))
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
400) (Int32 -> Int32)
-> (Int32 -> (Int32, Bool))
-> (Int32, Int32)
-> (Int32, (Int32, Bool))
forall b c b' c'. (b -> c) -> (b' -> c') -> (b, b') -> (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** Int32 -> Int32
forall a. a -> a
id (Int32 -> Int32) -> (Int32 -> Bool) -> Int32 -> (Int32, Bool)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Int32 -> Int32 -> Bool
forall a. (Num a, Eq a) => a -> a -> Bool
borders Int32
forall a. Num a => a
daysPerCycle (Int32 -> (Int32, (Int32, Bool)))
-> Int32 -> (Int32, (Int32, Bool))
forall a b. (a -> b) -> a -> b
$ Int32
days
    (Int32
centuryYears, Int32
centuryDays) = (Int32 -> Int32 -> (Int32, Int32))
-> Int32 -> Int32 -> (Int32, Int32)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
divMod Int32
forall a. Num a => a
daysPerCentury (Int32 -> (Int32, Int32))
-> ((Int32, Int32) -> (Int32, Int32)) -> Int32 -> (Int32, Int32)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int32 -> Int32) -> (Int32, Int32) -> (Int32, Int32)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
* Int32
100) (Int32 -> (Int32, Int32)) -> Int32 -> (Int32, Int32)
forall a b. (a -> b) -> a -> b
$ Int32
cycleDays
    y :: Int32
y = Int32
cycleYears Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
centuryYears

daysToYearMonthDay :: Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay :: Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay Int32
days = (Int32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y', Word8
m'', Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
d')
  where
    (Int32
centuryYears, Int32
centuryDays, Bool
isExtraCycleDay) = Int32 -> (Int32, Int32, Bool)
calculateCenturyDays Int32
days
    decodeEntry :: DTCacheTable -> Int -> (Word16, Word16, Word16)
decodeEntry (DTCacheTable DTCacheDaysTable
xs DTCacheDaysTable
_) = (\Word16
x -> (Word16 -> Word16
decodeYear Word16
x, Word16 -> Word16
decodeMonth Word16
x, Word16 -> Word16
decodeDay Word16
x)) (Word16 -> (Word16, Word16, Word16))
-> (Int -> Word16) -> Int -> (Word16, Word16, Word16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTCacheDaysTable -> Int -> Word16
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
(!) DTCacheDaysTable
xs
    (Word16
y,Word16
m,Word16
d) = DTCacheTable -> Int -> (Word16, Word16, Word16)
decodeEntry DTCacheTable
cacheTable (Int -> (Word16, Word16, Word16))
-> (Int32 -> Int) -> Int32 -> (Word16, Word16, Word16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> (Word16, Word16, Word16))
-> Int32 -> (Word16, Word16, Word16)
forall a b. (a -> b) -> a -> b
$ Int32
centuryDays
    (Word16
m',Word16
d') = if Bool
isExtraCycleDay then (Word16
1,Word16
29) else (Word16
m,Word16
d)
    (Int32
y',Word8
m'') = (Int32
2000 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
centuryYears Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Word16 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y, Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word8) -> Word16 -> Word8
forall a b. (a -> b) -> a -> b
$ Word16
m')

-- here to avoid circular dependancy between Instant and Gregorian
instantToYearMonthDay :: Instant -> (Int32, Word8, Word8)
instantToYearMonthDay :: Instant -> (Int32, Word8, Word8)
instantToYearMonthDay (Instant Int32
days Word32
_ Word32
_) = Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay Int32
days

-- Date Gregorian bridge functions (cycle\/century\/day-in-century representation)

-- | Reconstruct the flat (epoch-relative) day count from a 'Date' 'Gregorian'.  Inverse of 'daysToGregorian'; must
--   agree with 'yearMonthDayToDays' so the cycle representation round-trips against the flat day count.
gregorianToDays :: Date Gregorian -> Int32
gregorianToDays :: Date Gregorian -> Int32
gregorianToDays (GregorianDate Int8
cyc Word8
century Word32
days) = Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int32) -> Int -> Int32
forall a b. (a -> b) -> a -> b
$ Int
cyc' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
daysPerCycle Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
century' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
daysPerCentury Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
days'
  where
    cyc' :: Int
cyc' = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
cyc :: Int
    century' :: Int
century' = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
century :: Int
    days' :: Int
days' = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
days :: Int

-- | Decompose a flat (epoch-relative) day count into the cycle\/century\/day-in-century representation.  Uses floored
--   'divMod' so remainders are non-negative.  Representation (ii): 'century' is always in [0,3]; the single extra leap
--   day per cycle (which floored division would place at century 4, day 0) is folded back to day 36524 of century 3.
daysToGregorian :: Int32 -> Date Gregorian
daysToGregorian :: Int32 -> Date Gregorian
daysToGregorian Int32
days = Int8 -> Word8 -> Word32 -> Date Gregorian
GregorianDate (Int -> Int8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cycles) (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
century) (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dic)
  where
    (Int
cycles, Int
cycleDays) = (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
days :: Int) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
forall a. Num a => a
daysPerCycle
    (Int
century0, Int
dic0) = Int
cycleDays Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
forall a. Num a => a
daysPerCentury
    (Int
century, Int
dic) = if Int
century0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int
4 :: Int) then (Int
3, Int
dic0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forall a. Num a => a
daysPerCentury) else (Int
century0, Int
dic0)

-- | Decode a 'Date' 'Gregorian' directly to (year, zero-based month, day) from its stored fields: the cycle\/century
--   split is already present, so month and day come from a single cache-table lookup on the day-in-century.
gregorianToYearMonthDay :: Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay :: Date Gregorian -> (Int32, Word8, Word8)
gregorianToYearMonthDay (GregorianDate Int8
cyc Word8
century Word32
dic)
  | Word32
dic Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
forall a. Num a => a
daysPerCentury = (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
extraYear, Word8
1, Word8
29)   -- extra-cycle-day: 29 Feb (month 1 = February, 0-based)
  | Bool
otherwise             = (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yr, Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
m, Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
d)
  where
    cycleYear :: Int
cycleYear = Int8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
cyc Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
400 :: Int)
    extraYear :: Int
extraYear = Int
2000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cycleYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
400
    yr :: Int
yr = Int
2000 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cycleYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
century Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
y
    (Word16
y, Word16
m, Word16
d) = DTCacheTable -> Int -> (Word16, Word16, Word16)
decodeEntry DTCacheTable
cacheTable (Int -> (Word16, Word16, Word16))
-> (Word32 -> Int) -> Word32 -> (Word16, Word16, Word16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> (Word16, Word16, Word16))
-> Word32 -> (Word16, Word16, Word16)
forall a b. (a -> b) -> a -> b
$ Word32
dic
    decodeEntry :: DTCacheTable -> Int -> (Word16, Word16, Word16)
decodeEntry (DTCacheTable DTCacheDaysTable
xs DTCacheDaysTable
_) = (\Word16
x -> (Word16 -> Word16
decodeYear Word16
x, Word16 -> Word16
decodeMonth Word16
x, Word16 -> Word16
decodeDay Word16
x)) (Word16 -> (Word16, Word16, Word16))
-> (Int -> Word16) -> Int -> (Word16, Word16, Word16)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DTCacheDaysTable -> Int -> Word16
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
a i e -> i -> e
(!) DTCacheDaysTable
xs

-- | Shift a date by 'delta' days.  Fast path: when the shift stays within the current century (and we are safely
--   past the pre-Gregorian threshold, so cyc >= -1) only the day-in-century changes and the cycle\/century are
--   untouched.  Otherwise fall back to reconstructing the flat day count, applying 'onFlat' (e.g. the validity clamp),
--   and re-decomposing.  The extra-cycle-day (day-in-century == 36524) always fails the in-century bound.
shiftDaysWith :: (Int32 -> Int32) -> Int -> Date Gregorian -> Date Gregorian
shiftDaysWith :: (Int32 -> Int32) -> Int -> Date Gregorian -> Date Gregorian
shiftDaysWith Int32 -> Int32
onFlat Int
delta gd :: Date Gregorian
gd@(GregorianDate Int8
cyc Word8
century Word32
dic)
  | Int8
cyc Int8 -> Int8 -> Bool
forall a. Ord a => a -> a -> Bool
>= -Int8
1 Bool -> Bool -> Bool
&& Int
dic' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0 Bool -> Bool -> Bool
&& Int
dic' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
forall a. Num a => a
daysPerCentury = Int8 -> Word8 -> Word32 -> Date Gregorian
GregorianDate Int8
cyc Word8
century (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
dic')
  | Bool
otherwise                                       = Int32 -> Date Gregorian
daysToGregorian (Int32 -> Date Gregorian)
-> (Int32 -> Int32) -> Int32 -> Date Gregorian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int32
onFlat (Int32 -> Date Gregorian) -> Int32 -> Date Gregorian
forall a b. (a -> b) -> a -> b
$ Date Gregorian -> Int32
gregorianToDays Date Gregorian
gd Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
delta
  where dic' :: Int
dic' = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
dic Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta :: Int

-- | Clamp a flat day count so it never precedes the first valid Gregorian date (15 Oct 1582).
clampToValid :: Int32 -> Int32
clampToValid :: Int32 -> Int32
clampToValid Int32
days = if Int32
days Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
forall a. Integral a => a
invalidDayThresh then Int32
days else Int32
forall a. Integral a => a
invalidDayThresh Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1