[commit: packages/time] master, wip/travis: more calendar functions, plus test for UTC - Calendar conversion (70e1b39)
git at git.haskell.org
git at git.haskell.org
Sat May 7 06:39:40 UTC 2016
Repository : ssh://git@git.haskell.org/time
On branches: master,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
More information about the ghc-commits
mailing list