[commit: packages/time] master, wip/travis: add dayToCalendar function, with test (266f005)

[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/266f0057ecca2b00449eb0c631c6d9507b8281af

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

commit 266f0057ecca2b00449eb0c631c6d9507b8281af
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Wed Mar 2 03:12:18 2005 -0800

    add dayToCalendar function, with test
    
    darcs-hash:20050302111218-ac6dd-2efd1ae180bcf6b419cbab3f1a1876c5ed7b55c4


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

266f0057ecca2b00449eb0c631c6d9507b8281af
 System/Time/Calendar.hs | 12 +++++++++++-
 TestTime.hs             |  6 +++++-
 2 files changed, 16 insertions(+), 2 deletions(-)

diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs
index fa55f5a..a3b9e5a 100644
--- a/System/Time/Calendar.hs
+++ b/System/Time/Calendar.hs
@@ -7,7 +7,7 @@ module System.Time.Calendar
 
 	-- converting times to Gregorian "calendrical" format
 	TimeOfDay,CalendarDay,CalendarTime,
-	dayToCalendar
+	dayToCalendar,calendarToDay
 
 	-- calendrical arithmetic
     -- e.g. "one month after March 31st"
@@ -102,6 +102,16 @@ dayToCalendar mjd = CalendarDay year month day where
 	(year,yd,isleap) = dayToYearDay mjd
 	(month,day) = findMonthDay (months isleap) yd
 
+-- | find out which day a given Gregorian calendar day is
+calendarToDay :: CalendarDay -> ModJulianDay
+-- formula from <http://en.wikipedia.org/wiki/Julian_Day>
+calendarToDay (CalendarDay year month day) =
+	(fromIntegral day) + (div (153 * m + 2) 5) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678882 where
+	month' = fromIntegral month
+	a = div (14 - month') 12
+	y = year - a
+	m = month' + (12 * a) - 3
+
 
 utcToCalendar :: TimeZone -> UTCTime -> CalendarTime
 utcToCalendar tz utc = undefined
diff --git a/TestTime.hs b/TestTime.hs
index d724f89..af9ceec 100644
--- a/TestTime.hs
+++ b/TestTime.hs
@@ -5,7 +5,11 @@ import System.Time.TAI
 import System.Time.Calendar
 
 showCal :: ModJulianDay -> IO ()
-showCal d = putStrLn ((show d) ++ "=" ++ show (dayToCalendar d))
+showCal d = do
+	let cal = dayToCalendar d
+	let d' = calendarToDay cal
+	putStr ((show d) ++ "=" ++ show (dayToCalendar d))
+	putStrLn (if d == d' then "" else "=" ++ (show d') ++ "!")
 
 for :: (Monad m) => (a -> m ()) -> [a] -> m ()
 for _ [] = return ()