{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- 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.  It is proleptic in that, while it only started in 45 BC, this
-- implementation applies that rule uniformly and does not try to account for the fact that before around 4 AD the leap year rule was accidentally implemented as a leap year every three years.  This
-- implementation stores the year unsigned, so its supported range is AD 1 onward (BC years are not representable).  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.
----------------------------------------------------------------------------
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 Data.HodaTime.Instant.Internal (Instant(..))
import Data.HodaTime.Calendar.Internal (mkCommonDayLens, mkCommonMonthLens, mkYearLens, 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

-- | The Julian calendar predates the Gregorian one, so \- unlike 'Data.HodaTime.Calendar.Gregorian', which is only
--   valid from 15.Oct.1582 \- there is no reason to reject earlier dates here: rejecting pre\-1582 dates is exactly
--   what the Julian calendar exists to represent.  We floor at 1.Jan.AD 1 because the decoded year is stored unsigned
--   ('toYmd' returns a 'Word32' year), so BC years are not representable in this implementation.
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
1, b
0, c
1)        -- NOTE: 1.Jan.AD 1

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
Wednesday

-- | The Julian and (proleptic) Gregorian calendars diverge, so they cannot share a flat day 0 that is a clean date in
--   both.  'Data.HodaTime.Calendar.Gregorian' owns the shared absolute epoch (flat day 0 = 1.Mar.2000 Gregorian), which
--   the Julian calendar labels 17.Feb.2000.  Julian's own clean epoch (1.Mar.2000 Julian) sits 13 days later on that
--   shared timeline, so we shift the internal Julian day count by this constant to place it on the same absolute
--   timeline as every other calendar.  Because it is the gap between two fixed absolute days, the shift is constant for
--   all of time.
julianEpochShift :: Num a => a
julianEpochShift :: forall a. Num a => a
julianEpochShift = 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, Int -> Date Julian -> ShowS
[Date Julian] -> ShowS
Date Julian -> String
(Int -> Date Julian -> ShowS)
-> (Date Julian -> String)
-> ([Date Julian] -> ShowS)
-> Show (Date Julian)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date Julian -> ShowS
showsPrec :: Int -> Date Julian -> ShowS
$cshow :: Date Julian -> String
show :: Date Julian -> String
$cshowList :: [Date Julian] -> ShowS
showList :: [Date Julian] -> ShowS
Show, 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

  day' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Julian -> f (Date Julian)
day' = Int
-> (Int -> Month Julian -> Int -> Int)
-> (Int32 -> Date Julian)
-> (Date Julian -> (Int32, Word8, Word8))
-> (Int -> f Int)
-> Date Julian
-> f (Date Julian)
forall (f :: * -> *) mon d.
(Functor f, Enum mon) =>
Int
-> (Int -> mon -> Int -> Int)
-> (Int32 -> d)
-> (d -> (Int32, Word8, Word8))
-> (Int -> f Int)
-> d
-> f d
mkCommonDayLens 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

  monthl' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Julian -> f (Date Julian)
monthl' = Int
-> (Int, Int, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Date Julian -> (Int32, Word8, Word8))
-> (Int32 -> Date Julian)
-> (Int -> f Int)
-> Date Julian
-> f (Date Julian)
forall (f :: * -> *) mon d.
(Functor f, Enum mon) =>
Int
-> (Int, Int, Word8)
-> (mon -> Int -> Int)
-> (Int -> mon -> Int -> Int)
-> (d -> (Int32, Word8, Word8))
-> (Int32 -> d)
-> (Int -> f Int)
-> d
-> f d
mkCommonMonthLens 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 monthl' #-}

  year' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Julian -> f (Date Julian)
year' = (Int, Word8, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Date Julian -> (Int32, Word8, Word8))
-> (Int32 -> Date Julian)
-> (Int -> f Int)
-> Date Julian
-> f (Date Julian)
forall (f :: * -> *) mon d.
(Functor f, Enum mon) =>
(Int, Word8, Word8)
-> (mon -> Int -> Int)
-> (Int -> mon -> Int -> Int)
-> (d -> (Int32, Word8, Word8))
-> (Int32 -> d)
-> (Int -> f Int)
-> d
-> f d
mkYearLens (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 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) (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) 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 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
forall a. Num a => a
julianEpochShift

daysToYearMonthDay :: Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay :: Int32 -> (Int32, Word8, Word8)
daysToYearMonthDay Int32
days0 = (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
    days :: Int32
days = Int32
days0 Int32 -> Int32 -> Int32
forall a. Num a => a -> a -> a
- Int32
forall a. Num a => a
julianEpochShift
    (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