{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Data.Time.Calendar.DayPeriod (
DayPeriod (..),
periodAllDays,
periodLength,
periodFromDay,
periodToDay,
periodToDayClip,
periodToDayValid,
) where
#if MIN_VERSION_time(1,15,0)
import Data.Time.Calendar
#elif MIN_VERSION_time(1,12,1)
import Data.Time.Calendar
import Data.Time.Calendar.Private
periodToDayClip :: DayPeriod p => p -> Int -> Day
periodToDayClip p i = periodToDay p $ clip 1 (periodLength p) i
#else
import Data.Time.Calendar
import Data.Time.Calendar.Private
#if MIN_VERSION_time(1,11,0)
import Data.Time.Calendar.Month
import Data.Time.Calendar.Quarter
#endif
class Ord p => DayPeriod p where
periodFirstDay :: p -> Day
periodLastDay :: p -> Day
dayPeriod :: Day -> p
periodAllDays :: DayPeriod p => p -> [Day]
periodAllDays p = [periodFirstDay p .. periodLastDay p]
periodLength :: DayPeriod p => p -> Int
periodLength p = succ $ fromInteger $ diffDays (periodLastDay p) (periodFirstDay p)
periodFromDay :: DayPeriod p => Day -> (p, Int)
periodFromDay d =
let
p = dayPeriod d
dt = succ $ fromInteger $ diffDays d $ periodFirstDay p
in
(p, dt)
periodToDay :: DayPeriod p => p -> Int -> Day
periodToDay p i = addDays (toInteger $ pred i) $ periodFirstDay p
periodToDayClip :: DayPeriod p => p -> Int -> Day
periodToDayClip p i = periodToDay p $ clip 1 (periodLength p) i
periodToDayValid :: DayPeriod p => p -> Int -> Maybe Day
periodToDayValid p i =
let
d = periodToDay p i
in
if fst (periodFromDay d) == p then Just d else Nothing
instance DayPeriod Day where
periodFirstDay = id
periodLastDay = id
dayPeriod = id
instance DayPeriod Integer where
periodFirstDay y = fromGregorian y 1 1
periodLastDay y = fromGregorian y 12 31
dayPeriod (toGregorian -> (y,_,_)) = y
#if MIN_VERSION_time(1,11,0)
instance DayPeriod Month where
periodFirstDay (YearMonth y m) = YearMonthDay y m 1
periodLastDay (YearMonth y m) = YearMonthDay y m 31
dayPeriod (YearMonthDay y my _) = YearMonth y my
instance DayPeriod Quarter where
periodFirstDay (YearQuarter y q) =
case q of
Q1 -> periodFirstDay $ YearMonth y 1
Q2 -> periodFirstDay $ YearMonth y 4
Q3 -> periodFirstDay $ YearMonth y 7
Q4 -> periodFirstDay $ YearMonth y 10
periodLastDay (YearQuarter y q) =
case q of
Q1 -> periodLastDay $ YearMonth y 3
Q2 -> periodLastDay $ YearMonth y 6
Q3 -> periodLastDay $ YearMonth y 9
Q4 -> periodLastDay $ YearMonth y 12
dayPeriod (MonthDay m _) = monthQuarter m
#endif
#endif