module Data.Time.Calendar.Week (
DayOfWeek (..),
dayOfWeek,
dayOfWeekDiff,
firstDayOfWeekOnAfter,
weekAllDays,
weekFirstDay,
weekLastDay,
) where
import Control.DeepSeq
import Data.Data
import Data.Fixed
import Data.Ix
import Data.Time.Calendar.Days
data DayOfWeek
= Monday
| Tuesday
| Wednesday
| Thursday
| Friday
| Saturday
| Sunday
deriving (Eq, Show, Read, Data, Typeable, Ord, Ix)
instance NFData DayOfWeek where
rnf Monday = ()
rnf Tuesday = ()
rnf Wednesday = ()
rnf Thursday = ()
rnf Friday = ()
rnf Saturday = ()
rnf Sunday = ()
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
dayOfWeekDiff :: DayOfWeek -> DayOfWeek -> Int
dayOfWeekDiff a b = mod' (fromEnum a fromEnum b) 7
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d
weekAllDays :: DayOfWeek -> Day -> [Day]
weekAllDays firstDay day = [weekFirstDay firstDay day .. weekLastDay firstDay day]
weekFirstDay :: DayOfWeek -> Day -> Day
weekFirstDay firstDay day = addDays (negate 7) $ firstDayOfWeekOnAfter firstDay $ succ day
weekLastDay :: DayOfWeek -> Day -> Day
weekLastDay firstDay day = pred $ firstDayOfWeekOnAfter firstDay $ succ day