{-# 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 calendar is proleptic in that, while it does start in 45 BC it 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.
----------------------------------------------------------------------------
module Data.HodaTime.Calendar.Julian
(
  -- * Constructors
  -- calendarDate
  --,fromNthDay
  --,fromWeekDate
  -- * Types
   Month(..)
  ,DayOfWeek(..)
  ,Julian
  ,yearMonthDayToDays
)
where

import Data.HodaTime.CalendarDateTime.Internal (IsCalendar(..), CalendarDate(..), IsCalendarDateTime(..), DayOfMonth, Year, CalendarDateTime(..), LocalTime(..))
import Data.HodaTime.Instant.Internal (Instant(..))
import Data.HodaTime.Calendar.Internal (mkCommonDayLens, mkCommonMonthLens, mkYearLens, moveByDow, dayOfWeekFromDays, commonMonthDayOffsets, borders, daysPerStandardYear, daysPerFourYears)
import Data.Int (Int32)
import Data.Word (Word8, Word32)
import Control.Arrow ((>>>), (***), (&&&))
import Data.Maybe (fromJust)
import Data.List (findIndex)

-- constants

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

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
1582, b
9, c
15)
 
epochDayOfWeek :: DayOfWeek Julian
epochDayOfWeek :: DayOfWeek Julian
epochDayOfWeek = DayOfWeek Julian
Wednesday

-- In case we ever decide to generate a 28 year table to store cycles
-- daysPerSolarCycle :: Num a => a
-- daysPerSolarCycle = 10227

-- types
    
data Julian
    
instance IsCalendar Julian where
  type Date Julian = CalendarDate Julian
  
  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)
    
  day' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDate Julian -> f (CalendarDate Julian)
day' = Int
-> (Int -> Month Julian -> Int -> Int)
-> (Int32 -> (Word32, Word8, Word8))
-> (Int -> f Int)
-> CalendarDate Julian
-> f (CalendarDate Julian)
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 Julian -> Int -> Int
yearMonthDayToDays Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay
  {-# INLINE day' #-}
    
  month' :: CalendarDate Julian -> Month Julian
month' (CalendarDate Int32
_ Word8
_ Word8
m Word32
_) = 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) -> CalendarDate Julian -> f (CalendarDate Julian)
monthl' = (Int, Int, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate Julian
-> f (CalendarDate Julian)
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)
firstJulDayTuple Month Julian -> Int -> Int
maxDaysInMonth Int -> Month Julian -> Int -> Int
yearMonthDayToDays
  {-# INLINE monthl' #-}
    
  year' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> CalendarDate Julian -> f (CalendarDate Julian)
year' = (Int, Word8, Word8)
-> (Month Julian -> Int -> Int)
-> (Int -> Month Julian -> Int -> Int)
-> (Int -> f Int)
-> CalendarDate Julian
-> f (CalendarDate Julian)
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)
firstJulDayTuple Month Julian -> Int -> Int
maxDaysInMonth Int -> Month Julian -> Int -> Int
yearMonthDayToDays
  {-# INLINE year' #-}
    
  dayOfWeek' :: CalendarDate Julian -> DayOfWeek Julian
dayOfWeek' (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = 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 cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
DayOfWeek cal -> 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 -> CalendarDate Julian -> CalendarDate Julian
next' Int
n DayOfWeek Julian
dow (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = (Int32 -> (Word32, Word8, Word8))
-> DayOfWeek Julian
-> Int
-> DayOfWeek Julian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate Julian
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 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 -> CalendarDate Julian -> CalendarDate Julian
previous' Int
n DayOfWeek Julian
dow (CalendarDate Int32
days Word8
_ Word8
_ Word32
_) = (Int32 -> (Word32, Word8, Word8))
-> DayOfWeek Julian
-> Int
-> DayOfWeek Julian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> CalendarDate Julian
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 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) = CalendarDate Julian -> LocalTime -> CalendarDateTime Julian
forall calendar.
CalendarDate calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime CalendarDate Julian
cd LocalTime
lt
    where
      cd :: CalendarDate Julian
cd = Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate Julian
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 Julian -> 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

-- 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 -> (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, 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
    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
    (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