DayPeriod.hs

module Test.Calendar.DayPeriod (
    testHasDays,
) where

import Data.Time.Calendar
import Data.Time.Calendar.Month
import Data.Time.Calendar.Quarter
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck

newtype WDay = MkWDay Day
    deriving (Eq, Show)

instance Arbitrary WDay where
    arbitrary = do
        (MkWYear y) <- arbitrary
        (MkWMonthOfYear m) <- arbitrary
        (MkWDayOfMonth d) <- arbitrary
        pure $ MkWDay $ YearMonthDay y m d

newtype WYear = MkWYear Year
    deriving (Eq, Show)

instance Arbitrary WYear where
    arbitrary = fmap MkWYear $ choose (-1000, 3000)

newtype WMonthOfYear = MkWMonthOfYear MonthOfYear
    deriving (Eq, Show)

instance Arbitrary WMonthOfYear where
    arbitrary = fmap MkWMonthOfYear $ choose (-5, 17)

newtype WMonth = MkWMonth Month
    deriving (Eq, Show)

instance Arbitrary WMonth where
    arbitrary = do
        (MkWYear y) <- arbitrary
        (MkWMonthOfYear m) <- arbitrary
        pure $ MkWMonth $ YearMonth y m

newtype WDayOfMonth = MkWDayOfMonth DayOfMonth
    deriving (Eq, Show)

instance Arbitrary WDayOfMonth where
    arbitrary = fmap MkWDayOfMonth $ choose (-5, 35)

testHasDays :: TestTree
testHasDays =
    testGroup
        "DayPeriod"
        [ testGroup "Day" testDay
        , testGroup "Month" testMonth
        , testGroup "Quarter" testQuarter
        , testGroup "Year" testYear
        ]

testDay :: [TestTree]
testDay =
    [ testProperty "periodFirstDay" $ \(MkWDay d) ->
        periodFirstDay d == d
    , testProperty "periodLastDay" $ \(MkWDay d) ->
        periodLastDay d == d
    ]

testMonth :: [TestTree]
testMonth =
    [ testProperty "periodFirstDay" $ \(MkWMonth my@(YearMonth y m)) ->
        periodFirstDay my == YearMonthDay y m 1
    , testGroup
        "periodLastDay"
        [ testCase "leap year" $
            periodLastDay (YearMonth 2024 February) @?= YearMonthDay 2024 February 29
        , testCase "regular year" $
            periodLastDay (YearMonth 2023 February) @?= YearMonthDay 2023 February 28
        ]
    ]

testQuarter :: [TestTree]
testQuarter =
    [ testGroup
        "periodFirstDay"
        [ testProperty "Q1" $ \(MkWYear y) ->
            periodFirstDay (YearQuarter y Q1) == YearMonthDay y January 1
        , testProperty "Q2" $ \(MkWYear y) ->
            periodFirstDay (YearQuarter y Q2) == YearMonthDay y April 1
        , testProperty "Q3" $ \(MkWYear y) ->
            periodFirstDay (YearQuarter y Q3) == YearMonthDay y July 1
        , testProperty "Q4" $ \(MkWYear y) ->
            periodFirstDay (YearQuarter y Q4) == YearMonthDay y October 1
        ]
    , testGroup
        "periodLastDay"
        [ testProperty "Q1" $ \(MkWYear y) ->
            periodLastDay (YearQuarter y Q1) == YearMonthDay y March 31
        , testProperty "Q2" $ \(MkWYear y) ->
            periodLastDay (YearQuarter y Q2) == YearMonthDay y June 30
        , testProperty "Q3" $ \(MkWYear y) ->
            periodLastDay (YearQuarter y Q3) == YearMonthDay y September 30
        , testProperty "Q4" $ \(MkWYear y) ->
            periodLastDay (YearQuarter y Q4) == YearMonthDay y December 31
        ]
    ]

testYear :: [TestTree]
testYear =
    [ testProperty "periodFirstDay" $ \(MkWYear y) ->
        periodFirstDay y == YearMonthDay y January 1
    , testProperty "periodLastDay" $ \(MkWYear y) ->
        periodLastDay y == YearMonthDay y December 31
    ]