{-# 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 (..)) #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 !_ = () -- | \"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