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

import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), CalendarDate(..), IsCalendarDateTime(..), DayOfMonth, Year, WeekNumber, CalendarDateTime(..), LocalTime(..))
import Data.HodaTime.Calendar.Gregorian.CacheTable (DTCacheTable(..), decodeMonth, decodeYear, decodeDay, cacheTable)
import Data.HodaTime.Calendar.Internal (mkCommonDayLens, mkCommonMonthLens, mkYearLens, moveByDow, dayOfWeekFromDays, commonMonthDayOffsets, borders, daysPerStandardYear, daysPerCentury)
import Data.HodaTime.Instant.Internal (Instant(..))
import Control.Arrow ((>>>), (&&&), (***), first)
import Data.Int (Int32)
import Data.Word (Word8, Word32)
import Data.Array.Unboxed ((!))
import Control.Monad (guard, when)

-- Constants

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

leapDaysPerCentury :: Num a => a
leapDaysPerCentury :: forall a. Num a => a
leapDaysPerCentury = a
24

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
  type Date Gregorian = CalendarDate Gregorian
    
  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)
    
  day' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int)
-> CalendarDate Gregorian -> f (CalendarDate Gregorian)
day' = Int
-> (Int -> Month Gregorian -> Int -> Int)
-> (Int32 -> (Word32, Word8, Word8))
-> (Int -> f Int)
-> CalendarDate Gregorian
-> f (CalendarDate Gregorian)
forall cal (f :: * -> *).
(IsCalendar cal, Functor f, Enum (Month cal)) =>
Int
-> (Int -> Month cal -> Int -> Int)
-> (Int32 -> (Word32, Word8, Word8))
-> (Int -> f Int)
-> CalendarDate cal
-> f (CalendarDate cal)
mkCommonDayLens Int
forall a. Integral a => a
invalidDayThresh Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay
  {-# INLINE day' #-}
    
  month' :: CalendarDate Gregorian -> Month Gregorian
month' (CalendarDate Int32
_ Word8
_ Word8
m Word32
_) = 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
    
  monthl' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int)
-> CalendarDate Gregorian -> f (CalendarDate Gregorian)
monthl' = (Int, Int, Word8)
-> (Month Gregorian -> Int -> Int)
-> (Int -> Month Gregorian -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate Gregorian
-> f (CalendarDate Gregorian)
forall cal (f :: * -> *).
(IsCalendar cal, Functor f, Enum (Month cal)) =>
(Int, Int, Word8)
-> (Month cal -> Int -> Int)
-> (Int -> Month cal -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate cal
-> f (CalendarDate cal)
mkCommonMonthLens (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
  {-# INLINE monthl' #-}
    
  year' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int)
-> CalendarDate Gregorian -> f (CalendarDate Gregorian)
year' = (Int, Word8, Word8)
-> (Month Gregorian -> Int -> Int)
-> (Int -> Month Gregorian -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate Gregorian
-> f (CalendarDate Gregorian)
forall cal (f :: * -> *).
(IsCalendar cal, Functor f, Enum (Month cal)) =>
(Int, Word8, Word8)
-> (Month cal -> Int -> Int)
-> (Int -> Month cal -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate cal
-> f (CalendarDate cal)
mkYearLens (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
  {-# INLINE year' #-}
    
  dayOfWeek' :: CalendarDate Gregorian -> DayOfWeek Gregorian
dayOfWeek' (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = Int -> DayOfWeek Gregorian
forall a. Enum a => Int -> a
toEnum (Int -> DayOfWeek Gregorian)
-> (Int32 -> Int) -> Int32 -> DayOfWeek Gregorian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek Gregorian -> Int -> Int
forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
DayOfWeek cal -> Int -> Int
dayOfWeekFromDays DayOfWeek Gregorian
epochDayOfWeek (Int -> Int) -> (Int32 -> Int) -> Int32 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int32 -> DayOfWeek Gregorian) -> Int32 -> DayOfWeek Gregorian
forall a b. (a -> b) -> a -> b
$ Int32
days
    
  next' :: Int
-> DayOfWeek Gregorian
-> CalendarDate Gregorian
-> CalendarDate Gregorian
next' Int
n DayOfWeek Gregorian
dow (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = (Int32 -> (Word32, Word8, Word8))
-> DayOfWeek Gregorian
-> Int
-> DayOfWeek Gregorian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate Gregorian
forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
(Int32 -> (Word32, Word8, Word8))
-> DayOfWeek cal
-> Int
-> DayOfWeek cal
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate cal
moveByDow Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay DayOfWeek Gregorian
epochDayOfWeek Int
n DayOfWeek Gregorian
dow (-) Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(>) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
days)
    
  previous' :: Int
-> DayOfWeek Gregorian
-> CalendarDate Gregorian
-> CalendarDate Gregorian
previous' Int
n DayOfWeek Gregorian
dow (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = (Int32 -> (Word32, Word8, Word8))
-> DayOfWeek Gregorian
-> Int
-> DayOfWeek Gregorian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate Gregorian
forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
(Int32 -> (Word32, Word8, Word8))
-> DayOfWeek cal
-> Int
-> DayOfWeek cal
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate cal
moveByDow Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay DayOfWeek Gregorian
epochDayOfWeek Int
n DayOfWeek Gregorian
dow Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract (-) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
(<) (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
days)  -- NOTE: subtract is (-) with the arguments flipped

instance IsCalendarDateTime Gregorian where
  fromAdjustedInstant :: Instant -> CalendarDateTime Gregorian
fromAdjustedInstant (Instant Int32
days Word32
secs Word32
nsecs) = CalendarDate Gregorian -> LocalTime -> CalendarDateTime Gregorian
forall calendar.
CalendarDate calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime CalendarDate Gregorian
cd LocalTime
lt
    where
      cd :: CalendarDate Gregorian
cd = Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate Gregorian
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate Int32
days Word8
d Word8
m Word32
y
      (Word32
y, Word8
m, Word8
d) = Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay Int32
days
      lt :: LocalTime
lt = Word32 -> Word32 -> LocalTime
LocalTime Word32
secs Word32
nsecs

  toUnadjustedInstant :: CalendarDateTime Gregorian -> Instant
toUnadjustedInstant (CalendarDateTime (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) (LocalTime Word32
secs Word32
nsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant Int32
days 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
minWeekDays DayOfWeek Gregorian
wkStartDoW Int
weekNum DayOfWeek Gregorian
dow Int
y = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int32
days Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
> Int32
forall a. Integral a => a
invalidDayThresh
  CalendarDate Gregorian -> Maybe (CalendarDate Gregorian)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (CalendarDate Gregorian -> Maybe (CalendarDate Gregorian))
-> CalendarDate Gregorian -> Maybe (CalendarDate Gregorian)
forall a b. (a -> b) -> a -> b
$ Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate Gregorian
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate Int32
days Word8
d Word8
m Word32
y'
    where
      soyDays :: Int
soyDays = Int -> Month Gregorian -> Int -> Int
yearMonthDayToDays Int
y Month Gregorian
January Int
minWeekDays
      soyDoW :: Int
soyDoW = DayOfWeek Gregorian -> Int -> Int
forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
DayOfWeek cal -> Int -> Int
dayOfWeekFromDays DayOfWeek Gregorian
epochDayOfWeek Int
soyDays
      startDoWDistance :: Int
startDoWDistance = Int -> Int
forall a. Enum a => a -> Int
fromEnum Int
soyDoW Int -> Int -> Int
forall a. Num a => a -> a -> a
- DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek Gregorian
wkStartDoW
      dowDistance :: Int
dowDistance = DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek Gregorian
dow Int -> Int -> Int
forall a. Num a => a -> a -> a
- DayOfWeek Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek Gregorian
wkStartDoW
      dowDistance' :: Int
dowDistance' = if Int
dowDistance Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
dowDistance Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 else Int
dowDistance
      startDays :: Int
startDays = Int
soyDays Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
startDoWDistance
      weekNum' :: Int
weekNum' = Int -> Int
forall a. Enum a => a -> a
pred Int
weekNum
      days :: Int32
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
startDays Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
weekNum' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
dowDistance'
      (Word32
y', Word8
m, Word8
d) = Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay Int32
days

-- 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
dom Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
d' 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
    dom :: Int
dom = if Int
nth Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
mdm else Int
1
    m :: Int
m = Month Gregorian -> Int
forall a. Enum a => a -> Int
fromEnum Month Gregorian
month
    dow :: Int
dow = (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
    d :: Int
d = Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
dow
    d' :: Int
d' = if Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
7 else Int
d
    (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

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
cycles, Int
centuries, Int
days)
  where
    y' :: Int
y' = 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
cycles, Int
years) = Int
y' Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
forall a. Num a => a
yearsPerCycle
    (Int
centuries, Int
years') = Int
years Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
100
    leapDays :: Int
leapDays = Int
forall a. Num a => a
leapDaysPerCentury Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
centuries Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
years' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) 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. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
centuries Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
years' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
forall a. Num a => a
yearsPerCycle
    yearDays :: Int
yearDays = Int
years' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
forall a. Num a => a
daysPerStandardYear
    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
    days :: Int
days = Int
yearDays Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
leapDays 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

-- NOTE: Epoch is March 1 2000 because that has nicest properties that is near our current time.
-- TODO: The addition of leap days below will add from the previous year.  We need to determine if this is a bug
-- TODO: and if it is not, why isn't it
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 -> (Word32, Word8, Word8)
daysToYearMonthDay :: Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay Int32
days = (Int32 -> Word32
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 -> (Word32, Word8, Word8)
instantToYearMonthDay :: Instant -> (Word32, Word8, Word8)
instantToYearMonthDay (Instant Int32
days Word32
_ Word32
_) = Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay Int32
days