[commit: packages/time] format-widths, ghc, improve-leapseconds, master, posix-perf, tasty, wip/travis: more calendar functions, plus test for UTC - Calendar conversion (70e1b39)

[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/70e1b39e22c8b19ab1d8bfa128c63256f8d84a9f

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

commit 70e1b39e22c8b19ab1d8bfa128c63256f8d84a9f
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Thu Mar 3 22:24:46 2005 -0800

    more calendar functions, plus test for UTC - Calendar conversion
    
    darcs-hash:20050304062446-ac6dd-51e7118d9d1d7e194bb7b0734a76ec9a3a0ebb88


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

70e1b39e22c8b19ab1d8bfa128c63256f8d84a9f
 CurrentTime.hs          |  5 ++++-
 System/Time/Calendar.hs | 58 ++++++++++++++++++++++++++++++++++++++++++++-----
 System/Time/Clock.hs    |  5 ++++-
 TestTime.hs             | 21 ++++++++++++++++++
 TestTime.ref            |  6 +++++
 5 files changed, 88 insertions(+), 7 deletions(-)

diff --git a/CurrentTime.hs b/CurrentTime.hs
index aebfd6a..19e46c1 100644
--- a/CurrentTime.hs
+++ b/CurrentTime.hs
@@ -4,8 +4,11 @@ import System.Time.Clock
 import System.Time.TAI
 import System.Time.Calendar
 
+myzone :: TimeZone
+myzone = hoursToTimezone (- 8)
+
 main :: IO ()
 main = do
 	now <- getCurrentTime
 	putStrLn (show (utctDay now) ++ "," ++ show (utctDayTime now))
---	putStrLn (show (utcToCalendar (60 * -8) now))
+	putStrLn (show (utcToCalendar myzone now))
diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs
index a3b9e5a..60312e8 100644
--- a/System/Time/Calendar.hs
+++ b/System/Time/Calendar.hs
@@ -1,13 +1,16 @@
 module System.Time.Calendar
 (
 	-- time zones
-	TimeZone,timezoneToMinutes,minutesToTimezone,
+	TimeZone,timezoneToMinutes,minutesToTimezone,hoursToTimezone,utc,
 
 	-- getting the locale time zone
 
 	-- converting times to Gregorian "calendrical" format
-	TimeOfDay,CalendarDay,CalendarTime,
-	dayToCalendar,calendarToDay
+	TimeOfDay(..),CalendarDay(..),CalendarTime(..),
+	dayToCalendar,calendarToDay,
+	utcToLocalTimeOfDay,localToUTCTimeOfDay,
+	timeToTimeOfDay,timeOfDayToTime,
+	utcToCalendar,calendarToUTC
 
 	-- calendrical arithmetic
     -- e.g. "one month after March 31st"
@@ -26,6 +29,13 @@ newtype TimeZone = MkTimeZone {
 minutesToTimezone :: Int -> TimeZone
 minutesToTimezone = MkTimeZone
 
+hoursToTimezone :: Int -> TimeZone
+hoursToTimezone i = minutesToTimezone (60 * i)
+
+-- | The UTC time zone
+utc :: TimeZone
+utc = minutesToTimezone 0
+
 -- | time of day as represented in hour, minute and second (with picoseconds), typically used to express local time of day
 data TimeOfDay = TimeOfDay {
 	todHour    :: Int,
@@ -112,11 +122,49 @@ calendarToDay (CalendarDay year month day) =
 	y = year - a
 	m = month' + (12 * a) - 3
 
+-- | convert a ToD in UTC to a ToD in some timezone, together with a day adjustment
+utcToLocalTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
+utcToLocalTimeOfDay (MkTimeZone tz) (TimeOfDay h m s p) = (fromIntegral (div h' 24),TimeOfDay (mod h' 60) (mod m' 60) s p) where
+	m' = m + tz
+	h' = h + (div m' 60)
+
+-- | convert a ToD in some timezone to a ToD in UTC, together with a day adjustment
+localToUTCTimeOfDay :: TimeZone -> TimeOfDay -> (Integer,TimeOfDay)
+localToUTCTimeOfDay (MkTimeZone tz) = utcToLocalTimeOfDay (MkTimeZone (negate tz))
+
+-- note: this is also in System.Time.Clock.
+posixDaySeconds :: (Num a) => a
+posixDaySeconds = 86400
+
+posixDay :: DiffTime
+posixDay = siSecondsToTime posixDaySeconds
+
+-- | get a TimeOfDay given a time since midnight
+-- | time more than 24h will be converted to leap-seconds
+timeToTimeOfDay :: DiffTime -> TimeOfDay
+timeToTimeOfDay dt | dt >= posixDay = TimeOfDay 23 59 (60 + s) p where
+	offset = dt - posixDay
+	s = fromIntegral (div offset siSecond)
+	p = fromIntegral (mod offset siSecond)
+timeToTimeOfDay dt = TimeOfDay (fromInteger h) (fromInteger m) (fromInteger s) p where
+	p = fromIntegral (mod dt siSecond)
+	s' = fromIntegral (div dt siSecond)
+	s = mod s' 60
+	m' = div s' 60
+	m = mod m' 60
+	h = div m' 60
+
+-- | find out how much time since midnight a given TimeOfDay is
+timeOfDayToTime :: TimeOfDay -> DiffTime
+timeOfDayToTime (TimeOfDay h m s ps) = (((fromIntegral h) * 60 + (fromIntegral m)) * 60 + (fromIntegral s)) * siSecond + (fromIntegral ps)
 
 utcToCalendar :: TimeZone -> UTCTime -> CalendarTime
-utcToCalendar tz utc = undefined
+utcToCalendar tz (UTCTime day dt) = CalendarTime (dayToCalendar (day + i)) tod where
+	(i,tod) = utcToLocalTimeOfDay tz (timeToTimeOfDay dt)
 
 calendarToUTC :: TimeZone -> CalendarTime -> UTCTime
-calendarToUTC tz cal = undefined
+calendarToUTC tz (CalendarTime cday tod) = UTCTime (day + i) (timeOfDayToTime todUTC) where
+	day = calendarToDay cday
+	(i,todUTC) = localToUTCTimeOfDay tz tod
 
 
diff --git a/System/Time/Clock.hs b/System/Time/Clock.hs
index 5a4825f..bfc7379 100644
--- a/System/Time/Clock.hs
+++ b/System/Time/Clock.hs
@@ -6,7 +6,7 @@ module System.Time.Clock
 	ModJulianDay,ModJulianDate,
 
 	-- absolute time intervals
-	DiffTime,timeToSISeconds,siSecondsToTime,
+	DiffTime,siSecond,timeToSISeconds,siSecondsToTime,
 
 	-- UTC arithmetic
 	UTCTime(..),UTCDiffTime,utcTimeToUTCSeconds,utcSecondsToUTCTime,
@@ -35,6 +35,9 @@ newtype DiffTime = MkDiffTime Integer deriving (Eq,Ord,Num,Enum,Real,Integral)
 instance Show DiffTime where
 	show (MkDiffTime t) = (show t) ++ "ps"
 
+siSecond :: DiffTime
+siSecond = secondPicoseconds
+
 timeToSISeconds :: (Fractional a) => DiffTime -> a
 timeToSISeconds t = fromRational ((toRational t) / (toRational secondPicoseconds));
 
diff --git a/TestTime.hs b/TestTime.hs
index af9ceec..104801e 100644
--- a/TestTime.hs
+++ b/TestTime.hs
@@ -11,10 +11,22 @@ showCal d = do
 	putStr ((show d) ++ "=" ++ show (dayToCalendar d))
 	putStrLn (if d == d' then "" else "=" ++ (show d') ++ "!")
 
+showUTCTime :: UTCTime -> String
+showUTCTime (UTCTime d t) =  show d ++ "," ++ show t
+
 for :: (Monad m) => (a -> m ()) -> [a] -> m ()
 for _ [] = return ()
 for f (x:xs) = f x >> for f xs
 
+myzone :: TimeZone
+myzone = hoursToTimezone (- 8)
+
+leapSec1998Cal :: CalendarTime
+leapSec1998Cal = CalendarTime (CalendarDay 1998 12 31) (TimeOfDay 23 59 60 500000000000)
+
+leapSec1998 :: UTCTime
+leapSec1998 = calendarToUTC utc leapSec1998Cal
+
 main :: IO ()
 main = do
 	showCal 0	
@@ -36,3 +48,12 @@ main = do
 	showCal 51604
 	-- years 2000 and 2001, plus some slop
 	for showCal [51540..52280]
+	--
+	putStrLn ""
+	showCal 51178
+	putStrLn (show leapSec1998Cal)
+	putStrLn (showUTCTime leapSec1998)
+	let lsMineCal = utcToCalendar myzone leapSec1998
+	putStrLn (show lsMineCal)
+	let lsMine = calendarToUTC myzone lsMineCal
+	putStrLn (showUTCTime lsMine)
diff --git a/TestTime.ref b/TestTime.ref
index c589a5d..ebe832a 100644
--- a/TestTime.ref
+++ b/TestTime.ref
@@ -752,3 +752,9 @@
 52278=2002-01-04
 52279=2002-01-05
 52280=2002-01-06
+
+51178=1998-12-31
+1998-12-31 23:59:60.5
+51178,86400500000000000ps
+1998-12-31 15:59:60.5
+51178,86400500000000000ps