    {-|

    Manipulate the time periods typically used for reports with Period,
    a richer abstraction than DateSpan. See also Types and Dates.

    -}

    module Hledger.Data.Period (
       periodAsDateSpan
      ,dateSpanAsPeriod
      ,simplifyPeriod
      ,isLastDayOfMonth
      ,isStandardPeriod
      ,showPeriod
      ,showPeriodMonthAbbrev
      ,periodStart
      ,periodEnd
      ,periodNext
      ,periodPrevious
      ,periodNextIn
      ,periodPreviousIn
      ,periodMoveTo
      ,periodGrow
      ,periodShrink
      ,mondayBefore
      ,yearMonthContainingWeekStarting
      ,quarterContainingMonth
      ,firstMonthOfQuarter
      ,startOfFirstWeekInMonth
    )
    where

    import Data.Time.Calendar
    import Data.Time.Calendar.MonthDay
    import Data.Time.Calendar.OrdinalDate
    import Data.Time.Calendar.WeekDate
    import Data.Time.Format
    import Text.Printf

    import Hledger.Data.Types

    -- | Convert Periods to DateSpans.
    --
    -- >>> periodAsDateSpan (MonthPeriod 2000 1) == DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1)
    -- True
    periodAsDateSpan :: Period -> DateSpan
    periodAsDateSpan :: Period -> DateSpan
    periodAsDateSpan (DayPeriod d :: Day
    d) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    d) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays 1 Day
    d)
    periodAsDateSpan (WeekPeriod b :: Day
    b) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    b) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Day -> Day
    addDays 7 Day
    b)
    periodAsDateSpan (MonthPeriod y :: Integer
    y m :: Month
    m) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    y Month
    m 1) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    y' Month
    m' 1)
      where
        (y' :: Integer
    y',m' :: Month
    m') | Month
    mMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==12     = (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1,1)
                | Bool
    otherwise = (Integer
    y,Month
    mMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1)
    periodAsDateSpan (QuarterPeriod y :: Integer
    y q :: Month
    q) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    y Month
    m 1) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    y' Month
    m' 1)
      where
        (y' :: Integer
    y', q' :: Month
    q') | Month
    qMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==4      = (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1,1)
                 | Bool
    otherwise = (Integer
    y,Month
    qMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1)
        quarterAsMonth :: a -> a
    quarterAsMonth q :: a
    q = (a
    qa -> a -> a
    forall a. Num a => a -> a -> a
    -1) a -> a -> a
    forall a. Num a => a -> a -> a
    * 3 a -> a -> a
    forall a. Num a => a -> a -> a
    + 1
        m :: Month
    m  = Month -> Month
    forall a. Num a => a -> a
    quarterAsMonth Month
    q
        m' :: Month
    m' = Month -> Month
    forall a. Num a => a -> a
    quarterAsMonth Month
    q'
    periodAsDateSpan (YearPeriod y :: Integer
    y) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    y 1 1) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just (Day -> Maybe Day) -> Day -> Maybe Day
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1) 1 1)
    periodAsDateSpan (PeriodBetween b :: Day
    b e :: Day
    e) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    b) (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    e)
    periodAsDateSpan (PeriodFrom b :: Day
    b) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    b) Maybe Day
    forall a. Maybe a
    Nothing
    periodAsDateSpan (PeriodTo e :: Day
    e) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    forall a. Maybe a
    Nothing (Day -> Maybe Day
    forall a. a -> Maybe a
    Just Day
    e)
    periodAsDateSpan (Period
    PeriodAll) = Maybe Day -> Maybe Day -> DateSpan
    DateSpan Maybe Day
    forall a. Maybe a
    Nothing Maybe Day
    forall a. Maybe a
    Nothing

    -- | Convert DateSpans to Periods.
    --
    -- >>> dateSpanAsPeriod $ DateSpan (Just $ fromGregorian 2000 1 1) (Just $ fromGregorian 2000 2 1)
    -- MonthPeriod 2000 1
    dateSpanAsPeriod :: DateSpan -> Period
    dateSpanAsPeriod :: DateSpan -> Period
    dateSpanAsPeriod (DateSpan (Just b :: Day
    b) (Just e :: Day
    e)) = Period -> Period
    simplifyPeriod (Period -> Period) -> Period -> Period
    forall a b. (a -> b) -> a -> b
    $ Day -> Day -> Period
    PeriodBetween Day
    b Day
    e
    dateSpanAsPeriod (DateSpan (Just b :: Day
    b) Nothing) = Day -> Period
    PeriodFrom Day
    b
    dateSpanAsPeriod (DateSpan Nothing (Just e :: Day
    e)) = Day -> Period
    PeriodTo Day
    e
    dateSpanAsPeriod (DateSpan Nothing Nothing) = Period
    PeriodAll

    -- | Convert PeriodBetweens to a more abstract period where possible.
    --
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 1 1 1) (fromGregorian 2 1 1)
    -- YearPeriod 1
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 10 1) (fromGregorian 2001 1 1)
    -- QuarterPeriod 2000 4
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 1) (fromGregorian 2000 3 1)
    -- MonthPeriod 2000 2
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2016 7 25) (fromGregorian 2016 8 1)
    -- WeekPeriod 2016-07-25
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 1 1) (fromGregorian 2000 1 2)
    -- DayPeriod 2000-01-01
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 28) (fromGregorian 2000 3 1)
    -- PeriodBetween 2000-02-28 2000-03-01
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 2 29) (fromGregorian 2000 3 1)
    -- DayPeriod 2000-02-29
    -- >>> simplifyPeriod $ PeriodBetween (fromGregorian 2000 12 31) (fromGregorian 2001 1 1)
    -- DayPeriod 2000-12-31
    --
    simplifyPeriod :: Period -> Period
    simplifyPeriod :: Period -> Period
    simplifyPeriod (PeriodBetween b :: Day
    b e :: Day
    e) =
      case (Day -> (Integer, Month, Month)
    toGregorian Day
    b, Day -> (Integer, Month, Month)
    toGregorian Day
    e) of
        -- a year
        ((by :: Integer
    by,1,1), (ey :: Integer
    ey,1,1))   | Integer
    byInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey           -> Integer -> Period
    YearPeriod Integer
    by
        -- a half-year
        -- ((by,1,1), (ey,7,1))   | by==ey             ->
        -- ((by,7,1), (ey,1,1))   | by+1==ey           ->
        -- a quarter
        ((by :: Integer
    by,1,1), (ey :: Integer
    ey,4,1))   | Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey             -> Integer -> Month -> Period
    QuarterPeriod Integer
    by 1
        ((by :: Integer
    by,4,1), (ey :: Integer
    ey,7,1))   | Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey             -> Integer -> Month -> Period
    QuarterPeriod Integer
    by 2
        ((by :: Integer
    by,7,1), (ey :: Integer
    ey,10,1))  | Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey             -> Integer -> Month -> Period
    QuarterPeriod Integer
    by 3
        ((by :: Integer
    by,10,1), (ey :: Integer
    ey,1,1))  | Integer
    byInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey           -> Integer -> Month -> Period
    QuarterPeriod Integer
    by 4
        -- a month
        ((by :: Integer
    by,bm :: Month
    bm,1), (ey :: Integer
    ey,em :: Month
    em,1)) | Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey Bool -> Bool -> Bool
    && Month
    bmMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1Month -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Month
    em -> Integer -> Month -> Period
    MonthPeriod Integer
    by Month
    bm
        ((by :: Integer
    by,12,1), (ey :: Integer
    ey,1,1))  | Integer
    byInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey           -> Integer -> Month -> Period
    MonthPeriod Integer
    by 12
        -- a week (two successive mondays),
        -- YYYYwN ("week N of year YYYY")
        -- _ | let ((by,bw,bd), (ey,ew,ed)) = (toWeekDate from, toWeekDate to) in by==ey && fw+1==tw && bd==1 && ed==1 ->
        -- a week starting on a monday
        _ | let ((by :: Integer
    by,bw :: Month
    bw,bd :: Month
    bd), (ey :: Integer
    ey,ew :: Month
    ew,ed :: Month
    ed)) = (Day -> (Integer, Month, Month)
    toWeekDate Day
    b, Day -> (Integer, Month, Month)
    toWeekDate (Integer -> Day -> Day
    addDays (-1) Day
    e))
            in Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey Bool -> Bool -> Bool
    && Month
    bwMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Month
    ew Bool -> Bool -> Bool
    && Month
    bdMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1 Bool -> Bool -> Bool
    && Month
    edMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==7   -> Day -> Period
    WeekPeriod Day
    b
        -- a day
        ((by :: Integer
    by,bm :: Month
    bm,bd :: Month
    bd), (ey :: Integer
    ey,em :: Month
    em,ed :: Month
    ed)) |
            (Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey Bool -> Bool -> Bool
    && Month
    bmMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Month
    em Bool -> Bool -> Bool
    && Month
    bdMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1Month -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Month
    ed) Bool -> Bool -> Bool
    ||
            (Integer
    byInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey Bool -> Bool -> Bool
    && Month
    bmMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==12 Bool -> Bool -> Bool
    && Month
    emMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1 Bool -> Bool -> Bool
    && Month
    bdMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31 Bool -> Bool -> Bool
    && Month
    edMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1) Bool -> Bool -> Bool
    || -- crossing a year boundary
            (Integer
    byInteger -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Integer
    ey Bool -> Bool -> Bool
    && Month
    bmMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1Month -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Month
    em Bool -> Bool -> Bool
    && Integer -> Month -> Month -> Bool
    forall a a. (Eq a, Eq a, Num a, Num a) => Integer -> a -> a -> Bool
    isLastDayOfMonth Integer
    by Month
    bm Month
    bd Bool -> Bool -> Bool
    && Month
    edMonth -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    ==1) -- crossing a month boundary
             -> Day -> Period
    DayPeriod Day
    b
        _ -> Day -> Day -> Period
    PeriodBetween Day
    b Day
    e
    simplifyPeriod p :: Period
    p = Period
    p

    isLastDayOfMonth :: Integer -> a -> a -> Bool
    isLastDayOfMonth y :: Integer
    y m :: a
    m d :: a
    d =
      case a
    m of
        1 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        2 | Integer -> Bool
    isLeapYear Integer
    y -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==29
          | Bool
    otherwise    -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==28
        3 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        4 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==30
        5 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        6 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==30
        7 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        8 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        9 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==30
        10 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        11 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==30
        12 -> a
    da -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    ==31
        _ -> Bool
    False

    -- | Is this period a "standard" period, referencing a particular day, week, month, quarter, or year ?
    -- Periods of other durations, or infinite duration, or not starting on a standard period boundary, are not.
    isStandardPeriod :: Period -> Bool
    isStandardPeriod = Period -> Bool
    isStandardPeriod' (Period -> Bool) -> (Period -> Period) -> Period -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Period -> Period
    simplifyPeriod
      where
        isStandardPeriod' :: Period -> Bool
    isStandardPeriod' (DayPeriod _) = Bool
    True
        isStandardPeriod' (WeekPeriod _) = Bool
    True
        isStandardPeriod' (MonthPeriod _ _) = Bool
    True
        isStandardPeriod' (QuarterPeriod _ _) = Bool
    True
        isStandardPeriod' (YearPeriod _) = Bool
    True
        isStandardPeriod' _ = Bool
    False

    -- | Render a period as a compact display string suitable for user output.
    --
    -- >>> showPeriod (WeekPeriod (fromGregorian 2016 7 25))
    -- "2016-07-25W30"
    showPeriod :: Period -> String
    showPeriod (DayPeriod b :: Day
    b)       = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%F" Day
    b              -- DATE
    showPeriod (WeekPeriod b :: Day
    b)      = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%FW%V" Day
    b           -- STARTDATEWYEARWEEK
    showPeriod (MonthPeriod y :: Integer
    y m :: Month
    m)   = String -> Integer -> Month -> String
    forall r. PrintfType r => String -> r
    printf "%04d-%02d" Integer
    y Month
    m                           -- YYYY-MM
    showPeriod (QuarterPeriod y :: Integer
    y q :: Month
    q) = String -> Integer -> Month -> String
    forall r. PrintfType r => String -> r
    printf "%04dQ%d" Integer
    y Month
    q                             -- YYYYQN
    showPeriod (YearPeriod y :: Integer
    y)      = String -> Integer -> String
    forall r. PrintfType r => String -> r
    printf "%04d" Integer
    y                                  -- YYYY
    showPeriod (PeriodBetween b :: Day
    b e :: Day
    e) = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%F" Day
    b
                                     String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "..%F" (Integer -> Day -> Day
    addDays (-1) Day
    e) -- STARTDATE..INCLUSIVEENDDATE
    showPeriod (PeriodFrom b :: Day
    b)      = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "%F.." Day
    b                   -- STARTDATE..
    showPeriod (PeriodTo e :: Day
    e)        = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale "..%F" (Integer -> Day -> Day
    addDays (-1) Day
    e)    -- ..INCLUSIVEENDDATE
    showPeriod PeriodAll           = ".."

    -- | Like showPeriod, but if it's a month period show just
    -- the 3 letter month name abbreviation for the current locale.
    showPeriodMonthAbbrev :: Period -> String
    showPeriodMonthAbbrev (MonthPeriod _ m :: Month
    m)                           -- Jan
      | Month
    m Month -> Month -> Bool
    forall a. Ord a => a -> a -> Bool
    > 0 Bool -> Bool -> Bool
    && Month
    m Month -> Month -> Bool
    forall a. Ord a => a -> a -> Bool
    <= [(String, String)] -> Month
    forall (t :: * -> *) a. Foldable t => t a -> Month
    length [(String, String)]
    monthnames = (String, String) -> String
    forall a b. (a, b) -> b
    snd ((String, String) -> String) -> (String, String) -> String
    forall a b. (a -> b) -> a -> b
    $ [(String, String)]
    monthnames [(String, String)] -> Month -> (String, String)
    forall a. [a] -> Month -> a
    !! (Month
    mMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    -1)
      where monthnames :: [(String, String)]
    monthnames = TimeLocale -> [(String, String)]
    months TimeLocale
    defaultTimeLocale
    showPeriodMonthAbbrev p :: Period
    p = Period -> String
    showPeriod Period
    p

    periodStart :: Period -> Maybe Day
    periodStart :: Period -> Maybe Day
    periodStart p :: Period
    p = Maybe Day
    mb
      where
        DateSpan mb :: Maybe Day
    mb _ = Period -> DateSpan
    periodAsDateSpan Period
    p

    periodEnd :: Period -> Maybe Day
    periodEnd :: Period -> Maybe Day
    periodEnd p :: Period
    p = Maybe Day
    me
      where
        DateSpan _ me :: Maybe Day
    me = Period -> DateSpan
    periodAsDateSpan Period
    p

    -- | Move a standard period to the following period of same duration.
    -- Non-standard periods are unaffected.
    periodNext :: Period -> Period
    periodNext :: Period -> Period
    periodNext (DayPeriod b :: Day
    b) = Day -> Period
    DayPeriod (Integer -> Day -> Day
    addDays 1 Day
    b)
    periodNext (WeekPeriod b :: Day
    b) = Day -> Period
    WeekPeriod (Integer -> Day -> Day
    addDays 7 Day
    b)
    periodNext (MonthPeriod y :: Integer
    y 12) = Integer -> Month -> Period
    MonthPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1) 1
    periodNext (MonthPeriod y :: Integer
    y m :: Month
    m) = Integer -> Month -> Period
    MonthPeriod Integer
    y (Month
    mMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1)
    periodNext (QuarterPeriod y :: Integer
    y 4) = Integer -> Month -> Period
    QuarterPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1) 1
    periodNext (QuarterPeriod y :: Integer
    y q :: Month
    q) = Integer -> Month -> Period
    QuarterPeriod Integer
    y (Month
    qMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    +1)
    periodNext (YearPeriod y :: Integer
    y) = Integer -> Period
    YearPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +1)
    periodNext p :: Period
    p = Period
    p

    -- | Move a standard period to the preceding period of same duration.
    -- Non-standard periods are unaffected.
    periodPrevious :: Period -> Period
    periodPrevious :: Period -> Period
    periodPrevious (DayPeriod b :: Day
    b) = Day -> Period
    DayPeriod (Integer -> Day -> Day
    addDays (-1) Day
    b)
    periodPrevious (WeekPeriod b :: Day
    b) = Day -> Period
    WeekPeriod (Integer -> Day -> Day
    addDays (-7) Day
    b)
    periodPrevious (MonthPeriod y :: Integer
    y 1) = Integer -> Month -> Period
    MonthPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -1) 12
    periodPrevious (MonthPeriod y :: Integer
    y m :: Month
    m) = Integer -> Month -> Period
    MonthPeriod Integer
    y (Month
    mMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    -1)
    periodPrevious (QuarterPeriod y :: Integer
    y 1) = Integer -> Month -> Period
    QuarterPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -1) 4
    periodPrevious (QuarterPeriod y :: Integer
    y q :: Month
    q) = Integer -> Month -> Period
    QuarterPeriod Integer
    y (Month
    qMonth -> Month -> Month
    forall a. Num a => a -> a -> a
    -1)
    periodPrevious (YearPeriod y :: Integer
    y) = Integer -> Period
    YearPeriod (Integer
    yInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    -1)
    periodPrevious p :: Period
    p = Period
    p

    -- | Move a standard period to the following period of same duration, staying within enclosing dates.
    -- Non-standard periods are unaffected.
    periodNextIn :: DateSpan -> Period -> Period
    periodNextIn :: DateSpan -> Period -> Period
    periodNextIn (DateSpan _ (Just e :: Day
    e)) p :: Period
    p =
      case Maybe Day
    mb of
        Just b :: Day
    b -> if Day
    b Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    < Day
    e then Period
    p' else Period
    p
        _      -> Period
    p
      where
        p' :: Period
    p' = Period -> Period
    periodNext Period
    p
        mb :: Maybe Day
    mb = Period -> Maybe Day
    periodStart Period
    p'
    periodNextIn _ p :: Period
    p = Period -> Period
    periodNext Period
    p

    -- | Move a standard period to the preceding period of same duration, staying within enclosing dates.
    -- Non-standard periods are unaffected.
    periodPreviousIn :: DateSpan -> Period -> Period
    periodPreviousIn :: DateSpan -> Period -> Period
    periodPreviousIn (DateSpan (Just b :: Day
    b) _) p :: Period
    p =
      case Maybe Day
    me of
        Just e :: Day
    e -> if Day
    e Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    > Day
    b then Period
    p' else Period
    p
        _      -> Period
    p
      where
        p' :: Period
    p' = Period -> Period
    periodPrevious Period
    p
        me :: Maybe Day
    me = Period -> Maybe Day
    periodEnd Period
    p'
    periodPreviousIn _ p :: Period
    p = Period -> Period
    periodPrevious Period
    p

    -- | Move a standard period stepwise so that it encloses the given date.
    -- Non-standard periods are unaffected.
    periodMoveTo :: Day -> Period -> Period
    periodMoveTo :: Day -> Period -> Period
    periodMoveTo d :: Day
    d (DayPeriod _) = Day -> Period
    DayPeriod Day
    d
    periodMoveTo d :: Day
    d (WeekPeriod _) = Day -> Period
    WeekPeriod (Day -> Period) -> Day -> Period
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    mondayBefore Day
    d
    periodMoveTo d :: Day
    d (MonthPeriod _ _) = Integer -> Month -> Period
    MonthPeriod Integer
    y Month
    m where (y :: Integer
    y,m :: Month
    m,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    d
    periodMoveTo d :: Day
    d (QuarterPeriod _ _) = Integer -> Month -> Period
    QuarterPeriod Integer
    y Month
    q
      where
        (y :: Integer
    y,m :: Month
    m,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    d
        q :: Month
    q = Month -> Month
    forall a. Integral a => a -> a
    quarterContainingMonth Month
    m
    periodMoveTo d :: Day
    d (YearPeriod _) = Integer -> Period
    YearPeriod Integer
    y where (y :: Integer
    y,_,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    d
    periodMoveTo _ p :: Period
    p = Period
    p

    -- | Enlarge a standard period to the next larger enclosing standard period, if there is one.
    -- Eg, a day becomes the enclosing week.
    -- A week becomes whichever month the week's thursday falls into.
    -- A year becomes all (unlimited).
    -- Non-standard periods (arbitrary dates, or open-ended) are unaffected.
    periodGrow :: Period -> Period
    periodGrow :: Period -> Period
    periodGrow (DayPeriod b :: Day
    b) = Day -> Period
    WeekPeriod (Day -> Period) -> Day -> Period
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    mondayBefore Day
    b
    periodGrow (WeekPeriod b :: Day
    b) = Integer -> Month -> Period
    MonthPeriod Integer
    y Month
    m
      where (y :: Integer
    y,m :: Month
    m) = Day -> (Integer, Month)
    yearMonthContainingWeekStarting Day
    b
    periodGrow (MonthPeriod y :: Integer
    y m :: Month
    m) = Integer -> Month -> Period
    QuarterPeriod Integer
    y (Month -> Month
    forall a. Integral a => a -> a
    quarterContainingMonth Month
    m)
    periodGrow (QuarterPeriod y :: Integer
    y _) = Integer -> Period
    YearPeriod Integer
    y
    periodGrow (YearPeriod _) = Period
    PeriodAll
    periodGrow p :: Period
    p = Period
    p

    -- | Shrink a period to the next smaller standard period inside it,
    -- choosing the subperiod which contains today's date if possible,
    -- otherwise the first subperiod. It goes like this:
    -- unbounded periods and nonstandard periods (between two arbitrary dates) ->
    -- current year ->
    -- current quarter if it's in selected year, otherwise first quarter of selected year ->
    -- current month if it's in selected quarter, otherwise first month of selected quarter ->
    -- current week if it's in selected month, otherwise first week of selected month ->
    -- today if it's in selected week, otherwise first day of selected week,
    --  unless that's in previous month, in which case first day of month containing selected week.
    -- Shrinking a day has no effect.
    periodShrink :: Day -> Period -> Period
    periodShrink :: Day -> Period -> Period
    periodShrink _     p :: Period
    p@(DayPeriod _) = Period
    p
    periodShrink today :: Day
    today (WeekPeriod b :: Day
    b)
      | Day
    today Day -> Day -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Day
    b Bool -> Bool -> Bool
    && Day -> Day -> Integer
    diffDays Day
    today Day
    b Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    < 7 = Day -> Period
    DayPeriod Day
    today
      | Month
    m Month -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Month
    weekmonth                     = Day -> Period
    DayPeriod (Day -> Period) -> Day -> Period
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Month -> Day
    fromGregorian Integer
    weekyear Month
    weekmonth 1
      | Bool
    otherwise                          = Day -> Period
    DayPeriod Day
    b
      where
        (_,m :: Month
    m,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    b
        (weekyear :: Integer
    weekyear,weekmonth :: Month
    weekmonth) = Day -> (Integer, Month)
    yearMonthContainingWeekStarting Day
    b
    periodShrink today :: Day
    today (MonthPeriod y :: Integer
    y m :: Month
    m)
      | (Integer
    y',Month
    m') (Integer, Month) -> (Integer, Month) -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Integer
    y,Month
    m) = Day -> Period
    WeekPeriod (Day -> Period) -> Day -> Period
    forall a b. (a -> b) -> a -> b
    $ Day -> Day
    mondayBefore Day
    today
      | Bool
    otherwise        = Day -> Period
    WeekPeriod (Day -> Period) -> Day -> Period
    forall a b. (a -> b) -> a -> b
    $ Integer -> Month -> Day
    startOfFirstWeekInMonth Integer
    y Month
    m
      where (y' :: Integer
    y',m' :: Month
    m',_) = Day -> (Integer, Month, Month)
    toGregorian Day
    today
    periodShrink today :: Day
    today (QuarterPeriod y :: Integer
    y q :: Month
    q)
      | Month -> Month
    forall a. Integral a => a -> a
    quarterContainingMonth Month
    thismonth Month -> Month -> Bool
    forall a. Eq a => a -> a -> Bool
    == Month
    q = Integer -> Month -> Period
    MonthPeriod Integer
    y Month
    thismonth
      | Bool
    otherwise                             = Integer -> Month -> Period
    MonthPeriod Integer
    y (Month -> Month
    forall a. Num a => a -> a
    firstMonthOfQuarter Month
    q)
      where (_,thismonth :: Month
    thismonth,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    today
    periodShrink today :: Day
    today (YearPeriod y :: Integer
    y)
      | Integer
    y Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    == Integer
    thisyear = Integer -> Month -> Period
    QuarterPeriod Integer
    y Month
    thisquarter
      | Bool
    otherwise     = Integer -> Month -> Period
    QuarterPeriod Integer
    y 1
      where
        (thisyear :: Integer
    thisyear,thismonth :: Month
    thismonth,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    today
        thisquarter :: Month
    thisquarter = Month -> Month
    forall a. Integral a => a -> a
    quarterContainingMonth Month
    thismonth
    periodShrink today :: Day
    today _ = Integer -> Period
    YearPeriod Integer
    y
      where (y :: Integer
    y,_,_) = Day -> (Integer, Month, Month)
    toGregorian Day
    today

    mondayBefore :: Day -> Day
    mondayBefore d :: Day
    d = Integer -> Day -> Day
    addDays (1 Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    - Month -> Integer
    forall a. Integral a => a -> Integer
    toInteger Month
    wd) Day
    d
      where
        (_,_,wd :: Month
    wd) = Day -> (Integer, Month, Month)
    toWeekDate Day
    d

    yearMonthContainingWeekStarting :: Day -> (Integer, Month)
    yearMonthContainingWeekStarting weekstart :: Day
    weekstart = (Integer
    y,Month
    m)
      where
        thu :: Day
    thu = Integer -> Day -> Day
    addDays 3 Day
    weekstart
        (y :: Integer
    y,yd :: Month
    yd) = Day -> (Integer, Month)
    toOrdinalDate Day
    thu
        (m :: Month
    m,_) = Bool -> Month -> (Month, Month)
    dayOfYearToMonthAndDay (Integer -> Bool
    isLeapYear Integer
    y) Month
    yd

    quarterContainingMonth :: a -> a
    quarterContainingMonth m :: a
    m = (a
    ma -> a -> a
    forall a. Num a => a -> a -> a
    -1) a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` 3 a -> a -> a
    forall a. Num a => a -> a -> a
    + 1

    firstMonthOfQuarter :: a -> a
    firstMonthOfQuarter q :: a
    q = (a
    qa -> a -> a
    forall a. Num a => a -> a -> a
    -1)a -> a -> a
    forall a. Num a => a -> a -> a
    *3 a -> a -> a
    forall a. Num a => a -> a -> a
    + 1

    startOfFirstWeekInMonth :: Integer -> Month -> Day
    startOfFirstWeekInMonth y :: Integer
    y m :: Month
    m
      | Month
    monthstartday Month -> Month -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 4 = Day
    mon
      | Bool
    otherwise          = Integer -> Day -> Day
    addDays 7 Day
    mon  -- month starts with a fri/sat/sun
      where
        monthstart :: Day
    monthstart = Integer -> Month -> Month -> Day
    fromGregorian Integer
    y Month
    m 1
        mon :: Day
    mon = Day -> Day
    mondayBefore Day
    monthstart
        (_,_,monthstartday :: Month
    monthstartday) = Day -> (Integer, Month, Month)
    toWeekDate Day
    monthstart