lib/Data/Time/Calendar/WeekDate.hs

    {-# LANGUAGE Safe #-}

    -- | Week-based calendars
    module Data.Time.Calendar.WeekDate
        (
            Year, WeekOfYear, DayOfWeek(..), dayOfWeek,
            FirstWeekType (..),toWeekCalendar,fromWeekCalendar,fromWeekCalendarValid,
            -- * ISO 8601 Week Date format
            toWeekDate, fromWeekDate, pattern YearWeekDay,
            fromWeekDateValid, showWeekDate
        ) where

    import Data.Time.Calendar.Types
    import Data.Time.Calendar.Days
    import Data.Time.Calendar.Week
    import Data.Time.Calendar.OrdinalDate
    import Data.Time.Calendar.Private

    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 Eq

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

    -- | Convert to the given kind of "week calendar".
    -- 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 wt ws d = let
        dw = dayOfWeek d
        (y0,_) = toOrdinalDate d
        j1p = firstDayOfWeekCalendar wt ws $ pred y0
        j1 = firstDayOfWeekCalendar wt ws y0
        j1s = firstDayOfWeekCalendar wt ws $ succ y0
        in if d < j1
            then (pred y0,succ $ div (fromInteger $ diffDays d j1p) 7,dw)
            else if d < j1s then (y0,succ $ div (fromInteger $ diffDays d j1) 7,dw)
            else (succ y0,succ $ div (fromInteger $ diffDays d j1s) 7,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 wt ws y wy dw = let
        d1 :: Day
        d1 = firstDayOfWeekCalendar wt ws y
        wy' = clip 1 53 wy
        getday :: WeekOfYear -> Day
        getday wy'' = addDays (toInteger $ (pred wy'' * 7) + (dayOfWeekDiff dw ws)) d1
        d1s = firstDayOfWeekCalendar wt ws $ succ y
        day = getday wy'
        in if wy' == 53 then if day >= d1s then getday 52 else day else 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 wt ws y wy dw = let
        d = fromWeekCalendar wt ws y wy dw
        in if toWeekCalendar wt ws d == (y,wy,dw) then Just d else Nothing

    -- | Convert to ISO 8601 Week Date format. First element of result is year, second week number (1-53), third day of week (1 for Monday to 7 for Sunday).
    -- Note that \"Week\" years are not quite the same as Gregorian years, as the first day of the year is always a Monday.
    -- The first week of a year is the first week to contain at least four days in the corresponding Gregorian year.
    toWeekDate :: Day -> (Year, WeekOfYear, Int)
    toWeekDate d = let
        (y,wy,dw) = toWeekCalendar FirstMostWeek Monday d
        in (y,wy,fromEnum dw)

    -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
    -- Invalid week and day values will be clipped to the correct range.
    fromWeekDate :: Year -> WeekOfYear -> Int -> Day
    fromWeekDate y wy dw = fromWeekCalendar FirstMostWeek Monday y wy (toEnum $ clip 1 7 dw)

    -- | 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 YearWeekDay y wy dw <- (toWeekDate -> (y,wy,toEnum -> dw)) where
        YearWeekDay y wy dw = fromWeekDate y wy (fromEnum dw)

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

    -- | Convert from ISO 8601 Week Date format. First argument is year, second week number (1-52 or 53), third day of week (1 for Monday to 7 for Sunday).
    -- Invalid week and day values will return Nothing.
    fromWeekDateValid :: Year -> WeekOfYear -> Int -> Maybe Day
    fromWeekDateValid y wy dwr = do
        dw <- clipValid 1 7 dwr
        fromWeekCalendarValid FirstMostWeek Monday y wy (toEnum dw)

    -- | Show in ISO 8601 Week Date format as yyyy-Www-d (e.g. \"2006-W46-3\").
    showWeekDate :: Day -> String
    showWeekDate date = (show4 y) ++ "-W" ++ (show2 w) ++ "-" ++ (show d)
      where
        (y, w, d) = toWeekDate date