[commit: packages/time] master: new gregorianMonthLength function (cfab0ea)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/packages/time.git/commitdiff/cfab0ea8c8107f76745a3bde61519b6bdd46c539

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

commit cfab0ea8c8107f76745a3bde61519b6bdd46c539
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Sat Aug 6 13:38:12 2005 -0700

    new gregorianMonthLength function
    
    darcs-hash:20050806203812-ac6dd-9110023cbd93ef6501f65be4439cac6093c372c9


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

cfab0ea8c8107f76745a3bde61519b6bdd46c539
 Data/Time/Calendar/Gregorian.hs | 13 ++++++++++---
 1 file changed, 10 insertions(+), 3 deletions(-)

diff --git a/Data/Time/Calendar/Gregorian.hs b/Data/Time/Calendar/Gregorian.hs
index 74b1435..9e83440 100644
--- a/Data/Time/Calendar/Gregorian.hs
+++ b/Data/Time/Calendar/Gregorian.hs
@@ -4,7 +4,7 @@
 module Data.Time.Calendar.Gregorian
 (
 	-- * Gregorian calendar
-	gregorian,fromGregorian,showGregorian
+	gregorian,fromGregorian,showGregorian,gregorianMonthLength
 
 	-- calendrical arithmetic
     -- e.g. "one month after March 31st"
@@ -22,13 +22,13 @@ gregorian date = (year,month,day) where
 fromGregorian :: Integer -> Int -> Int -> Date
 -- formula from <http://en.wikipedia.org/wiki/Julian_Day>
 fromGregorian year month day = ModJulianDay
-	((fromIntegral (clip 1 monthLength day)) + (div (153 * m + 2) 5) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678882) where
+	(day' + (div (153 * m + 2) 5) + (365 * y) + (div y 4) - (div y 100) + (div y 400) - 678882) where
 	month' = clip 1 12 month
 	month'' = fromIntegral month'
 	a = div (14 - month'') 12
 	y = year - a
 	m = month'' + (12 * a) - 3
-	monthLength = (monthLengths (isLeapYear year)) !! (month' - 1)
+	day' = fromIntegral (clip 1 (gregorianMonthLength' year month') day)
 
 showGregorian :: Date -> String
 showGregorian date = (show4 y) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d) where
@@ -38,6 +38,13 @@ findMonthDay :: [Int] -> Int -> (Int,Int)
 findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n))
 findMonthDay _ yd = (1,yd)
 
+gregorianMonthLength' :: Integer -> Int -> Int
+gregorianMonthLength' year month' = (monthLengths (isLeapYear year)) !! (month' - 1)
+
+-- | The number of days in a given month according to the proleptic Gregorian calendar. First argument is year, second is month.
+gregorianMonthLength :: Integer -> Int -> Int
+gregorianMonthLength year month = gregorianMonthLength' year (clip 1 12 month)
+
 monthLengths :: Bool -> [Int]
 monthLengths isleap = 
 	[31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]