{-# LANGUAGE TypeFamilies #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.Calendar.Coptic
-- 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 'Coptic' calendar, the liturgical calendar of the Coptic Orthodox Church whose era of the Martyrs (Anno Martyrum) counts years
-- from AD 284.  The year is twelve months of 30 days followed by a short thirteenth month ('PiKogiEnavot', the epagomenal days) of five days, or six in a leap year.  Leap years follow the same simple
-- every-fourth-year rule as 'Data.HodaTime.Calendar.Julian' (a Coptic year is leap when @year \`mod\` 4 == 3@), with the extra day added at the end of the year.  Year 1 begins on 29.Aug.284 in the
-- Julian calendar; dates share the same absolute timeline as every other calendar.
----------------------------------------------------------------------------
module Data.HodaTime.Calendar.Coptic
(
  -- * Constructors
   calendarDate
  ,fromNthDay
  ,fromWeekDate
  -- * Types
  ,Month(..)
  ,DayOfWeek(..)
  ,Coptic
)
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, daysPerStandardYear, daysPerFourYears)
import Data.Int (Int32)
import Data.Word (Word8)
import Control.Monad (guard)

-- constants

monthsPerYear :: Int
monthsPerYear :: Int
monthsPerYear = Int
13

daysPerMonth :: Int
daysPerMonth :: Int
daysPerMonth = Int
30

-- | The day-of-year (0-based) at which the thirteenth month (the epagomenal days) begins.
daysBeforeEpagomenae :: Int
daysBeforeEpagomenae :: Int
daysBeforeEpagomenae = Int
12 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
daysPerMonth      -- 360

-- | Flat day (shared absolute epoch, day 0 = 1.Mar.2000 Gregorian) of Coptic 1.Thout.1, i.e. 29.Aug.284 Julian.
copticEpoch :: Num a => a
copticEpoch :: forall a. Num a => a
copticEpoch = -a
626575

firstCopDayTuple :: (Integral a, Integral b, Integral c) => (a, b, c)
firstCopDayTuple :: forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstCopDayTuple = (a
1, b
0, c
1)        -- NOTE: 1.Thout.AM 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)
firstCopDayTuple :: (Year, Int, DayOfMonth)
    day0 :: Int
day0 = Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Int
y (Int -> Month Coptic
forall a. Enum a => Int -> a
toEnum Int
m) Int
d

epochDayOfWeek :: DayOfWeek Coptic
epochDayOfWeek :: DayOfWeek Coptic
epochDayOfWeek = DayOfWeek Coptic
Wednesday

-- types

data Coptic

instance IsCalendar Coptic where
  data Date Coptic = CopticDate {-# UNPACK #-} !Int32 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Int32
    deriving (Date Coptic -> Date Coptic -> Bool
(Date Coptic -> Date Coptic -> Bool)
-> (Date Coptic -> Date Coptic -> Bool) -> Eq (Date Coptic)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Date Coptic -> Date Coptic -> Bool
== :: Date Coptic -> Date Coptic -> Bool
$c/= :: Date Coptic -> Date Coptic -> Bool
/= :: Date Coptic -> Date Coptic -> Bool
Eq, Int -> Date Coptic -> ShowS
[Date Coptic] -> ShowS
Date Coptic -> String
(Int -> Date Coptic -> ShowS)
-> (Date Coptic -> String)
-> ([Date Coptic] -> ShowS)
-> Show (Date Coptic)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Date Coptic -> ShowS
showsPrec :: Int -> Date Coptic -> ShowS
$cshow :: Date Coptic -> String
show :: Date Coptic -> String
$cshowList :: [Date Coptic] -> ShowS
showList :: [Date Coptic] -> ShowS
Show, Eq (Date Coptic)
Eq (Date Coptic) =>
(Date Coptic -> Date Coptic -> Ordering)
-> (Date Coptic -> Date Coptic -> Bool)
-> (Date Coptic -> Date Coptic -> Bool)
-> (Date Coptic -> Date Coptic -> Bool)
-> (Date Coptic -> Date Coptic -> Bool)
-> (Date Coptic -> Date Coptic -> Date Coptic)
-> (Date Coptic -> Date Coptic -> Date Coptic)
-> Ord (Date Coptic)
Date Coptic -> Date Coptic -> Bool
Date Coptic -> Date Coptic -> Ordering
Date Coptic -> Date Coptic -> Date Coptic
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 Coptic -> Date Coptic -> Ordering
compare :: Date Coptic -> Date Coptic -> Ordering
$c< :: Date Coptic -> Date Coptic -> Bool
< :: Date Coptic -> Date Coptic -> Bool
$c<= :: Date Coptic -> Date Coptic -> Bool
<= :: Date Coptic -> Date Coptic -> Bool
$c> :: Date Coptic -> Date Coptic -> Bool
> :: Date Coptic -> Date Coptic -> Bool
$c>= :: Date Coptic -> Date Coptic -> Bool
>= :: Date Coptic -> Date Coptic -> Bool
$cmax :: Date Coptic -> Date Coptic -> Date Coptic
max :: Date Coptic -> Date Coptic -> Date Coptic
$cmin :: Date Coptic -> Date Coptic -> Date Coptic
min :: Date Coptic -> Date Coptic -> Date Coptic
Ord)

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

  data Month Coptic = Thout | Paopi | Hathor | Koiak | Tobi | Meshir | Paremhat | Paremoude | Pashons | Paoni | Epip | Mesori | PiKogiEnavot
    deriving (Int -> Month Coptic -> ShowS
[Month Coptic] -> ShowS
Month Coptic -> String
(Int -> Month Coptic -> ShowS)
-> (Month Coptic -> String)
-> ([Month Coptic] -> ShowS)
-> Show (Month Coptic)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Month Coptic -> ShowS
showsPrec :: Int -> Month Coptic -> ShowS
$cshow :: Month Coptic -> String
show :: Month Coptic -> String
$cshowList :: [Month Coptic] -> ShowS
showList :: [Month Coptic] -> ShowS
Show, ReadPrec [Month Coptic]
ReadPrec (Month Coptic)
Int -> ReadS (Month Coptic)
ReadS [Month Coptic]
(Int -> ReadS (Month Coptic))
-> ReadS [Month Coptic]
-> ReadPrec (Month Coptic)
-> ReadPrec [Month Coptic]
-> Read (Month Coptic)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS (Month Coptic)
readsPrec :: Int -> ReadS (Month Coptic)
$creadList :: ReadS [Month Coptic]
readList :: ReadS [Month Coptic]
$creadPrec :: ReadPrec (Month Coptic)
readPrec :: ReadPrec (Month Coptic)
$creadListPrec :: ReadPrec [Month Coptic]
readListPrec :: ReadPrec [Month Coptic]
Read, Month Coptic -> Month Coptic -> Bool
(Month Coptic -> Month Coptic -> Bool)
-> (Month Coptic -> Month Coptic -> Bool) -> Eq (Month Coptic)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Month Coptic -> Month Coptic -> Bool
== :: Month Coptic -> Month Coptic -> Bool
$c/= :: Month Coptic -> Month Coptic -> Bool
/= :: Month Coptic -> Month Coptic -> Bool
Eq, Eq (Month Coptic)
Eq (Month Coptic) =>
(Month Coptic -> Month Coptic -> Ordering)
-> (Month Coptic -> Month Coptic -> Bool)
-> (Month Coptic -> Month Coptic -> Bool)
-> (Month Coptic -> Month Coptic -> Bool)
-> (Month Coptic -> Month Coptic -> Bool)
-> (Month Coptic -> Month Coptic -> Month Coptic)
-> (Month Coptic -> Month Coptic -> Month Coptic)
-> Ord (Month Coptic)
Month Coptic -> Month Coptic -> Bool
Month Coptic -> Month Coptic -> Ordering
Month Coptic -> Month Coptic -> Month Coptic
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 Coptic -> Month Coptic -> Ordering
compare :: Month Coptic -> Month Coptic -> Ordering
$c< :: Month Coptic -> Month Coptic -> Bool
< :: Month Coptic -> Month Coptic -> Bool
$c<= :: Month Coptic -> Month Coptic -> Bool
<= :: Month Coptic -> Month Coptic -> Bool
$c> :: Month Coptic -> Month Coptic -> Bool
> :: Month Coptic -> Month Coptic -> Bool
$c>= :: Month Coptic -> Month Coptic -> Bool
>= :: Month Coptic -> Month Coptic -> Bool
$cmax :: Month Coptic -> Month Coptic -> Month Coptic
max :: Month Coptic -> Month Coptic -> Month Coptic
$cmin :: Month Coptic -> Month Coptic -> Month Coptic
min :: Month Coptic -> Month Coptic -> Month Coptic
Ord, Int -> Month Coptic
Month Coptic -> Int
Month Coptic -> [Month Coptic]
Month Coptic -> Month Coptic
Month Coptic -> Month Coptic -> [Month Coptic]
Month Coptic -> Month Coptic -> Month Coptic -> [Month Coptic]
(Month Coptic -> Month Coptic)
-> (Month Coptic -> Month Coptic)
-> (Int -> Month Coptic)
-> (Month Coptic -> Int)
-> (Month Coptic -> [Month Coptic])
-> (Month Coptic -> Month Coptic -> [Month Coptic])
-> (Month Coptic -> Month Coptic -> [Month Coptic])
-> (Month Coptic -> Month Coptic -> Month Coptic -> [Month Coptic])
-> Enum (Month Coptic)
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 Coptic -> Month Coptic
succ :: Month Coptic -> Month Coptic
$cpred :: Month Coptic -> Month Coptic
pred :: Month Coptic -> Month Coptic
$ctoEnum :: Int -> Month Coptic
toEnum :: Int -> Month Coptic
$cfromEnum :: Month Coptic -> Int
fromEnum :: Month Coptic -> Int
$cenumFrom :: Month Coptic -> [Month Coptic]
enumFrom :: Month Coptic -> [Month Coptic]
$cenumFromThen :: Month Coptic -> Month Coptic -> [Month Coptic]
enumFromThen :: Month Coptic -> Month Coptic -> [Month Coptic]
$cenumFromTo :: Month Coptic -> Month Coptic -> [Month Coptic]
enumFromTo :: Month Coptic -> Month Coptic -> [Month Coptic]
$cenumFromThenTo :: Month Coptic -> Month Coptic -> Month Coptic -> [Month Coptic]
enumFromThenTo :: Month Coptic -> Month Coptic -> Month Coptic -> [Month Coptic]
Enum, Month Coptic
Month Coptic -> Month Coptic -> Bounded (Month Coptic)
forall a. a -> a -> Bounded a
$cminBound :: Month Coptic
minBound :: Month Coptic
$cmaxBound :: Month Coptic
maxBound :: Month Coptic
Bounded)

  fromDays :: Int32 -> Date Coptic
fromDays = Int32 -> Date Coptic
copticFromDays
  toDays :: Date Coptic -> Int32
toDays = Date Coptic -> Int32
copticToDays
  toYmd :: Date Coptic -> (Int32, Word8, Word8)
toYmd = Date Coptic -> (Int32, Word8, Word8)
copticToYmd

  day' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Coptic -> f (Date Coptic)
day' = Int
-> (Int -> Month Coptic -> Int -> Int)
-> (Int32 -> Date Coptic)
-> (Date Coptic -> (Int32, Word8, Word8))
-> (Int -> f Int)
-> Date Coptic
-> f (Date Coptic)
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 Coptic -> Int -> Int
yearMonthDayToDays Int32 -> Date Coptic
copticFromDays Date Coptic -> (Int32, Word8, Word8)
copticToYmd
  {-# INLINE day' #-}

  month' :: Date Coptic -> Month Coptic
month' (CopticDate Int32
_ Word8
_ Word8
m Int32
_) = Int -> Month Coptic
forall a. Enum a => Int -> a
toEnum (Int -> Month Coptic) -> (Word8 -> Int) -> Word8 -> Month Coptic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month Coptic) -> Word8 -> Month Coptic
forall a b. (a -> b) -> a -> b
$ Word8
m

  monthl' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Coptic -> f (Date Coptic)
monthl' = Int
-> (Int, Int, Word8)
-> (Month Coptic -> Int -> Int)
-> (Int -> Month Coptic -> Int -> Int)
-> (Date Coptic -> (Int32, Word8, Word8))
-> (Int32 -> Date Coptic)
-> (Int -> f Int)
-> Date Coptic
-> f (Date Coptic)
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
monthsPerYear (Int, Int, Word8)
forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstCopDayTuple Month Coptic -> Int -> Int
maxDaysInMonth Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Date Coptic -> (Int32, Word8, Word8)
copticToYmd Int32 -> Date Coptic
copticFromDays
  {-# INLINE monthl' #-}

  year' :: forall (f :: * -> *).
Functor f =>
(Int -> f Int) -> Date Coptic -> f (Date Coptic)
year' = (Int, Word8, Word8)
-> (Month Coptic -> Int -> Int)
-> (Int -> Month Coptic -> Int -> Int)
-> (Date Coptic -> (Int32, Word8, Word8))
-> (Int32 -> Date Coptic)
-> (Int -> f Int)
-> Date Coptic
-> f (Date Coptic)
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)
firstCopDayTuple Month Coptic -> Int -> Int
maxDaysInMonth Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Date Coptic -> (Int32, Word8, Word8)
copticToYmd Int32 -> Date Coptic
copticFromDays
  {-# INLINE year' #-}

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

  next' :: Int -> DayOfWeek Coptic -> Date Coptic -> Date Coptic
next' Int
n DayOfWeek Coptic
dow (CopticDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Coptic)
-> DayOfWeek Coptic
-> Int
-> DayOfWeek Coptic
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Coptic
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Coptic
copticFromDays DayOfWeek Coptic
epochDayOfWeek Int
n DayOfWeek Coptic
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 Coptic -> Date Coptic -> Date Coptic
previous' Int
n DayOfWeek Coptic
dow (CopticDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Coptic)
-> DayOfWeek Coptic
-> Int
-> DayOfWeek Coptic
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Coptic
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Coptic
copticFromDays DayOfWeek Coptic
epochDayOfWeek Int
n DayOfWeek Coptic
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 Coptic where
  fromAdjustedInstant :: Instant -> CalendarDateTime Coptic
fromAdjustedInstant (Instant Int32
days Word32
secs Word32
nsecs) = Date Coptic -> LocalTime -> CalendarDateTime Coptic
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime (Int32 -> Date Coptic
copticFromDays Int32
days) (Word32 -> Word32 -> LocalTime
LocalTime Word32
secs Word32
nsecs)
  toUnadjustedInstant :: CalendarDateTime Coptic -> Instant
toUnadjustedInstant (CalendarDateTime Date Coptic
cd (LocalTime Word32
secs Word32
nsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant (Date Coptic -> Int32
copticToDays Date Coptic
cd) Word32
secs Word32
nsecs

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

copticToDays :: Date Coptic -> Int32
copticToDays :: Date Coptic -> Int32
copticToDays (CopticDate Int32
days Word8
_ Word8
_ Int32
_) = Int32
days

copticToYmd :: Date Coptic -> (Int32, Word8, Word8)
copticToYmd :: Date Coptic -> (Int32, Word8, Word8)
copticToYmd (CopticDate Int32
_ Word8
d Word8
m Int32
y) = (Int32
y, Word8
m, Word8
d)

-- Constructors

-- | Smart constructor for a 'Coptic' calendar date.
calendarDate :: DayOfMonth -> Month Coptic -> Year -> Maybe (CalendarDate Coptic)
calendarDate :: Int -> Month Coptic -> Int -> Maybe (Date Coptic)
calendarDate Int
d Month Coptic
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 Coptic -> Int -> Int
maxDaysInMonth Month Coptic
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 Coptic -> Int -> Int
yearMonthDayToDays Int
y Month Coptic
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 Coptic -> Maybe (Date Coptic)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Date Coptic -> Maybe (Date Coptic))
-> Date Coptic -> Maybe (Date Coptic)
forall a b. (a -> b) -> a -> b
$ Int32 -> Date Coptic
copticFromDays Int32
days

-- | Smart constructor for a 'Coptic' 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 Coptic -> Month Coptic -> Year -> Maybe (CalendarDate Coptic)
fromNthDay :: DayNth
-> DayOfWeek Coptic -> Month Coptic -> Int -> Maybe (Date Coptic)
fromNthDay = Int
-> DayOfWeek Coptic
-> (Int -> Month Coptic -> Int -> Int)
-> (Month Coptic -> Int -> Int)
-> (Int32 -> Date Coptic)
-> DayNth
-> DayOfWeek Coptic
-> Month Coptic
-> Int
-> Maybe (Date Coptic)
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 Coptic
epochDayOfWeek Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Month Coptic -> Int -> Int
maxDaysInMonth Int32 -> Date Coptic
copticFromDays

-- | Smart constructor for a 'Coptic' 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 Coptic -> Year -> Maybe (CalendarDate Coptic)
fromWeekDate :: Int -> DayOfWeek Coptic -> Int -> Maybe (Date Coptic)
fromWeekDate = Int
-> DayOfWeek Coptic
-> (Int -> Month Coptic -> Int -> Int)
-> (Int32 -> Date Coptic)
-> Int
-> DayOfWeek Coptic
-> Int
-> DayOfWeek Coptic
-> Int
-> Maybe (Date Coptic)
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 Coptic
epochDayOfWeek Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Int32 -> Date Coptic
copticFromDays Int
1 DayOfWeek Coptic
Sunday

-- helper functions

maxDaysInMonth :: Month Coptic -> Year -> Int
maxDaysInMonth :: Month Coptic -> Int -> Int
maxDaysInMonth Month Coptic
R:MonthCoptic
PiKogiEnavot Int
y
  | Bool
isLeap                                 = Int
6
  | Bool
otherwise                              = Int
5
  where
    isLeap :: Bool
isLeap                                 = Int
3 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 Coptic
_ Int
_                         = Int
daysPerMonth

yearMonthDayToDays :: Year -> Month Coptic -> DayOfMonth -> Int
yearMonthDayToDays :: Int -> Month Coptic -> Int -> Int
yearMonthDayToDays Int
y Month Coptic
m Int
d = Int
forall a. Num a => a
copticEpoch Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
y 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
daysPerStandardYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
y Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Month Coptic -> Int
forall a. Enum a => a -> Int
fromEnum Month Coptic
m Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
daysPerMonth 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
flatDays = (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m, Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
d)
  where
    n :: Int
n = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
flatDays Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
forall a. Num a => a
copticEpoch                          -- days since 1.Thout.1 (>= 0 for valid dates)
    (Int
fourYears, Int
remaining) = Int
n Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
forall a. Num a => a
daysPerFourYears             -- 1461-day cycle, leap year last in each block
    (Int
yearInBlock, Int
dayOfYear)
      | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
365       = (Int
0, Int
remaining)
      | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
730       = (Int
1, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
365)
      | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1096      = (Int
2, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
730)                 -- the leap year (366 days)
      | Bool
otherwise             = (Int
3, Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1096)
    y :: Int
y = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
fourYears Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
yearInBlock
    (Int
m, Int
d)
      | Int
dayOfYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
daysBeforeEpagomenae  = (Int
12, Int
dayOfYear Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
daysBeforeEpagomenae Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise                          = let (Int
mm, Int
dd) = Int
dayOfYear Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
daysPerMonth in (Int
mm, Int
dd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)