{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.HodaTime.Calendar.Persian
-- 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 'Persian' (Solar Hijri) calendar, the official calendar of Iran and Afghanistan.  It is a solar calendar whose year begins at the
-- vernal equinox (Nowruz, around 20\/21 March): the first six months ('Farvardin' through 'Shahrivar') have 31 days, the next five ('Mehr' through 'Bahman') have 30, and the final month ('Esfand') has
-- 29, or 30 in a leap year.  Year 1 begins on 22.Mar.622 CE (proleptic Gregorian), the year of the Hijra; dates share the same absolute timeline as every other calendar.
--
-- == Leap years: the astronomical calendar
--
-- This is the /astronomical/ Solar Hijri calendar — the official civil calendar of Iran (equivalent to the .NET @PersianCalendar@ from 4.6 onwards and NodaTime's @PersianAstronomical@).  Rather than an
-- arithmetic cycle, a year is a leap year exactly when the astronomical rule places the following Nowruz 366 days later.  Nowruz is the day on which the March equinox occurs if the equinox is before true
-- noon at the reference meridian (52.5°E, Iran Standard Time), otherwise the next day.  The equinox and leap years are computed in "Data.HodaTime.Calendar.Persian.Astronomical"; the table is built lazily,
-- so programs that don't use the Persian calendar pay nothing for it.
--
-- == Supported range and why it is capped at 1500
--
-- The calendar is vouched for over Persian years 1 .. 1500 (≈ 622 .. 2121 CE); 'calendarDate' rejects years outside that range.  This is a deliberately narrower window than NodaTime's
-- @PersianAstronomical@, which spans years 1 .. 9377 (≈ 622 .. 9999 CE).  The difference is not an oversight but a consequence of /how/ each library determines Nowruz:
--
-- * NodaTime embeds a fixed lookup table of leap-year bits that was generated once from the .NET 4.6 BCL @PersianCalendar@.  Every year up to 9377 therefore has a /frozen, deterministic/ answer,
--   even far-future years for which the "astronomical" leap flag is really just whatever value the BCL happened to precompute.
--
-- * We instead compute each Nowruz on demand from first principles: the March equinox (Meeus, /Astronomical Algorithms/ ch. 27\/28), the equation of time (to reduce mean noon to apparent noon at
--   the Iranian reference meridian), and ΔT — the difference between Terrestrial Time and Universal Time caused by the slow, irregular change in the Earth's rotation.
--
-- ΔT is the limiting factor.  It can only be /measured/ for the past and /extrapolated/ for the future, and the standard Espenak–Meeus polynomials are only trustworthy through roughly 2150 CE; beyond
-- that the extrapolation error grows without bound and can shift the computed equinox — and hence a borderline Nowruz — by a whole day.  Capping at Persian year 1500 (≈ 2121 CE) keeps every result
-- inside the range where the astronomy is genuinely well constrained, so every leap year we report is defensible rather than speculative.  Over this range our results match NodaTime exactly, including
-- all of the documented years where the astronomical calendar diverges from the arithmetic one (e.g. Persian 1404 = 21.Mar.2025, where the arithmetic calendar gives the 20th).
--
-- If you need dates past 2121 CE, prefer the arithmetic (Birashk) Solar Hijri calendar, whose leap rule is exact by definition and carries no astronomical uncertainty.
----------------------------------------------------------------------------
module Data.HodaTime.Calendar.Persian
(
  -- * Constructors
   calendarDate
  ,fromNthDay
  ,fromWeekDate
  -- * Types
  ,Month(..)
  ,DayOfWeek(..)
  ,Persian
)
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)
import Data.HodaTime.Calendar.Persian.Astronomical (newYearDay, minPersianYear, maxPersianYear)
import Data.Int (Int32)
import Data.Word (Word8)
import Control.Monad (guard)

-- constants

monthsPerYear :: Int
monthsPerYear :: Int
monthsPerYear = Int
12

-- | Days elapsed before each 0-based month.  Months 1-6 have 31 days, months 7-11 have 30, 'Esfand' has 29 (30 in a leap year).
persianMonthDayOffsets :: [Int]
persianMonthDayOffsets :: [Int]
persianMonthDayOffsets = [Int
0, Int
31, Int
62, Int
93, Int
124, Int
155, Int
186, Int
216, Int
246, Int
276, Int
306, Int
336]

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

-- | Persian dates are stored directly on the universal timeline (day 0 = 1.Mar.2000 Gregorian = Wednesday), so the
--   'Instant' bridge is the identity and the epoch weekday is that of the shared day 0.
epochDayOfWeek :: DayOfWeek Persian
epochDayOfWeek :: DayOfWeek Persian
epochDayOfWeek = DayOfWeek Persian
Wednesday

-- types

data Persian

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

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

  data Month Persian = Farvardin | Ordibehesht | Khordad | Tir | Mordad | Shahrivar | Mehr | Aban | Azar | Dey | Bahman | Esfand
    deriving (Int -> Month Persian -> ShowS
[Month Persian] -> ShowS
Month Persian -> String
(Int -> Month Persian -> ShowS)
-> (Month Persian -> String)
-> ([Month Persian] -> ShowS)
-> Show (Month Persian)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Month Persian -> ShowS
showsPrec :: Int -> Month Persian -> ShowS
$cshow :: Month Persian -> String
show :: Month Persian -> String
$cshowList :: [Month Persian] -> ShowS
showList :: [Month Persian] -> ShowS
Show, ReadPrec [Month Persian]
ReadPrec (Month Persian)
Int -> ReadS (Month Persian)
ReadS [Month Persian]
(Int -> ReadS (Month Persian))
-> ReadS [Month Persian]
-> ReadPrec (Month Persian)
-> ReadPrec [Month Persian]
-> Read (Month Persian)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS (Month Persian)
readsPrec :: Int -> ReadS (Month Persian)
$creadList :: ReadS [Month Persian]
readList :: ReadS [Month Persian]
$creadPrec :: ReadPrec (Month Persian)
readPrec :: ReadPrec (Month Persian)
$creadListPrec :: ReadPrec [Month Persian]
readListPrec :: ReadPrec [Month Persian]
Read, Month Persian -> Month Persian -> Bool
(Month Persian -> Month Persian -> Bool)
-> (Month Persian -> Month Persian -> Bool) -> Eq (Month Persian)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Month Persian -> Month Persian -> Bool
== :: Month Persian -> Month Persian -> Bool
$c/= :: Month Persian -> Month Persian -> Bool
/= :: Month Persian -> Month Persian -> Bool
Eq, Eq (Month Persian)
Eq (Month Persian) =>
(Month Persian -> Month Persian -> Ordering)
-> (Month Persian -> Month Persian -> Bool)
-> (Month Persian -> Month Persian -> Bool)
-> (Month Persian -> Month Persian -> Bool)
-> (Month Persian -> Month Persian -> Bool)
-> (Month Persian -> Month Persian -> Month Persian)
-> (Month Persian -> Month Persian -> Month Persian)
-> Ord (Month Persian)
Month Persian -> Month Persian -> Bool
Month Persian -> Month Persian -> Ordering
Month Persian -> Month Persian -> Month Persian
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 Persian -> Month Persian -> Ordering
compare :: Month Persian -> Month Persian -> Ordering
$c< :: Month Persian -> Month Persian -> Bool
< :: Month Persian -> Month Persian -> Bool
$c<= :: Month Persian -> Month Persian -> Bool
<= :: Month Persian -> Month Persian -> Bool
$c> :: Month Persian -> Month Persian -> Bool
> :: Month Persian -> Month Persian -> Bool
$c>= :: Month Persian -> Month Persian -> Bool
>= :: Month Persian -> Month Persian -> Bool
$cmax :: Month Persian -> Month Persian -> Month Persian
max :: Month Persian -> Month Persian -> Month Persian
$cmin :: Month Persian -> Month Persian -> Month Persian
min :: Month Persian -> Month Persian -> Month Persian
Ord, Int -> Month Persian
Month Persian -> Int
Month Persian -> [Month Persian]
Month Persian -> Month Persian
Month Persian -> Month Persian -> [Month Persian]
Month Persian -> Month Persian -> Month Persian -> [Month Persian]
(Month Persian -> Month Persian)
-> (Month Persian -> Month Persian)
-> (Int -> Month Persian)
-> (Month Persian -> Int)
-> (Month Persian -> [Month Persian])
-> (Month Persian -> Month Persian -> [Month Persian])
-> (Month Persian -> Month Persian -> [Month Persian])
-> (Month Persian
    -> Month Persian -> Month Persian -> [Month Persian])
-> Enum (Month Persian)
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 Persian -> Month Persian
succ :: Month Persian -> Month Persian
$cpred :: Month Persian -> Month Persian
pred :: Month Persian -> Month Persian
$ctoEnum :: Int -> Month Persian
toEnum :: Int -> Month Persian
$cfromEnum :: Month Persian -> Int
fromEnum :: Month Persian -> Int
$cenumFrom :: Month Persian -> [Month Persian]
enumFrom :: Month Persian -> [Month Persian]
$cenumFromThen :: Month Persian -> Month Persian -> [Month Persian]
enumFromThen :: Month Persian -> Month Persian -> [Month Persian]
$cenumFromTo :: Month Persian -> Month Persian -> [Month Persian]
enumFromTo :: Month Persian -> Month Persian -> [Month Persian]
$cenumFromThenTo :: Month Persian -> Month Persian -> Month Persian -> [Month Persian]
enumFromThenTo :: Month Persian -> Month Persian -> Month Persian -> [Month Persian]
Enum, Month Persian
Month Persian -> Month Persian -> Bounded (Month Persian)
forall a. a -> a -> Bounded a
$cminBound :: Month Persian
minBound :: Month Persian
$cmaxBound :: Month Persian
maxBound :: Month Persian
Bounded)

  fromDays :: Int32 -> Date Persian
fromDays = Int32 -> Date Persian
persianFromDays
  toDays :: Date Persian -> Int32
toDays = Date Persian -> Int32
persianToDays
  toYmd :: Date Persian -> (Int32, Word8, Word8)
toYmd = Date Persian -> (Int32, Word8, Word8)
persianToYmd
  calendarName :: Date Persian -> String
calendarName Date Persian
_ = String
"Persian"

  day' :: Date Persian -> Int
day' (PersianDate Int32
_ Word8
d Word8
_ Int32
_) = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d
  setDay' :: Int -> Date Persian -> Date Persian
setDay' = Int
-> (Int -> Month Persian -> Int -> Int)
-> (Int32 -> Date Persian)
-> (Date Persian -> (Int32, Word8, Word8))
-> Int
-> Date Persian
-> Date Persian
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 Persian -> Int -> Int
yearMonthDayToDays Int32 -> Date Persian
persianFromDays Date Persian -> (Int32, Word8, Word8)
persianToYmd
  {-# INLINE day' #-}

  month' :: Date Persian -> Month Persian
month' (PersianDate Int32
_ Word8
_ Word8
m Int32
_) = Int -> Month Persian
forall a. Enum a => Int -> a
toEnum (Int -> Month Persian) -> (Word8 -> Int) -> Word8 -> Month Persian
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month Persian) -> Word8 -> Month Persian
forall a b. (a -> b) -> a -> b
$ Word8
m
  setMonthIndex' :: Int -> Date Persian -> Date Persian
setMonthIndex' = Int
-> (Int, Int, Word8)
-> (Month Persian -> Int -> Int)
-> (Int -> Month Persian -> Int -> Int)
-> (Date Persian -> (Int32, Word8, Word8))
-> (Int32 -> Date Persian)
-> Int
-> Date Persian
-> Date Persian
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
monthsPerYear (Int, Int, Word8)
forall a b c. (Integral a, Integral b, Integral c) => (a, b, c)
firstPerDayTuple Month Persian -> Int -> Int
maxDaysInMonth Int -> Month Persian -> Int -> Int
yearMonthDayToDays Date Persian -> (Int32, Word8, Word8)
persianToYmd Int32 -> Date Persian
persianFromDays
  {-# INLINE month' #-}

  year' :: Date Persian -> Int
year' (PersianDate Int32
_ Word8
_ Word8
_ Int32
y) = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
y
  setYear' :: Int -> Date Persian -> Date Persian
setYear' = (Int, Word8, Word8)
-> (Month Persian -> Int -> Int)
-> (Int -> Month Persian -> Int -> Int)
-> (Date Persian -> (Int32, Word8, Word8))
-> (Int32 -> Date Persian)
-> Int
-> Date Persian
-> Date Persian
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)
firstPerDayTuple Month Persian -> Int -> Int
maxDaysInMonth Int -> Month Persian -> Int -> Int
yearMonthDayToDays Date Persian -> (Int32, Word8, Word8)
persianToYmd Int32 -> Date Persian
persianFromDays
  {-# INLINE year' #-}

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

  next' :: Int -> DayOfWeek Persian -> Date Persian -> Date Persian
next' Int
n DayOfWeek Persian
dow (PersianDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Persian)
-> DayOfWeek Persian
-> Int
-> DayOfWeek Persian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Persian
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Persian
persianFromDays DayOfWeek Persian
epochDayOfWeek Int
n DayOfWeek Persian
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 Persian -> Date Persian -> Date Persian
previous' Int
n DayOfWeek Persian
dow (PersianDate Int32
days Word8
_ Word8
_ Int32
_) = (Int32 -> Date Persian)
-> DayOfWeek Persian
-> Int
-> DayOfWeek Persian
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> Date Persian
forall dow d.
Enum dow =>
(Int32 -> d)
-> dow
-> Int
-> dow
-> (Int -> Int -> Int)
-> (Int -> Int -> Int)
-> (Int -> Int -> Bool)
-> Int
-> d
moveByDow Int32 -> Date Persian
persianFromDays DayOfWeek Persian
epochDayOfWeek Int
n DayOfWeek Persian
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 Persian) where
  rnf :: Date Persian -> ()
rnf (PersianDate 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 Persian) where
  hashWithSalt :: Int -> Date Persian -> Int
hashWithSalt Int
s (PersianDate 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 Persian) where
  rnf :: Month Persian -> ()
rnf Month Persian
m = Month Persian
m Month Persian -> () -> ()
forall a b. a -> b -> b
`seq` ()

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

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

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

instance IsCalendarDateTime Persian where
  fromAdjustedInstant :: Instant -> CalendarDateTime Persian
fromAdjustedInstant (Instant Int32
days Word32
secs Word32
nsecs) = Date Persian -> LocalTime -> CalendarDateTime Persian
forall calendar.
Date calendar -> LocalTime -> CalendarDateTime calendar
CalendarDateTime (Int32 -> Date Persian
persianFromDays Int32
days) (Word32 -> Word32 -> LocalTime
LocalTime Word32
secs Word32
nsecs)
  toUnadjustedInstant :: CalendarDateTime Persian -> Instant
toUnadjustedInstant (CalendarDateTime Date Persian
pd (LocalTime Word32
secs Word32
nsecs)) = Int32 -> Word32 -> Word32 -> Instant
Instant (Date Persian -> Int32
persianToDays Date Persian
pd) Word32
secs Word32
nsecs

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

persianToDays :: Date Persian -> Int32
persianToDays :: Date Persian -> Int32
persianToDays (PersianDate Int32
days Word8
_ Word8
_ Int32
_) = Int32
days

persianToYmd :: Date Persian -> (Int32, Word8, Word8)
persianToYmd :: Date Persian -> (Int32, Word8, Word8)
persianToYmd (PersianDate Int32
_ Word8
d Word8
m Int32
y) = (Int32
y, Word8
m, Word8
d)

-- Constructors

-- | Smart constructor for a 'Persian' calendar date.  Returns 'Nothing' if the day is out of range for the month or the
--   year is outside the supported range (1 .. 1500).
calendarDate :: DayOfMonth -> Month Persian -> Year -> Maybe (CalendarDate Persian)
calendarDate :: Int -> Month Persian -> Int -> Maybe (Date Persian)
calendarDate Int
d Month Persian
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
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
minPersianYear Bool -> Bool -> Bool
&& Int
y Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
maxPersianYear
  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 Persian -> Int -> Int
maxDaysInMonth Month Persian
m Int
y
  Date Persian -> Maybe (Date Persian)
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (Date Persian -> Maybe (Date Persian))
-> Date Persian -> Maybe (Date Persian)
forall a b. (a -> b) -> a -> b
$ Int32 -> Date Persian
persianFromDays (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 Persian -> Int -> Int
yearMonthDayToDays Int
y Month Persian
m Int
d)

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

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

-- helper functions

-- | A year is a leap year exactly when the astronomical rule places the next Nowruz 366 days later.
isLeapYear :: Year -> Bool
isLeapYear :: Int -> Bool
isLeapYear Int
y = Int -> Int
newYearDay (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral 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 -> Int
newYearDay (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
366

maxDaysInMonth :: Month Persian -> Year -> Int
maxDaysInMonth :: Month Persian -> Int -> Int
maxDaysInMonth Month Persian
R:MonthPersian
Esfand Int
y
  | Int -> Bool
isLeapYear Int
y                           = Int
30
  | Bool
otherwise                              = Int
29
maxDaysInMonth Month Persian
m Int
_
  | Month Persian -> Int
forall a. Enum a => a -> Int
fromEnum Month Persian
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6                         = Int
31        -- Farvardin .. Shahrivar
  | Bool
otherwise                              = Int
30        -- Mehr .. Bahman

-- | Universal flat day (day 0 = 1.Mar.2000 Gregorian) of the given Persian date.
yearMonthDayToDays :: Year -> Month Persian -> DayOfMonth -> Int
yearMonthDayToDays :: Int -> Month Persian -> Int -> Int
yearMonthDayToDays Int
y Month Persian
m Int
d = Int -> Int
newYearDay (Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int]
persianMonthDayOffsets [Int] -> Int -> Int
forall a. HasCallStack => [a] -> Int -> a
!! Month Persian -> Int
forall a. Enum a => a -> Int
fromEnum Month Persian
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
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
    day :: Int
day = Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
flatDays :: Int                               -- universal flat day
    yEst :: Int
yEst = Int
minPersianYear Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
newYearDay Int
minPersianYear) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
365
    y :: Int
y = Int -> Int
adjust Int
yEst
    adjust :: Int -> Int
adjust Int
yy
      | Int -> Int
newYearDay Int
yy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
day        = Int -> Int
adjust (Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
      | Int -> Int
newYearDay (Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
day = Int -> Int
adjust (Int
yy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise                  = Int
yy
    dayOfYear :: Int
dayOfYear = Int
day Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
newYearDay Int
y
    (Int
m, Int
d)
      | Int
dayOfYear Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
365                   = (Int
11, Int
30)                -- Esfand 30 (leap years only)
      | Int
dayOfYear Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
31                 = let (Int
mm, Int
dd) = Int
dayOfYear Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
31 in (Int
mm, Int
dd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
      | Bool
otherwise                          = let (Int
mm, Int
dd) = (Int
dayOfYear Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
31) Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
30 in (Int
mm Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6, Int
dd Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)