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