{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleContexts #-}
module Data.HodaTime.Calendar.Internal
(
   mkCommonDayLens
  ,mkCommonMonthLens
  ,mkYearLens
  ,moveByDow
  ,dayOfWeekFromDays
  ,commonMonthDayOffsets
  ,borders
  ,daysPerStandardYear
  ,daysPerFourYears
  ,daysPerCentury
)
where

import Data.HodaTime.CalendarDateTime.Internal (CalendarDate(..), IsCalendar(..), Year, DayOfMonth)
import Data.Int (Int32)
import Data.Word (Word8, Word32)
import Control.Arrow ((>>>), first)

-- Constants

daysPerStandardYear :: Num a => a
daysPerStandardYear :: forall a. Num a => a
daysPerStandardYear = a
365

daysPerFourYears :: Num a => a
daysPerFourYears :: forall a. Num a => a
daysPerFourYears = a
1461

daysPerCentury :: Num a => a
daysPerCentury :: forall a. Num a => a
daysPerCentury = a
36524

-- helper functions

mkCommonDayLens :: (IsCalendar cal, Functor f, Enum (Month cal)) =>
     Int
  -> (Year -> Month cal -> DayOfMonth -> Int)
  -> (Int32 -> (Word32, Word8, Word8))
  -> (DayOfMonth -> f DayOfMonth)
  -> CalendarDate cal
  -> f (CalendarDate cal)
mkCommonDayLens :: 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
preStartDay Int -> Month cal -> Int -> Int
yearMonthDayToDays Int32 -> (Word32, Word8, Word8)
daysToyearMonthDays Int -> f Int
f (CalendarDate Int32
_ Word8
d Word8
m Word32
y) = Int -> CalendarDate cal
mkcd (Int -> CalendarDate cal)
-> (Int -> Int) -> Int -> CalendarDate cal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
restInt -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> CalendarDate cal) -> f Int -> f (CalendarDate cal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d)
    where
      rest :: Int
rest = Int -> Int
forall a. Enum a => a -> a
pred (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Month cal -> Int -> Int
yearMonthDayToDays (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y) (Int -> Month cal
forall a. Enum a => Int -> a
toEnum (Int -> Month cal) -> (Word8 -> Int) -> Word8 -> Month cal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month cal) -> Word8 -> Month cal
forall a b. (a -> b) -> a -> b
$ Word8
m) Int
1
      mkcd :: Int -> CalendarDate cal
mkcd Int
days =
        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
$ if Int
days Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
preStartDay then Int
days else Int
preStartDay Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
          (Word32
y', Word8
m', Word8
d') = Int32 -> (Word32, Word8, Word8)
daysToyearMonthDays Int32
days'
        in Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate cal
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate Int32
days' Word8
d' Word8
m' Word32
y'
{-# INLINE mkCommonDayLens #-}

mkCommonMonthLens :: (IsCalendar cal, Functor f, Enum (Month cal)) =>
     (Int, Int, Word8)
  -> (Month cal -> Year -> Int)
  -> (Year -> Month cal -> DayOfMonth -> Int)
  -> (Int -> f Int)
  -> CalendarDate cal
  -> f (CalendarDate cal)
mkCommonMonthLens :: 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)
firstDayTuple Month cal -> Int -> Int
maxDaysInMonth Int -> Month cal -> Int -> Int
yearMonthDayToDays Int -> f Int
f (CalendarDate Int32
_ Word8
d Word8
m Word32
y) = Int -> CalendarDate cal
mkcd (Int -> CalendarDate cal) -> f Int -> f (CalendarDate cal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (Word8 -> Int
forall a. Enum a => a -> Int
fromEnum Word8
m)
    where
      mkcd :: Int -> CalendarDate cal
mkcd Int
months = Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate cal
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate (Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
days) Word8
d'' (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
m') (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y'')
        where
          (Int
y', Int
months') = (Int -> Int -> (Int, Int)) -> Int -> Int -> (Int, Int)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
divMod Int
12 (Int -> (Int, Int))
-> ((Int, Int) -> (Int, Int)) -> Int -> (Int, Int)
forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> (Int -> Int) -> (Int, Int) -> (Int, Int)
forall b c d. (b -> c) -> (b, d) -> (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y) (Int -> (Int, Int)) -> Int -> (Int, Int)
forall a b. (a -> b) -> a -> b
$ Int
months
          (Int
y'', Int
m', Word8
d') = if (Int
y', Int
months', Word8
d) (Int, Int, Word8) -> (Int, Int, Word8) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Int, Word8)
firstDayTuple then (Int, Int, Word8)
firstDayTuple else (Int
y', Int
months', Word8
d)
          mdim :: Word8
mdim = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Month cal -> Int -> Int
maxDaysInMonth (Int -> Month cal
forall a. Enum a => Int -> a
toEnum Int
m') Int
y'
          d'' :: Word8
d'' = if Word8
d' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
mdim then Word8
mdim else Word8
d'
          days :: Int
days = Int -> Month cal -> Int -> Int
yearMonthDayToDays Int
y'' (Int -> Month cal
forall a. Enum a => Int -> a
toEnum Int
m') (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d'')
{-# INLINE mkCommonMonthLens #-}

mkYearLens :: (IsCalendar cal, Functor f, Enum (Month cal)) =>
     (Int, Word8, Word8)
  -> (Month cal -> Year -> Int)
  -> (Year -> Month cal -> DayOfMonth -> Int)
  -> (Int -> f Int)
  -> CalendarDate cal
  -> f (CalendarDate cal)
mkYearLens :: 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)
firstDayTuple Month cal -> Int -> Int
maxDaysInMonth Int -> Month cal -> Int -> Int
yearMonthDayToDays Int -> f Int
f (CalendarDate Int32
_ Word8
d Word8
m Word32
y) = Int -> CalendarDate cal
mkcd (Int -> CalendarDate cal) -> f Int -> f (CalendarDate cal)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> f Int
f (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
y)
    where
      mkcd :: Int -> CalendarDate cal
mkcd Int
y' = Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate cal
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate Int32
days Word8
d'' Word8
m' (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
y'')
        where
          (Int
y'', Word8
m', Word8
d') = if (Int
y', Word8
m, Word8
d) (Int, Word8, Word8) -> (Int, Word8, Word8) -> Bool
forall a. Ord a => a -> a -> Bool
< (Int, Word8, Word8)
firstDayTuple then (Int, Word8, Word8)
firstDayTuple else (Int
y', Word8
m, Word8
d)
          m'' :: Month cal
m'' = Int -> Month cal
forall a. Enum a => Int -> a
toEnum (Int -> Month cal) -> (Word8 -> Int) -> Word8 -> Month cal
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Month cal) -> Word8 -> Month cal
forall a b. (a -> b) -> a -> b
$ Word8
m'
          mdim :: Word8
mdim = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Month cal -> Int -> Int
maxDaysInMonth Month cal
m'' Int
y''
          d'' :: Word8
d'' = if Word8
d' Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
> Word8
mdim then Word8
mdim else Word8
d'
          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 cal -> Int -> Int
yearMonthDayToDays Int
y'' Month cal
m'' (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d'')        
{-# INLINE mkYearLens #-}

moveByDow :: (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 :: 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 cal
epochDayOfWeek Int
n DayOfWeek cal
dow Int -> Int -> Int
distanceF Int -> Int -> Int
adjust Int -> Int -> Bool
cmp Int
days = Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate cal
forall calendar.
Int32 -> Word8 -> Word8 -> Word32 -> CalendarDate calendar
CalendarDate Int32
days' Word8
d Word8
m Word32
y
  where
    n' :: Int
n' = if Int
targetDow Int -> Int -> Bool
`cmp` Int
currentDoW then Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1 else Int
n
    currentDoW :: Int
currentDoW = DayOfWeek cal -> Int -> Int
forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
DayOfWeek cal -> Int -> Int
dayOfWeekFromDays DayOfWeek cal
epochDayOfWeek Int
days
    targetDow :: Int
targetDow = Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int) -> (DayOfWeek cal -> Int) -> DayOfWeek cal -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DayOfWeek cal -> Int
forall a. Enum a => a -> Int
fromEnum (DayOfWeek cal -> Int) -> DayOfWeek cal -> Int
forall a b. (a -> b) -> a -> b
$ DayOfWeek cal
dow
    distance :: Int
distance = Int -> Int -> Int
distanceF Int
targetDow Int
currentDoW
    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 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
days Int -> Int -> Int
`adjust` (Int
7 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
n') Int -> Int -> Int
`adjust` Int
distance
    (Word32
y, Word8
m, Word8
d) = Int32 -> (Word32, Word8, Word8)
daysToYearMonthDay Int32
days'

dayOfWeekFromDays :: (IsCalendar cal, Enum (DayOfWeek cal)) => DayOfWeek cal -> Int -> Int
dayOfWeekFromDays :: forall cal.
(IsCalendar cal, Enum (DayOfWeek cal)) =>
DayOfWeek cal -> Int -> Int
dayOfWeekFromDays DayOfWeek cal
epochDayOfWeek = Int -> Int
forall {a}. (Ord a, Num a) => a -> a
normalize (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DayOfWeek cal -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek cal
epochDayOfWeek Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Int -> Int) -> Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Int -> Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
7
  where
    normalize :: a -> a
normalize a
n = if a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>= a
7 then a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
7 else a
n

commonMonthDayOffsets :: Num a => [a]
commonMonthDayOffsets :: forall a. Num a => [a]
commonMonthDayOffsets = a
0 a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
rest
  where
    rest :: [a]
rest = (a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(+) [a]
daysPerMonth (a
0a -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest)
    daysPerMonth :: [a]
daysPerMonth = [a
31, a
30, a
31, a
30, a
31, a
31, a
30, a
31, a
30, a
31, a
31]

-- | The issue is that 4 * daysPerCentury will be one less than daysPerCycle.  The reason for this is that the Gregorian calendar adds one more day per 400 year cycle
--   and this day is missing from adding up 4 individual centuries.  We have the same issue again with 4 years (i.e. 365*4 is daysPerFourYears - 1)
--   so we use this function to check if this has occurred so we can add the missing day back in.
borders :: (Num a, Eq a) => a -> a -> Bool
borders :: forall a. (Num a, Eq a) => a -> a -> Bool
borders a
c a
x = a
x a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
c a -> a -> a
forall a. Num a => a -> a -> a
- a
1