ClipDates.hs

module Test.Calendar.ClipDates (
    clipDates,
) where

import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
import Data.Time.Calendar.WeekDate
import Test.Calendar.ClipDatesRef
import Test.Tasty
import Test.Tasty.HUnit

yearAndDay :: (Integer, Int) -> String
yearAndDay (y, d) = (show y) ++ "-" ++ (show d) ++ " = " ++ (showOrdinalDate (fromOrdinalDate y d))

gregorian :: (Integer, Int, Int) -> String
gregorian (y, m, d) = (show y) ++ "-" ++ (show m) ++ "-" ++ (show d) ++ " = " ++ (showGregorian (fromGregorian y m d))

iSOWeekDay :: (Integer, Int, Int) -> String
iSOWeekDay (y, w, d) = (show y) ++ "-W" ++ (show w) ++ "-" ++ (show d) ++ " = " ++ (showWeekDate (fromWeekDate y w d))

--
tupleUp2 :: [a] -> [b] -> [(a, b)]
tupleUp2 l1 l2 = concatMap (\e -> map (e,) l2) l1

tupleUp3 :: [a] -> [b] -> [c] -> [(a, b, c)]
tupleUp3 l1 l2 l3 =
    let
        ts = tupleUp2 l2 l3
    in
        concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1

testPairs :: String -> [String] -> [String] -> TestTree
testPairs name expected found = testGroup name $ fmap (\(e, f) -> testCase e $ assertEqual "" e f) $ zip expected found

--
clipDates :: TestTree
clipDates =
    testGroup
        "clipDates"
        [ testPairs "YearAndDay" clipDatesYearAndDayRef $ map yearAndDay $ tupleUp2 [1968, 1969, 1971] [-4, 0, 1, 200, 364, 365, 366, 367, 700]
        , testPairs "Gregorian" clipDatesGregorianDayRef $
            map gregorian $
                tupleUp3 [1968, 1969, 1971] [-20, -1, 0, 1, 2, 12, 13, 17] [-7, -1, 0, 1, 2, 27, 28, 29, 30, 31, 32, 40]
        , testPairs "ISOWeekDay" clipDatesISOWeekDayRef $
            map iSOWeekDay $
                tupleUp3 [1968, 1969, 2004] [-20, -1, 0, 1, 20, 51, 52, 53, 54] [-2, -1, 0, 1, 4, 6, 7, 8, 9]
        ]