{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.Calendar.Julian
-- Copyright   :  (C) 2017 Jason Johnson
-- License     :  BSD-style (see the file LICENSE)
-- Maintainer  :  Jason Johnson <jason.johnson.081@gmail.com>
-- Stability   :  experimental
-- Portability :  POSIX, Windows
--
-- This is the module for 'CalendarDate' and 'CalendarDateTime' in the 'Julian' calendar.  The Julian calendar has a simple leap year rule \- every fourth year is a leap year, with none of the century
-- exceptions that 'Data.HodaTime.Calendar.Gregorian' later added to keep the calendar aligned to the solar year.  Years use astronomical numbering, so year 1 is AD 1, year 0 is 1 BC, year -1 is 2 BC
-- and so on; dates run from the calendar's introduction on 1.January.45 BC (year -44) onward, with no upper bound.  Dates share the same absolute timeline as every other calendar, so in the modern era
-- a Julian date reads 13 days behind the same instant's Gregorian date.  The Julian calendar is not merely historical \- the Eastern Orthodox churches still use it liturgically, so it stays useful for
-- both past dates and current and future feast-day calculations.
--
-- == Proleptic every-fourth-year rule
--
-- This implementation applies the clean every-fourth-year rule uniformly from 45 BC onward.  It deliberately does /not/ reproduce the calendar's messy early history, in which the priests who
-- administered it inserted a leap day every three years by mistake (the "triennial error") until Augustus suspended leap years to realign it, the regular rule only settling in by around AD 8.  We omit
-- that for two reasons:
--
-- * The exact sequence of long years during 45 BC \- AD 7 is genuinely disputed: Scaliger, Ideler and Bennett each reconstruct it differently, so an "accurate" version would just bake one contested
--   interpretation in as fact.
--
-- * By long-standing convention historians and astronomers already cite ancient dates in the /proleptic/ Julian calendar (the clean rule), precisely because the real sequence is uncertain.  For example
--   "15.March.44 BC" for Caesar's assassination is a proleptic Julian date; modelling the errors would make this library disagree with the way such dates are normally written.
----------------------------------------------------------------------------
module Data.HodaTime.Calendar.Julian
(
  -- * Constructors
   calendarDate
  ,fromNthDay
  ,fromWeekDate
  -- * Types
  ,Month(..)
  ,DayOfWeek(..)
  ,Julian
)
where

import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), IsCalendarDateTime(..), CalendarDate, DayNth, DayOfMonth, Year, WeekNumber, CalendarDateTime(..), LocalTime(..), Date)
import Control.DeepSeq (NFData(..))
import Data.Hashable (Hashable(..))
import Data.HodaTime.Instant.Internal (Instant(..))
import Data.HodaTime.Calendar.Internal (mkCommonDaySetter, mkCommonMonthSetter, mkYearSetter, mkFromNthDay, mkFromWeekDate, moveByDow, dayOfWeekFromDays, commonMonthDayOffsets, borders, daysPerStandardYear, daysPerFourYears)
import Data.Int (Int32)
import Data.Word (Word8)
import Control.Arrow ((>>>), (***), (&&&))
import Control.Monad (guard)
import Data.Maybe (fromJust)
import Data.List (findIndex)

-- constants

-- | Julian dates are valid from the calendar's introduction, 1.January.45 BC (astronomical year -44), onward; earlier
--   dates are rejected \- the calendar did not exist and this implementation does not extend it backwards.  There is no
--   upper bound beyond the 'Int32' day representation. This tuple is also the floor the shared setter\/constructor
--   helpers clamp to.
firstJulDayTuple :: (Integral a, Integral b, Integral c) => (a, b, c)
firstJulDayTuple :: forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstJulDayTuple = (-a
44, b
0, c
1)        -- NOTE: 1.Jan.45 BC

invalidDayThresh :: Integral a => a
invalidDayThresh :: forall a. Integral a => a
invalidDayThresh = Int -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> a) -> Int -> a
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Enum a => a -> a
pred Int
day0
  where
    (Int
y, Int
m, Int
d) = (Int, Int, Int)
forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstJulDayTuple :: (Year, Int, DayOfMonth)
    day0 :: Int
day0 = Int -> Month Julian -> Int -> Int
yearMonthDayToDays Int
y (Int -> Month Julian
forall a. Enum a => Int -> a
toEnum Int
m) Int
d

epochDayOfWeek :: DayOfWeek Julian
epochDayOfWeek :: DayOfWeek Julian
epochDayOfWeek = DayOfWeek Julian
Tuesday

-- | Julian works in its own frame: internal flat day 0 is 1.Mar.2000 in the Julian calendar.  Only the 'Instant'
--   bridge crosses to the universal timeline (day 0 = 1.Mar.2000 Gregorian), where Julian's epoch sits 13 days later
--   (the Julian\/Gregorian divergence), so 'toUnadjustedInstant' adds this offset and 'fromAdjustedInstant' subtracts
--   it.  Because it is the gap between two fixed absolute days, the offset is constant for all of time.
julianEpochOffset :: Num a => a
julianEpochOffset :: forall a. Num a => a
julianEpochOffset = a
13

-- In case we ever decide to generate a 28 year table to store cycles
-- daysPerSolarCycle :: Num a => a
-- daysPerSolarCycle = 10227     -- NOTE: 28 Julian years = 10227 days = 1461 * 7 weeks exactly (dates and weekdays repeat)

-- types
    
data Julian
    
instance IsCalendar Julian where
  data Date Julian = JulianDate {-# UNPACK #-} !Int32 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Int32
    deriving (Date Julian -> Date Julian -> Bool
(Date Julian -> Date Julian -> Bool)
-> (Date Julian -> Date Julian -> Bool) -> Eq (Date Julian)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date Julian -> Date Julian -> Bool
== :: Date Julian -> Date Julian -> Bool
$c/= :: Date Julian -> Date Julian -> Bool
/= :: Date Julian -> Date Julian -> Bool
Eq, Eq (Date Julian)
Eq (Date Julian) =>
(Date Julian -> Date Julian -> Ordering)
-> (Date Julian -> Date Julian -> Bool)
-> (Date Julian -> Date Julian -> Bool)
-> (Date Julian -> Date Julian -> Bool)
-> (Date Julian -> Date Julian -> Bool)
-> (Date Julian -> Date Julian -> Date Julian)
-> (Date Julian -> Date Julian -> Date Julian)
-> Ord (Date Julian)
Date Julian -> Date Julian -> Bool
Date Julian -> Date Julian -> Ordering
Date Julian -> Date Julian -> Date Julian
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 Julian -> Date Julian -> Ordering
compare :: Date Julian -> Date Julian -> Ordering
$c< :: Date Julian -> Date Julian -> Bool
< :: Date Julian -> Date Julian -> Bool
$c<= :: Date Julian -> Date Julian -> Bool
<= :: Date Julian -> Date Julian -> Bool
$c> :: Date Julian -> Date Julian -> Bool
> :: Date Julian -> Date Julian -> Bool
$c>= :: Date Julian -> Date Julian -> Bool
>= :: Date Julian -> Date Julian -> Bool
$cmax :: Date Julian -> Date Julian -> Date Julian
max :: Date Julian -> Date Julian -> Date Julian
$cmin :: Date Julian -> Date Julian -> Date Julian
min :: Date Julian -> Date Julian -> Date Julian
Ord)

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

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

  fromDays :: Int32 -> Date Julian
fromDays = Int32 -> Date Julian
julianFromDays
  toDays :: Date Julian -> Int32
toDays = Date Julian -> Int32
julianToDays
  toYmd :: Date Julian -> (Int32, Word8, Word8)
toYmd = Date Julian -> (Int32, Word8, Word8)
julianToYmd
  calendarName :: Date Julian -> String
calendarName Date Julian
_ = String
"Julian"

  day' :: Date Julian -> Int
day' (JulianDate Int32
_ Word8
d Word8
_ Int32
_) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
  setDay' :: Int -> Date Julian -> Date Julian
setDay' = Int
-> (Int -> Month Julian -> Int -> Int)
-> (Int32 -> Date Julian)
-> (Date Julian -> (Int32, Word8, Word8))
-> Int
-> Date Julian
-> Date Julian
forall mon d.
Enum mon =>
Int
-> (Int -> mon -> Int -> Int)
-> (Int32 -> d)
-> (d -> (Int32, Word8, Word8))
-> Int
-> d
-> d
mkCommonDaySetter Int
forall a. Integral a => a
invalidDayThresh Int -> Month Julian -> Int -> Int
yearMonthDayToDays Int32 -> Date Julian
julianFromDays Date Julian -> (Int32, Word8, Word8)
julianToYmd
  {-# INLINE day' #-}

  month' :: Date Julian -> Month Julian
month' (JulianDate Int32
_ Word8
_ Word8
m Int32
_) = Int -> Month Julian
forall a. Enum a => Int -> a
toEnum (Int -> Month Julian) -> (Word8 -> Int) -> Word8 -> Month Julian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month Julian) -> Word8 -> Month Julian
forall a b. (a -> b) -> a -> b
$ Word8
m
  setMonthIndex' :: Int -> Date Julian -> Date Julian
setMonthIndex' = Int
-> (Int, Int, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Date Julian -> (Int32, Word8, Word8))
-> (Int32 -> Date Julian)
-> Int
-> Date Julian
-> Date Julian
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)
firstJulDayTuple Month Julian -> Int -> Int
maxDaysInMonth Int -> Month Julian -> Int -> Int
yearMonthDayToDays Date Julian -> (Int32, Word8, Word8)
julianToYmd Int32 -> Date Julian
julianFromDays
  {-# INLINE month' #-}

  year' :: Date Julian -> Int
year' (JulianDate Int32
_ Word8
_ Word8
_ Int32
y) = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y
  setYear' :: Int -> Date Julian -> Date Julian
setYear' = (Int, Word8, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Date Julian -> (Int32, Word8, Word8))
-> (Int32 -> Date Julian)
-> Int
-> Date Julian
-> Date Julian
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)
firstJulDayTuple Month Julian -> Int -> Int
maxDaysInMonth Int -> Month Julian -> Int -> Int
yearMonthDayToDays Date Julian -> (Int32, Word8, Word8)
julianToYmd Int32 -> Date Julian
julianFromDays
  {-# INLINE year' #-}

  dayOfWeek' :: Date Julian -> DayOfWeek Julian
dayOfWeek' (JulianDate Int32
days Word8
_ Word8
_ Int32
_) = Int -> DayOfWeek Julian
forall a. Enum a => Int -> a
toEnum (Int -> DayOfWeek Julian)
-> (Int32 -> Int) -> Int32 -> DayOfWeek Julian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek Julian -> Int -> Int
forall dow. Enum dow => dow -> Int -> Int
dayOfWeekFromDays DayOfWeek Julian
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 Julian) -> Int32 -> DayOfWeek Julian
forall a b. (a -> b) -> a -> b
$ Int32
days

  next' :: Int -> DayOfWeek Julian -> Date Julian -> Date Julian
next' Int
n DayOfWeek Julian
dow (JulianDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Julian)
-> DayOfWeek Julian
-> Int
-> DayOfWeek Julian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Julian
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Julian
julianFromDays DayOfWeek Julian
epochDayOfWeek Int
n DayOfWeek Julian
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 Julian -> Date Julian -> Date Julian
previous' Int
n DayOfWeek Julian
dow (JulianDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Julian)
-> DayOfWeek Julian
-> Int
-> DayOfWeek Julian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Julian
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Julian
julianFromDays DayOfWeek Julian
epochDayOfWeek Int
n DayOfWeek Julian
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 NFData (Date Julian) where
  rnf :: Date Julian -> ()
rnf (JulianDate Int32
days Word8
d Word8
m Int32
y) = Int32 -> ()
forall a. NFData a => a -> ()
rnf Int32
days () -> () -> ()
forall a b. a -> b -> b
`seq` Word8 -> ()
forall a. NFData a => a -> ()
rnf Word8
d () -> () -> ()
forall a b. a -> b -> b
`seq` Word8 -> ()
forall a. NFData a => a -> ()
rnf Word8
m () -> () -> ()
forall a b. a -> b -> b
`seq` Int32 -> ()
forall a. NFData a => a -> ()
rnf Int32
y

instance Hashable (Date Julian) where
  hashWithSalt :: Int -> Date Julian -> Int
hashWithSalt Int
s (JulianDate Int32
days Word8
d Word8
m Int32
y) = Int
s Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int32
days Int -> Word8 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word8
d Int -> Word8 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Word8
m Int -> Int32 -> Int
forall a. Hashable a => Int -> a -> Int
`hashWithSalt` Int32
y

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

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

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

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

instance IsCalendarDateTime Julian where
  fromAdjustedInstant :: Instant -> CalendarDateTime Julian
fromAdjustedInstant (Instant Int32
days Word32
secs Word32
nsecs) = Date Julian -> LocalTime -> CalendarDateTime Julian
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime (Int32 -> Date Julian
julianFromDays (Int32
days Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
forall a. Num a => a
julianEpochOffset)) (Word32 -> Word32 -> LocalTime
LocalTime Word32
secs Word32
nsecs)
  toUnadjustedInstant :: CalendarDateTime Julian -> Instant
toUnadjustedInstant (CalendarDateTime Date Julian
jd (LocalTime Word32
secs Word32
nsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant (Date Julian -> Int32
julianToDays Date Julian
jd Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
forall a. Num a => a
julianEpochOffset) Word32
secs Word32
nsecs

-- | Build the flat Julian date (denormalized: keeps the day count plus the decoded day\/month\/year).
julianFromDays :: Int32 -> Date Julian
julianFromDays :: Int32 -> Date Julian
julianFromDays Int32
days = Int32 -> Word8 -> Word8 -> Int32 -> Date Julian
JulianDate Int32
days Word8
d Word8
m Int32
y
  where (Int32
y, Word8
m, Word8
d) = Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay Int32
days

julianToDays :: Date Julian -> Int32
julianToDays :: Date Julian -> Int32
julianToDays (JulianDate Int32
days Word8
_ Word8
_ Int32
_) = Int32
days

julianToYmd :: Date Julian -> (Int32, Word8, Word8)
julianToYmd :: Date Julian -> (Int32, Word8, Word8)
julianToYmd (JulianDate Int32
_ Word8
d Word8
m Int32
y) = (Int32
y, Word8
m, Word8
d)

-- Constructors

-- | Smart constructor for a 'Julian' calendar date.
calendarDate :: DayOfMonth -> Month Julian -> Year -> Maybe (CalendarDate Julian)
calendarDate :: Int -> Month Julian -> Int -> Maybe (Date Julian)
calendarDate Int
d Month Julian
m Int
y = do
  Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Month Julian -> Int -> Int
maxDaysInMonth Month Julian
m Int
y
  let 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 -> Month Julian -> Int -> Int
yearMonthDayToDays Int
y Month Julian
m Int
d
  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
  Date Julian -> Maybe (Date Julian)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Date Julian -> Maybe (Date Julian))
-> Date Julian -> Maybe (Date Julian)
forall a b. (a -> b) -> a -> b
$ Int32 -> Date Julian
julianFromDays Int32
days

-- | Smart constructor for a 'Julian' calendar date given as a day relative to a month (e.g. the third Monday of the month).  Returns 'Nothing' if the resulting date is invalid.
fromNthDay :: DayNth -> DayOfWeek Julian -> Month Julian -> Year -> Maybe (CalendarDate Julian)
fromNthDay :: DayNth
-> DayOfWeek Julian -> Month Julian -> Int -> Maybe (Date Julian)
fromNthDay = Int
-> DayOfWeek Julian
-> (Int -> Month Julian -> Int -> Int)
-> (Month Julian -> Int -> Int)
-> (Int32 -> Date Julian)
-> DayNth
-> DayOfWeek Julian
-> Month Julian
-> Int
-> Maybe (Date Julian)
forall mon dow d.
(Enum mon, Enum dow) =>
Int
-> dow
-> (Int -> mon -> Int -> Int)
-> (mon -> Int -> Int)
-> (Int32 -> d)
-> DayNth
-> dow
-> mon
-> Int
-> Maybe d
mkFromNthDay Int
forall a. Integral a => a
invalidDayThresh DayOfWeek Julian
epochDayOfWeek Int -> Month Julian -> Int -> Int
yearMonthDayToDays Month Julian -> Int -> Int
maxDaysInMonth Int32 -> Date Julian
julianFromDays

-- | Smart constructor for a 'Julian' calendar date given as a week date.  Note that this method assumes weeks start on Sunday and the first week of the year is the one
--   which has at least one day in the new year.
fromWeekDate :: WeekNumber -> DayOfWeek Julian -> Year -> Maybe (CalendarDate Julian)
fromWeekDate :: Int -> DayOfWeek Julian -> Int -> Maybe (Date Julian)
fromWeekDate = Int
-> DayOfWeek Julian
-> (Int -> Month Julian -> Int -> Int)
-> (Int32 -> Date Julian)
-> Int
-> DayOfWeek Julian
-> Int
-> DayOfWeek Julian
-> Int
-> Maybe (Date Julian)
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 Julian
epochDayOfWeek Int -> Month Julian -> Int -> Int
yearMonthDayToDays Int32 -> Date Julian
julianFromDays Int
1 DayOfWeek Julian
Sunday

-- helper functions

maxDaysInMonth :: Month Julian -> Year -> Int
maxDaysInMonth :: Month Julian -> Int -> Int
maxDaysInMonth Month Julian
R:MonthJulian
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
4
maxDaysInMonth Month Julian
m Int
_
  | Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Julian
April Bool -> Bool -> Bool
|| Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Julian
June Bool -> Bool -> Bool
|| Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Julian
September Bool -> Bool -> Bool
|| Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Eq a => a -> a -> Bool
== Month Julian
November  = Int
30
  | Bool
otherwise                                                   = Int
31

yearMonthDayToDays :: Year -> Month Julian -> DayOfMonth -> Int
yearMonthDayToDays :: Int -> Month Julian -> Int -> Int
yearMonthDayToDays Int
y Month Julian
m Int
d = Int
days
  where
    m' :: Int
m' = if Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Ord a => a -> a -> Bool
> Month Julian
February then Month Julian -> Int
forall a. Enum a => a -> Int
fromEnum Month Julian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2 else Month Julian -> Int
forall a. Enum a => a -> Int
fromEnum Month Julian
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
10
    years :: Int
years = if Month Julian
m Month Julian -> Month Julian -> Bool
forall a. Ord a => a -> a -> Bool
< Month Julian
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
    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

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, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m'', Int32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
d')
  where
    (Int32
fourYears, (Int32
remaining, Bool
isLeapDay)) = (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
daysPerFourYears (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
4) (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
daysPerFourYears (Int32 -> (Int32, (Int32, Bool)))
-> Int32 -> (Int32, (Int32, Bool))
forall a b. (a -> b) -> a -> b
$ Int32
days
    (Int32
oneYears, Int32
yearDays) = Int32
remaining Int32 -> Int32 -> (Int32, Int32)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int32
forall a. Num a => a
daysPerStandardYear
    -- NOTE: the sentinel 'daysPerStandardYear' lets February (yearDays >= the last real offset) be found; without it
    -- 'findIndex' returns Nothing and 'fromJust' crashes for any late-February date.
    m :: Int
m = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> ([Int32] -> Int) -> [Int32] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> ([Int32] -> Maybe Int) -> [Int32] -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int32 -> Bool) -> [Int32] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\Int32
mo -> Int32
yearDays Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
mo) ([Int32] -> Int) -> [Int32] -> Int
forall a b. (a -> b) -> a -> b
$ [Int32]
forall a. Num a => [a]
commonMonthDayOffsets [Int32] -> [Int32] -> [Int32]
forall a. [a] -> [a] -> [a]
++ [Int32
forall a. Num a => a
daysPerStandardYear]
    (Int
m', Int32
startDate) = if Int
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
10 then (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
10, Int32
2001) else (Int
m Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2, Int32
2000)
    d :: Int32
d = Int32
yearDays Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- [Int32]
forall a. Num a => [a]
commonMonthDayOffsets [Int32] -> Int -> Int32
forall a. HasCallStack => [a] -> Int -> a
!! Int
m Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
1
    (Int
m'', Int32
d') = if Bool
isLeapDay then (Int
1, Int32
29) else (Int
m', Int32
d)
    y :: Int32
y = Int32
startDate Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
fourYears Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
+ Int32
oneYears