1module Test.Calendar.ClipDates(clipDates) where
2
3import Data.Time.Calendar.OrdinalDate
4import Data.Time.Calendar.WeekDate
5import Data.Time.Calendar
6import Test.Tasty
7import Test.Tasty.HUnit
8import Test.Calendar.ClipDatesRef
9
10yearAndDay :: (Integer,Int) -> String
11yearAndDay (y,d) = (show y) ++ "-" ++ (show d) ++ " = " ++ (showOrdinalDate (fromOrdinalDate y d))
12
13gregorian :: (Integer,Int,Int) -> String
14gregorian (y,m,d) = (show y) ++ "-" ++ (show m) ++ "-" ++ (show d) ++ " = " ++ (showGregorian (fromGregorian y m d))
15
16iSOWeekDay :: (Integer,Int,Int) -> String
17iSOWeekDay (y,w,d) = (show y) ++ "-W" ++ (show w) ++ "-" ++ (show d) ++ " = " ++ (showWeekDate (fromWeekDate y w d))
18
19--
20
21tupleUp2 :: [a] -> [b] -> [(a, b)]
22tupleUp2 l1 l2 = concatMap (\e -> map (e,) l2) l1
23
24tupleUp3 :: [a] -> [b] -> [c] -> [(a, b, c)]
25tupleUp3 l1 l2 l3
26  = let ts = tupleUp2 l2 l3
27    in concatMap (\e -> map (\(f, g) -> (e, f, g)) ts) l1
28
29--
30
31clipDates :: TestTree
32clipDates = testCase "clipDates" $
33    let
34        yad  = unlines $ map yearAndDay $
35            tupleUp2 [1968,1969,1971] [-4,0,1,200,364,365,366,367,700]
36
37
38        greg = unlines $ map gregorian $
39            tupleUp3 [1968,1969,1971] [-20,-1,0,1,2,12,13,17] [-7,-1,0,1,2,27,28,29,30,31,32,40]
40
41        iso  = unlines $ map iSOWeekDay $
42            tupleUp3 [1968,1969,2004] [-20,-1,0,1,20,51,52,53,54] [-2,-1,0,1,4,6,7,8,9]
43
44    in assertEqual "" clipDatesRef $
45        concat [ "YearAndDay\n", yad, "Gregorian\n", greg, "ISOWeekDay\n", iso ]
46