[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: add validating constructors (9884b31)

[git at git.haskell.org]

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

On branches: format-widths,ghc,improve-leapseconds,master,posix-perf,tasty,wip/travis
Link       : http://git.haskell.org/packages/time.git/commitdiff/9884b31fcca197b64f6e356142d9d99e1422ab38

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

commit 9884b31fcca197b64f6e356142d9d99e1422ab38
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Wed Jun 17 01:49:36 2009 -0700

    add validating constructors
    
    Ignore-this: e01e75f9d860f34285265b39b20cf225
    
    darcs-hash:20090617084936-ac6dd-5ecf266acb8e2dabaa0b7a33fc2cda0cf6d44727


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

9884b31fcca197b64f6e356142d9d99e1422ab38
 Data/Time/Calendar/OrdinalDate.hs | 31 +++++++++++++++++++++++++++++++
 Data/Time/LocalTime/TimeOfDay.hs  |  9 ++++++++-
 2 files changed, 39 insertions(+), 1 deletion(-)

diff --git a/Data/Time/Calendar/OrdinalDate.hs b/Data/Time/Calendar/OrdinalDate.hs
index 327c561..4e5b2b9 100644
--- a/Data/Time/Calendar/OrdinalDate.hs
+++ b/Data/Time/Calendar/OrdinalDate.hs
@@ -79,6 +79,21 @@ fromMondayStartWeek y w d = ModifiedJulianDay (firstDay + yd)
           -- 0-based year day of first monday of the year
           firstMonday = (5 - firstDay) `mod` 7
 
+fromMondayStartWeekValid :: Integer -- ^ Year.
+                    -> Int     -- ^ Monday-starting week number.
+                    -> Int     -- ^ Day of week. 
+                               -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').
+                    -> Maybe Day
+fromMondayStartWeekValid year w d = do
+	d' <- clipValid 1 7 d
+	-- first day of the year
+	let firstDay = toModifiedJulianDay (fromOrdinalDate year 1)
+	-- 0-based year day of first monday of the year
+	let firstMonday = (5 - firstDay) `mod` 7
+	let yd = firstMonday + 7 * toInteger (w-1) + toInteger d'
+	yd' <- clipValid 1 (if isLeapYear year then 366 else 365) yd
+	return (ModifiedJulianDay (firstDay - 1 + yd'))
+
 -- | The inverse of 'sundayStartWeek'. Get a 'Day' given the year and
 -- the number of the day of a Sunday-starting week.
 -- The first Sunday is the first day of week 1, any earlier days in the 
@@ -94,3 +109,19 @@ fromSundayStartWeek y w d = ModifiedJulianDay (firstDay + yd)
           firstDay = toModifiedJulianDay (fromOrdinalDate y 1)
           -- 0-based year day of first sunday of the year
           firstSunday = (4 - firstDay) `mod` 7
+
+fromSundayStartWeekValid :: Integer -- ^ Year.
+                    -> Int     -- ^ Monday-starting week number.
+                    -> Int     -- ^ Day of week. 
+                               -- Monday is 1, Sunday is 7 (as \"%u\" in 'Data.Time.Format.formatTime').
+                    -> Maybe Day
+fromSundayStartWeekValid year w d = do
+	d' <- clipValid 1 7 d
+	-- first day of the year
+	let firstDay = toModifiedJulianDay (fromOrdinalDate year 1)
+	-- 0-based year day of first sunday of the year
+	let firstMonday = (4 - firstDay) `mod` 7
+	let yd = firstMonday + 7 * toInteger (w-1) + toInteger d'
+	yd' <- clipValid 1 (if isLeapYear year then 366 else 365) yd
+	return (ModifiedJulianDay (firstDay - 1 + yd'))
+
diff --git a/Data/Time/LocalTime/TimeOfDay.hs b/Data/Time/LocalTime/TimeOfDay.hs
index c0b4608..9639545 100644
--- a/Data/Time/LocalTime/TimeOfDay.hs
+++ b/Data/Time/LocalTime/TimeOfDay.hs
@@ -2,7 +2,7 @@
 module Data.Time.LocalTime.TimeOfDay
 (
 	-- * Time of day
-	TimeOfDay(..),midnight,midday,
+	TimeOfDay(..),midnight,midday,makeTimeOfDayValid,
 	utcToLocalTimeOfDay,localToUTCTimeOfDay,
 	timeToTimeOfDay,timeOfDayToTime,
 	dayFractionToTimeOfDay,timeOfDayToDayFraction
@@ -39,6 +39,13 @@ midday = TimeOfDay 12 0 0
 instance Show TimeOfDay where
 	show (TimeOfDay h m s) = (show2 h) ++ ":" ++ (show2 m) ++ ":" ++ (show2Fixed s)
 
+makeTimeOfDayValid :: Int -> Int -> Pico -> Maybe TimeOfDay
+makeTimeOfDayValid h m s = do
+	clipValid 0 23 h
+	clipValid 0 59 m
+	clipValid 0 60.999999999999 s
+	return (TimeOfDay h m s)
+
 -- | Convert a ToD in UTC to a ToD in some timezone, together with a day adjustment.
 utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
 utcToLocalTimeOfDay zone (TimeOfDay h m s) = (fromIntegral (div h' 24),TimeOfDay (mod h' 24) (mod m' 60) s) where