1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
{-# LANGUAGE Safe #-}
module Data.Time.Calendar.Week (
-- * 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 = ()
-- | \"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
-- | @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 a b = mod' (fromEnum a - fromEnum b) 7
-- | The first day-of-week on or after some day
firstDayOfWeekOnAfter :: DayOfWeek -> Day -> Day
firstDayOfWeekOnAfter dw d = addDays (toInteger $ dayOfWeekDiff dw $ dayOfWeek d) d
-- | Returns a week containing the given 'Day' where the first day is the
-- 'DayOfWeek' specified.
--
-- Examples:
--
-- >>> weekAllDays Sunday (YearMonthDay 2022 02 21)
-- [YearMonthDay 2022 2 20 .. YearMonthDay 2022 2 26]
--
-- >>> weekAllDays Monday (YearMonthDay 2022 02 21)
-- [YearMonthDay 2022 2 21 .. YearMonthDay 2022 2 27]
--
-- >>> weekAllDays Tuesday (YearMonthDay 2022 02 21)
-- [YearMonthDay 2022 2 15 .. YearMonthDay 2022 2 21]
--
-- @since 1.12.2
weekAllDays :: DayOfWeek -> Day -> [Day]
weekAllDays firstDay day = [weekFirstDay firstDay day .. weekLastDay firstDay day]
-- | Returns the first day of a week containing the given 'Day'.
--
-- Examples:
--
-- >>> weekFirstDay Sunday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 20
--
-- >>> weekFirstDay Monday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 21
--
-- >>> weekFirstDay Tuesday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 15
--
-- @since 1.12.2
weekFirstDay :: DayOfWeek -> Day -> Day
weekFirstDay firstDay day = addDays (negate 7) $ firstDayOfWeekOnAfter firstDay $ succ day
-- | Returns the last day of a week containing the given 'Day'.
--
-- Examples:
--
-- >>> weekLastDay Sunday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 26
--
-- >>> weekLastDay Monday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 27
--
-- >>> weekLastDay Tuesday (YearMonthDay 2022 02 21)
-- YearMonthDay 2022 2 21
--
-- @since 1.12.2
weekLastDay :: DayOfWeek -> Day -> Day
weekLastDay firstDay day = pred $ firstDayOfWeekOnAfter firstDay $ succ day
|
