1module Test.Calendar.ConvertBack(convertBack) where 2 3import Data.Time.Calendar.OrdinalDate 4import Data.Time.Calendar.Julian 5import Data.Time.Calendar.WeekDate 6import Data.Time.Calendar 7import Test.Tasty 8import Test.Tasty.HUnit 9 10checkDay :: (Show t) => (Day -> t) -> (t -> Day) -> (t -> Maybe Day) -> Day -> String 11checkDay encodeDay decodeDay decodeDayValid day = let 12 st = encodeDay day 13 day' = decodeDay st 14 mday' = decodeDayValid st 15 16 a = if day /= day' 17 then unwords [ show day, "-> " 18 , show st, "-> " 19 , show day' 20 , "(diff", show (diffDays day' day) ++ ")" ] 21 else "" 22 23 b = if Just day /= mday' 24 then unwords [show day, "->", show st, "->", show mday'] 25 else "" 26 in a ++ b 27 28checkers :: [Day -> String] 29checkers 30 = [ checkDay toOrdinalDate (\(y,d) -> fromOrdinalDate y d) (\(y,d) -> fromOrdinalDateValid y d) 31 , checkDay toWeekDate (\(y,w,d) -> fromWeekDate y w d) (\(y,w,d) -> fromWeekDateValid y w d) 32 , checkDay toGregorian (\(y,m,d) -> fromGregorian y m d) (\(y,m,d) -> fromGregorianValid y m d) 33 , checkDay toJulian (\(y,m,d) -> fromJulian y m d) (\(y,m,d) -> fromJulianValid y m d) ] 34 35days :: [Day] 36days = [ModifiedJulianDay 50000 .. ModifiedJulianDay 50200] ++ 37 (fmap (\year -> (fromGregorian year 1 4)) [1980..2000]) 38 39convertBack :: TestTree 40convertBack = testCase "convertBack" $ 41 assertEqual "" "" $ concatMap (\ch -> concatMap ch days) checkers 42