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