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