1module Test.Calendar.Week
2    ( testWeek
3    ) where
4
5import Data.Time.Calendar.Compat
6import Data.Time.Calendar.OrdinalDate.Compat
7import Data.Time.Calendar.WeekDate.Compat
8import Test.TestUtil
9import Test.Tasty
10import Test.Tasty.HUnit
11import Test.Arbitrary ()
12
13testDay :: TestTree
14testDay =
15    nameTest "day" $ do
16        let day = fromGregorian 2018 1 9
17        assertEqual "" (ModifiedJulianDay 58127) day
18        assertEqual "" (2018, 2, 2) $ toWeekDate day
19        assertEqual "" Tuesday $ dayOfWeek day
20
21allDaysOfWeek :: [DayOfWeek]
22allDaysOfWeek = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]
23
24testAllDays :: String -> (DayOfWeek -> IO ()) -> TestTree
25testAllDays name f = nameTest name $ fmap (\wd -> nameTest (show wd) $ f wd) allDaysOfWeek
26
27testSucc :: TestTree
28testSucc = testAllDays "succ" $ \wd -> assertEqual "" (toEnum $ succ $ fromEnum wd) $ succ wd
29
30testPred :: TestTree
31testPred = testAllDays "pred" $ \wd -> assertEqual "" (toEnum $ pred $ fromEnum wd) $ pred wd
32
33testSequences :: TestTree
34testSequences =
35    nameTest
36        "sequence"
37        [ nameTest "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday]
38        , nameTest "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday]
39        , nameTest "[Sunday .. Saturday]" $
40          assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday]
41        , nameTest "[Thursday .. Wednesday]" $
42          assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday]
43        , nameTest "[Tuesday ..]" $
44          assertEqual
45              ""
46              [ Tuesday
47              , Wednesday
48              , Thursday
49              , Friday
50              , Saturday
51              , Sunday
52              , Monday
53              , Tuesday
54              , Wednesday
55              , Thursday
56              , Friday
57              , Saturday
58              , Sunday
59              , Monday
60              , Tuesday
61              ] $
62          take 15 [Tuesday ..]
63        , nameTest "[Wednesday, Tuesday ..]" $
64          assertEqual
65              ""
66              [ Wednesday
67              , Tuesday
68              , Monday
69              , Sunday
70              , Saturday
71              , Friday
72              , Thursday
73              , Wednesday
74              , Tuesday
75              , Monday
76              , Sunday
77              , Saturday
78              , Friday
79              , Thursday
80              , Wednesday
81              ] $
82          take 15 [Wednesday,Tuesday ..]
83        , nameTest "[Sunday, Friday ..]" $
84          assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $
85          take 8 [Sunday,Friday ..]
86        , nameTest "[Monday,Sunday .. Tuesday]" $
87          assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday,Sunday .. Tuesday]
88        , nameTest "[Thursday, Saturday .. Tuesday]" $
89          assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday,Saturday .. Tuesday]
90        ]
91
92testReadShow :: TestTree
93testReadShow = testAllDays "read show" $ \wd -> assertEqual "" wd $ read $ show wd
94
95prop_firstDayOfWeekOnAfter_onAfter :: DayOfWeek -> Day -> Bool
96prop_firstDayOfWeekOnAfter_onAfter dw d = firstDayOfWeekOnAfter dw d >= d
97
98prop_firstDayOfWeekOnAfter_Day :: DayOfWeek -> Day -> Bool
99prop_firstDayOfWeekOnAfter_Day dw d = dayOfWeek (firstDayOfWeekOnAfter dw d) == dw
100
101prop_toFromWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> Bool
102prop_toFromWeekCalendar wt ws d = let
103    (y,wy,dw) = toWeekCalendar wt ws d
104    in fromWeekCalendar wt ws y wy dw == d
105
106prop_weekChanges :: FirstWeekType -> DayOfWeek -> Day -> Bool
107prop_weekChanges wt ws d = let
108    (_,wy0,_) = toWeekCalendar wt ws d
109    (_,wy1,dw) = toWeekCalendar wt ws $ succ d
110    in if dw == ws then wy0 /= wy1 else wy0 == wy1
111
112prop_weekYearWholeStart :: DayOfWeek -> Year -> Bool
113prop_weekYearWholeStart ws y = let
114    d = fromWeekCalendar FirstWholeWeek ws y 1 ws
115    (y',dy) = toOrdinalDate d
116    in y == y' && dy >= 1 && dy <= 7
117
118prop_weekYearMostStart :: DayOfWeek -> Year -> Bool
119prop_weekYearMostStart ws y = let
120    d = fromWeekCalendar FirstMostWeek ws y 2 ws
121    (y',dy) = toOrdinalDate d
122    in y == y' && dy >= 5 && dy <= 11
123
124testDiff :: TestTree
125testDiff = nameTest "diff"
126    [
127        nameTest "Friday - Tuesday" $ assertEqual "" 3 $ dayOfWeekDiff Friday Tuesday,
128        nameTest "Tuesday - Friday" $ assertEqual "" 4 $ dayOfWeekDiff Tuesday Friday,
129        nameTest "firstDayOfWeekOnAfter_onAfter" prop_firstDayOfWeekOnAfter_onAfter,
130        nameTest "firstDayOfWeekOnAfter_Day" prop_firstDayOfWeekOnAfter_Day,
131        nameTest "toFromWeekCalendar" prop_toFromWeekCalendar,
132        nameTest "weekChanges" prop_weekChanges,
133        nameTest "weekYearWholeStart" prop_weekYearWholeStart,
134        nameTest "weekYearMostStart" prop_weekYearMostStart
135    ]
136
137testWeek :: TestTree
138testWeek = nameTest "Week" [testDay, testSucc, testPred, testSequences, testReadShow, testDiff]
139