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