{-# LANGUAGE CPP                #-}
{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveDataTypeable #-}
#if __GLASGOW_HASKELL__ >= 710
{-# LANGUAGE PatternSynonyms    #-}
{-# LANGUAGE ViewPatterns       #-}
#endif
module Data.Time.Calendar.WeekDate.Compat (
    Year, WeekOfYear, DayOfWeek(..), dayOfWeek,
    FirstWeekType (..),
    toWeekCalendar,
    fromWeekCalendar,
    fromWeekCalendarValid,
    

    -- * ISO 8601 Week Date format
    toWeekDate,
    fromWeekDate,
#if __GLASGOW_HASKELL__ >= 710
    pattern YearWeekDay,
#endif
    fromWeekDateValid,
    showWeekDate,
) where

import Data.Time.Orphans ()

import Data.Time.Calendar
import Data.Time.Calendar.WeekDate

#if !MIN_VERSION_time(1,9,0)
import Data.Time.Format
#endif

#if !MIN_VERSION_time(1,11,0)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Data.Time.Calendar.Types
import Data.Time.Calendar.Private
import Data.Time.Calendar.OrdinalDate
#endif

import Control.DeepSeq (NFData (..))
import Data.Hashable (Hashable (..))


#if !MIN_VERSION_time(1,11,0)
data FirstWeekType
    = FirstWholeWeek
    -- ^ first week is the first whole week of the year
    | FirstMostWeek
    -- ^ first week is the first week with four days in the year
    deriving (FirstWeekType -> FirstWeekType -> Bool
(FirstWeekType -> FirstWeekType -> Bool)
-> (FirstWeekType -> FirstWeekType -> Bool) -> Eq FirstWeekType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FirstWeekType -> FirstWeekType -> Bool
$c/= :: FirstWeekType -> FirstWeekType -> Bool
== :: FirstWeekType -> FirstWeekType -> Bool
$c== :: FirstWeekType -> FirstWeekType -> Bool
Eq, Typeable)

firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
dow Year
year = let
    jan1st :: Day
jan1st = Year -> Int -> Day
fromOrdinalDate Year
year Int
1
    in case FirstWeekType
wt of
        FirstWeekType
FirstWholeWeek -> DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dow Day
jan1st
        FirstWeekType
FirstMostWeek -> DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dow (Day -> Day) -> Day -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Day -> Day
addDays (-Year
3) Day
jan1st

-- Note that the year number matches the weeks, and so is not always the same as the Gregorian year number.
toWeekCalendar ::
    FirstWeekType
    -- ^ how to reckon the first week of the year
    -> DayOfWeek
    -- ^ the first day of each week
    -> Day
    -> (Year, WeekOfYear, DayOfWeek)
toWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> (Year, Int, DayOfWeek)
toWeekCalendar FirstWeekType
wt DayOfWeek
ws Day
d = let
    dw :: DayOfWeek
dw = Day -> DayOfWeek
dayOfWeek Day
d
    (Year
y0,Int
_) = Day -> (Year, Int)
toOrdinalDate Day
d
    j1p :: Day
j1p = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
pred Year
y0
    j1 :: Day
j1 = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y0
    j1s :: Day
j1s = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
succ Year
y0
    in if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
j1
        then (Year -> Year
forall a. Enum a => a -> a
pred Year
y0,Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Year -> Int
forall a. Num a => Year -> a
fromInteger (Year -> Int) -> Year -> Int
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1p) Int
7,DayOfWeek
dw)
        else if Day
d Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
< Day
j1s then (Year
y0,Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Year -> Int
forall a. Num a => Year -> a
fromInteger (Year -> Int) -> Year -> Int
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1) Int
7,DayOfWeek
dw)
        else (Year -> Year
forall a. Enum a => a -> a
succ Year
y0,Int -> Int
forall a. Enum a => a -> a
succ (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (Year -> Int
forall a. Num a => Year -> a
fromInteger (Year -> Int) -> Year -> Int
forall a b. (a -> b) -> a -> b
$ Day -> Day -> Year
diffDays Day
d Day
j1s) Int
7,DayOfWeek
dw)

-- | Convert from the given kind of "week calendar".
-- Invalid week and day values will be clipped to the correct range.
fromWeekCalendar ::
    FirstWeekType
    -- ^ how to reckon the first week of the year
    -> DayOfWeek
    -- ^ the first day of each week
    -> Year -> WeekOfYear -> DayOfWeek -> Day
fromWeekCalendar :: FirstWeekType -> DayOfWeek -> Year -> Int -> DayOfWeek -> Day
fromWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y Int
wy DayOfWeek
dw = let
    d1 :: Day
    d1 :: Day
d1 = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y
    wy' :: Int
wy' = Int -> Int -> Int -> Int
forall t. Ord t => t -> t -> t -> t
clip Int
1 Int
53 Int
wy
    getday :: WeekOfYear -> Day
    getday :: Int -> Day
getday Int
wy'' = Year -> Day -> Day
addDays (Int -> Year
forall a. Integral a => a -> Year
toInteger (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ (Int -> Int
forall a. Enum a => a -> a
pred Int
wy'' Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
7) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff DayOfWeek
dw DayOfWeek
ws)) Day
d1
    d1s :: Day
d1s = FirstWeekType -> DayOfWeek -> Year -> Day
firstDayOfWeekCalendar FirstWeekType
wt DayOfWeek
ws (Year -> Day) -> Year -> Day
forall a b. (a -> b) -> a -> b
$ Year -> Year
forall a. Enum a => a -> a
succ Year
y
    day :: Day
day = Int -> Day
getday Int
wy'
    in if Int
wy' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
53 then if Day
day Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
>= Day
d1s then Int -> Day
getday Int
52 else Day
day else Day
day

-- | Convert from the given kind of "week calendar".
-- Invalid week and day values will return Nothing.
fromWeekCalendarValid ::
     FirstWeekType
    -- ^ how to reckon the first week of the year
    -> DayOfWeek
    -- ^ the first day of each week
    -> Year -> WeekOfYear -> DayOfWeek -> Maybe Day
fromWeekCalendarValid :: FirstWeekType -> DayOfWeek -> Year -> Int -> DayOfWeek -> Maybe Day
fromWeekCalendarValid FirstWeekType
wt DayOfWeek
ws Year
y Int
wy DayOfWeek
dw = let
    d :: Day
d = FirstWeekType -> DayOfWeek -> Year -> Int -> DayOfWeek -> Day
fromWeekCalendar FirstWeekType
wt DayOfWeek
ws Year
y Int
wy DayOfWeek
dw
    in if FirstWeekType -> DayOfWeek -> Day -> (Year, Int, DayOfWeek)
toWeekCalendar FirstWeekType
wt DayOfWeek
ws Day
d (Year, Int, DayOfWeek) -> (Year, Int, DayOfWeek) -> Bool
forall a. Eq a => a -> a -> Bool
== (Year
y,Int
wy,DayOfWeek
dw) then Day -> Maybe Day
forall a. a -> Maybe a
Just Day
d else Maybe Day
forall a. Maybe a
Nothing

#if __GLASGOW_HASKELL__ >= 710
-- | Bidirectional abstract constructor for ISO 8601 Week Date format.
-- Invalid week values will be clipped to the correct range.
pattern YearWeekDay :: Year -> WeekOfYear -> DayOfWeek -> Day
pattern $bYearWeekDay :: Year -> Int -> DayOfWeek -> Day
$mYearWeekDay :: forall r.
Day -> (Year -> Int -> DayOfWeek -> r) -> (Void# -> r) -> r
YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where
    YearWeekDay Year
y Int
wy DayOfWeek
dw = Year -> Int -> Int -> Day
fromWeekDate Year
y Int
wy (DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
dw)

#if __GLASGOW_HASKELL__ >= 802
{-# COMPLETE YearWeekDay #-}
#endif
#endif

#endif

#if !MIN_VERSION_time(1,9,0)

data DayOfWeek
    = Monday
    | Tuesday
    | Wednesday
    | Thursday
    | Friday
    | Saturday
    | Sunday
    deriving (Eq, Ord, Show, Read, Typeable, Data)

instance NFData DayOfWeek where
    rnf !_ = ()

instance Hashable DayOfWeek where
    hashWithSalt salt = hashWithSalt salt . fromEnum

-- | \"Circular\", so for example @[Tuesday ..]@ gives an endless sequence.
-- Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday], and 'toEnum' performs mod 7 to give a cycle of days.
instance Enum DayOfWeek where
    toEnum i =
        case mod i 7 of
            0 -> Sunday
            1 -> Monday
            2 -> Tuesday
            3 -> Wednesday
            4 -> Thursday
            5 -> Friday
            _ -> Saturday
    fromEnum Monday = 1
    fromEnum Tuesday = 2
    fromEnum Wednesday = 3
    fromEnum Thursday = 4
    fromEnum Friday = 5
    fromEnum Saturday = 6
    fromEnum Sunday = 7
    enumFromTo wd1 wd2
        | wd1 == wd2 = [wd1]
    enumFromTo wd1 wd2 = wd1 : enumFromTo (succ wd1) wd2
    enumFromThenTo wd1 wd2 wd3
        | wd2 == wd3 = [wd1, wd2]
    enumFromThenTo wd1 wd2 wd3 = wd1 : enumFromThenTo wd2 (toEnum $ (2 * fromEnum wd2) - (fromEnum wd1)) wd3

dayOfWeek :: Day -> DayOfWeek
dayOfWeek (ModifiedJulianDay d) = toEnum $ fromInteger $ d + 3



-------------------------------------------------------------------------------
-- FormatTime DayOfWeek
-------------------------------------------------------------------------------

toSomeDay :: DayOfWeek -> Day
toSomeDay d = ModifiedJulianDay (fromIntegral $ fromEnum d + 4)

#if MIN_VERSION_time(1,8,0)
#define FORMAT_OPTS tl mpo i
#else
#define FORMAT_OPTS tl mpo
#endif

instance FormatTime DayOfWeek where
    formatCharacter 'u' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'u')
    formatCharacter 'w' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'w')
    formatCharacter 'a' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'a')
    formatCharacter 'A' = fmap (\f FORMAT_OPTS d -> f FORMAT_OPTS (toSomeDay d)) (formatCharacter 'A')
    formatCharacter _  = Nothing

#endif

#if !MIN_VERSION_time(1,11,0)
-- | @dayOfWeekDiff a b = a - b@ in range 0 to 6.
-- The number of days from b to the next a.
dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff DayOfWeek
a DayOfWeek
b = Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod (DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
a Int -> Int -> Int
forall a. Num a => a -> a -> a
- DayOfWeek -> Int
forall a. Enum a => a -> Int
fromEnum DayOfWeek
b) Int
7

-- | The first day-of-week on or after some day
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter DayOfWeek
dw Day
d = Year -> Day -> Day
addDays (Int -> Year
forall a. Integral a => a -> Year
toInteger (Int -> Year) -> Int -> Year
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff DayOfWeek
dw (DayOfWeek -> Int) -> DayOfWeek -> Int
forall a b. (a -> b) -> a -> b
$ Day -> DayOfWeek
dayOfWeek Day
d) Day
d
#endif