[commit: packages/time] master, wip/travis: fix decodeDay in ISOWeek, with improved ConvertBack test (899a104)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/time

On branches: master,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/899a1047cf6940d1378dcc6efac9b987152ddae9

>---------------------------------------------------------------

commit 899a1047cf6940d1378dcc6efac9b987152ddae9
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sun May 8 21:37:46 2005 -0700

    fix decodeDay in ISOWeek, with improved ConvertBack test
    
    darcs-hash:20050509043746-ac6dd-de2745bf5dcba79c8a2e1600b9e9d2a4564d9ae7


>---------------------------------------------------------------

899a1047cf6940d1378dcc6efac9b987152ddae9
 System/Time/Calendar/ISOWeek.hs |  5 +++--
 test/ConvertBack.hs             | 25 ++++++++++++++++++-------
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/System/Time/Calendar/ISOWeek.hs b/System/Time/Calendar/ISOWeek.hs
index 9126ac9..e6412e4 100644
--- a/System/Time/Calendar/ISOWeek.hs
+++ b/System/Time/Calendar/ISOWeek.hs
@@ -21,7 +21,7 @@ instance DayEncoding ISOWeek where
 		(YearDay y0 yd) = encodeDay mjd
 		d = mjd + 2
 		foo :: Integer -> Integer
-		foo y = bar (decodeDay (YearDay y 4) + 2)
+		foo y = bar (decodeDay (YearDay y 6))
 		bar k = (div d 7) - (div k 7)
 		w0 = bar (d - (toInteger yd) + 4)
 		(y1,w1) = if w0 == -1
@@ -32,5 +32,6 @@ instance DayEncoding ISOWeek where
 				else (y0,w0)
 			else (y0,w0)
 
-	decodeDay (ISOWeek _ _ _) = undefined -- WRONG
+	decodeDay (ISOWeek y w d) = k - (mod k 7) + (toInteger ((w * 7) + d)) - 10 where
+		k = decodeDay (YearDay y 6)
 	maybeDecodeDay = Just . decodeDay -- WRONG
diff --git a/test/ConvertBack.hs b/test/ConvertBack.hs
index da3bf3e..5b4968d 100644
--- a/test/ConvertBack.hs
+++ b/test/ConvertBack.hs
@@ -5,16 +5,27 @@ module Main where
 import System.Time.Calendar
 import System.Time.Clock
 
-checkDay :: ModJulianDay -> IO ()
-checkDay day = do
-	let st = encodeDay day :: YearDay
+checkDay :: (DayEncoding t,Show t) => t -> ModJulianDay -> IO ()
+checkDay t day = do
+	let st = encodeDay' t day
 	let day' = decodeDay st
 	if day /= day'
-	 then putStrLn ((show day) ++ " -> " ++ (show st) ++ " -> " ++ (show day'))
+	 then putStrLn ((show day) ++ " -> " ++ (show st) ++ " -> " ++ (show day') ++ " (diff " ++ (show (day' - day)) ++ ")")
 	 else return ()
+	where
+		encodeDay' :: (DayEncoding t,Show t) => t -> ModJulianDay -> t
+		encodeDay' _ = encodeDay
 
+checkers :: [ModJulianDay -> IO ()]
+checkers = [
+	checkDay (undefined :: YearDay),
+	checkDay (undefined :: ISOWeek),
+	checkDay (undefined :: GregorianDay)
+	]
+
+days :: [ModJulianDay]
+days = [50000..50200] ++
+	(fmap (\year -> (decodeDay (GregorianDay year 1 4))) [1980..2000])
 
 main :: IO ()
-main = do
-	mapM_ checkDay [50000..50200]
-	mapM_ (\year -> checkDay (decodeDay (GregorianDay year 1 4))) [1980..2000]
+main = mapM_ (\ch -> mapM_ ch days) checkers