1module Test.Calendar.Week
2    ( testWeek
3    ) where
4
5import Data.Time.Calendar.Compat
6import Data.Time.Calendar.WeekDate.Compat
7
8import Test.Tasty
9import Test.Tasty.HUnit
10
11testDay :: TestTree
12testDay =
13    testCase "day" $ do
14        let day = fromGregorian 2018 1 9
15        assertEqual "" (ModifiedJulianDay 58127) day
16        assertEqual "" (2018, 2, 2) $ toWeekDate day
17        assertEqual "" Tuesday $ dayOfWeek day
18
19allDaysOfWeek :: [DayOfWeek]
20allDaysOfWeek = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]
21
22testAllDays :: String -> (DayOfWeek -> IO ()) -> TestTree
23testAllDays name f = testGroup name $ fmap (\wd -> testCase (show wd) $ f wd) allDaysOfWeek
24
25testSucc :: TestTree
26testSucc = testAllDays "succ" $ \wd -> assertEqual "" (toEnum $ succ $ fromEnum wd) $ succ wd
27
28testPred :: TestTree
29testPred = testAllDays "pred" $ \wd -> assertEqual "" (toEnum $ pred $ fromEnum wd) $ pred wd
30
31testSequences :: TestTree
32testSequences =
33    testGroup
34        "sequence"
35        [ testCase "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday]
36        , testCase "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday]
37        , testCase "[Sunday .. Saturday]" $
38          assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday]
39        , testCase "[Thursday .. Wednesday]" $
40          assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday]
41        , testCase "[Tuesday ..]" $
42          assertEqual
43              ""
44              [ Tuesday
45              , Wednesday
46              , Thursday
47              , Friday
48              , Saturday
49              , Sunday
50              , Monday
51              , Tuesday
52              , Wednesday
53              , Thursday
54              , Friday
55              , Saturday
56              , Sunday
57              , Monday
58              , Tuesday
59              ] $
60          take 15 [Tuesday ..]
61        , testCase "[Wednesday, Tuesday ..]" $
62          assertEqual
63              ""
64              [ Wednesday
65              , Tuesday
66              , Monday
67              , Sunday
68              , Saturday
69              , Friday
70              , Thursday
71              , Wednesday
72              , Tuesday
73              , Monday
74              , Sunday
75              , Saturday
76              , Friday
77              , Thursday
78              , Wednesday
79              ] $
80          take 15 [Wednesday,Tuesday ..]
81        , testCase "[Sunday, Friday ..]" $
82          assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $
83          take 8 [Sunday,Friday ..]
84        , testCase "[Monday,Sunday .. Tuesday]" $
85          assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday,Sunday .. Tuesday]
86        , testCase "[Thursday, Saturday .. Tuesday]" $
87          assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday,Saturday .. Tuesday]
88        ]
89
90testReadShow :: TestTree
91testReadShow = testAllDays "read show" $ \wd -> assertEqual "" wd $ read $ show wd
92
93testWeek :: TestTree
94testWeek = testGroup "Week" [testDay, testSucc, testPred, testSequences, testReadShow]
95