Week.hs

module Test.Calendar.Week (
    testWeek,
) where

import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate
import Test.Arbitrary ()
import Test.Tasty
import Test.Tasty.HUnit
import Test.TestUtil

testDay :: TestTree
testDay =
    nameTest "day" $ do
        let day = fromGregorian 2018 1 9
        assertEqual "" (ModifiedJulianDay 58127) day
        assertEqual "" (2018, 2, 2) $ toWeekDate day
        assertEqual "" Tuesday $ dayOfWeek day

allDaysOfWeek :: [DayOfWeek]
allDaysOfWeek = [Monday, Tuesday, Wednesday, Thursday, Friday, Saturday, Sunday]

testAllDays :: String -> (DayOfWeek -> IO ()) -> TestTree
testAllDays name f = nameTest name $ fmap (\wd -> nameTest (show wd) $ f wd) allDaysOfWeek

testSucc :: TestTree
testSucc = testAllDays "succ" $ \wd -> assertEqual "" (toEnum $ succ $ fromEnum wd) $ succ wd

testPred :: TestTree
testPred = testAllDays "pred" $ \wd -> assertEqual "" (toEnum $ pred $ fromEnum wd) $ pred wd

testSequences :: TestTree
testSequences =
    nameTest
        "sequence"
        [ nameTest "[Monday .. Sunday]" $ assertEqual "" allDaysOfWeek [Monday .. Sunday]
        , nameTest "[Wednesday .. Wednesday]" $ assertEqual "" [Wednesday] [Wednesday .. Wednesday]
        , nameTest "[Sunday .. Saturday]" $
            assertEqual "" [Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday] [Sunday .. Saturday]
        , nameTest "[Thursday .. Wednesday]" $
            assertEqual "" [Thursday, Friday, Saturday, Sunday, Monday, Tuesday, Wednesday] [Thursday .. Wednesday]
        , nameTest "[Tuesday ..]" $
            assertEqual
                ""
                [ Tuesday
                , Wednesday
                , Thursday
                , Friday
                , Saturday
                , Sunday
                , Monday
                , Tuesday
                , Wednesday
                , Thursday
                , Friday
                , Saturday
                , Sunday
                , Monday
                , Tuesday
                ]
                $ take 15 [Tuesday ..]
        , nameTest "[Wednesday, Tuesday ..]" $
            assertEqual
                ""
                [ Wednesday
                , Tuesday
                , Monday
                , Sunday
                , Saturday
                , Friday
                , Thursday
                , Wednesday
                , Tuesday
                , Monday
                , Sunday
                , Saturday
                , Friday
                , Thursday
                , Wednesday
                ]
                $ take 15 [Wednesday, Tuesday ..]
        , nameTest "[Sunday, Friday ..]" $
            assertEqual "" [Sunday, Friday, Wednesday, Monday, Saturday, Thursday, Tuesday, Sunday] $
                take 8 [Sunday, Friday ..]
        , nameTest "[Monday,Sunday .. Tuesday]" $
            assertEqual "" [Monday, Sunday, Saturday, Friday, Thursday, Wednesday, Tuesday] [Monday, Sunday .. Tuesday]
        , nameTest "[Thursday, Saturday .. Tuesday]" $
            assertEqual "" [Thursday, Saturday, Monday, Wednesday, Friday, Sunday, Tuesday] [Thursday, Saturday .. Tuesday]
        ]

testReadShow :: TestTree
testReadShow = testAllDays "read show" $ \wd -> assertEqual "" wd $ read $ show wd

prop_firstDayOfWeekOnAfter_onAfter :: DayOfWeek -> Day -> Bool
prop_firstDayOfWeekOnAfter_onAfter dw d = firstDayOfWeekOnAfter dw d >= d

prop_firstDayOfWeekOnAfter_Day :: DayOfWeek -> Day -> Bool
prop_firstDayOfWeekOnAfter_Day dw d = dayOfWeek (firstDayOfWeekOnAfter dw d) == dw

prop_toFromWeekCalendar :: FirstWeekType -> DayOfWeek -> Day -> Bool
prop_toFromWeekCalendar wt ws d =
    let (y, wy, dw) = toWeekCalendar wt ws d
     in fromWeekCalendar wt ws y wy dw == d

prop_weekChanges :: FirstWeekType -> DayOfWeek -> Day -> Bool
prop_weekChanges wt ws d =
    let (_, wy0, _) = toWeekCalendar wt ws d
        (_, wy1, dw) = toWeekCalendar wt ws $ succ d
     in if dw == ws then wy0 /= wy1 else wy0 == wy1

prop_weekYearWholeStart :: DayOfWeek -> Year -> Bool
prop_weekYearWholeStart ws y =
    let d = fromWeekCalendar FirstWholeWeek ws y 1 ws
        (y', dy) = toOrdinalDate d
     in y == y' && dy >= 1 && dy <= 7

prop_weekYearMostStart :: DayOfWeek -> Year -> Bool
prop_weekYearMostStart ws y =
    let d = fromWeekCalendar FirstMostWeek ws y 2 ws
        (y', dy) = toOrdinalDate d
     in y == y' && dy >= 5 && dy <= 11

testDiff :: TestTree
testDiff =
    nameTest
        "diff"
        [ nameTest "Friday - Tuesday" $ assertEqual "" 3 $ dayOfWeekDiff Friday Tuesday
        , nameTest "Tuesday - Friday" $ assertEqual "" 4 $ dayOfWeekDiff Tuesday Friday
        , nameTest "firstDayOfWeekOnAfter_onAfter" prop_firstDayOfWeekOnAfter_onAfter
        , nameTest "firstDayOfWeekOnAfter_Day" prop_firstDayOfWeekOnAfter_Day
        , nameTest "toFromWeekCalendar" prop_toFromWeekCalendar
        , nameTest "weekChanges" prop_weekChanges
        , nameTest "weekYearWholeStart" prop_weekYearWholeStart
        , nameTest "weekYearMostStart" prop_weekYearMostStart
        ]

testWeek :: TestTree
testWeek = nameTest "Week" [testDay, testSucc, testPred, testSequences, testReadShow, testDiff]