[commit: packages/time] master, wip/travis: CalendarTime synonym with convenience functions (f853253)
git at git.haskell.org
git at git.haskell.org
Sat May 7 06:40:57 UTC 2016
Repository : ssh://git@git.haskell.org/time
On branches: master,wip/travis
Link : http://git.haskell.org/packages/time.git/commitdiff/f8532533d788c272d59278286c021eab2b973744
>---------------------------------------------------------------
commit f8532533d788c272d59278286c021eab2b973744
Author: Ashley Yakeley <ashley at semantic.org>
Date: Wed May 11 02:30:27 2005 -0700
CalendarTime synonym with convenience functions
darcs-hash:20050511093027-ac6dd-4336dabf134f48c15b0b922d4ee54d11567b7975
>---------------------------------------------------------------
f8532533d788c272d59278286c021eab2b973744
System/Time/Calendar.hs | 39 ++++++++++++++++++++++++++++++++++++++-
System/Time/Calendar/Gregorian.hs | 7 +------
test/CurrentTime.hs | 5 ++---
test/ShowDST.hs | 4 ++--
test/TestFormat.hs | 2 +-
test/TestTime.hs | 16 ++++++++--------
6 files changed, 52 insertions(+), 21 deletions(-)
diff --git a/System/Time/Calendar.hs b/System/Time/Calendar.hs
index 9b5d890..4b848e5 100644
--- a/System/Time/Calendar.hs
+++ b/System/Time/Calendar.hs
@@ -8,9 +8,13 @@ module System.Time.Calendar
module System.Time.Calendar.YearDay,
module System.Time.Calendar.Gregorian,
module System.Time.Calendar.ISOWeek,
- module System.Time.Calendar.Format
+ module System.Time.Calendar.Format,
+ module System.Time.Calendar
) where
+import Data.Fixed
+import System.Time.Clock
+
import System.Time.Calendar.Timezone
import System.Time.Calendar.TimeOfDay
import System.Time.Calendar.Calendar
@@ -18,3 +22,36 @@ import System.Time.Calendar.YearDay
import System.Time.Calendar.Gregorian
import System.Time.Calendar.ISOWeek
import System.Time.Calendar.Format
+
+type CalendarTime = ZonedTime (DayAndTime GregorianDay)
+
+calendarTime :: Timezone -> Integer -> Int -> Int -> Int -> Int -> Pico -> CalendarTime
+calendarTime zone year month day hour minute second =
+ ZonedTime (DayAndTime (GregorianDay year month day) (TimeOfDay hour minute second)) zone
+
+ctZone :: CalendarTime -> Timezone
+ctZone = ztZone
+
+ctYear :: CalendarTime -> Integer
+ctYear = gregYear . dtDay . ztTime
+
+ctMonth :: CalendarTime -> Int
+ctMonth = gregMonth . dtDay . ztTime
+
+ctDay :: CalendarTime -> Int
+ctDay = gregDay . dtDay . ztTime
+
+ctHour :: CalendarTime -> Int
+ctHour = todHour . dtTime . ztTime
+
+ctMin :: CalendarTime -> Int
+ctMin = todMin . dtTime . ztTime
+
+ctSec :: CalendarTime -> Pico
+ctSec = todSec . dtTime . ztTime
+
+getCalendarTime :: IO CalendarTime
+getCalendarTime = do
+ t <- getCurrentTime
+ zone <- getTimezone t
+ return (encodeUTC zone t)
diff --git a/System/Time/Calendar/Gregorian.hs b/System/Time/Calendar/Gregorian.hs
index 77f389d..3e986bd 100644
--- a/System/Time/Calendar/Gregorian.hs
+++ b/System/Time/Calendar/Gregorian.hs
@@ -2,7 +2,7 @@
module System.Time.Calendar.Gregorian
(
- GregorianDay(..),GregorianTime,ZonedGregorianTime
+ GregorianDay(..)
-- calendrical arithmetic
-- e.g. "one month after March 31st"
@@ -19,10 +19,6 @@ data GregorianDay = GregorianDay {
gregDay :: Int
} deriving (Eq,Ord)
-type GregorianTime = DayAndTime GregorianDay
-
-type ZonedGregorianTime = ZonedTime (DayAndTime GregorianDay)
-
instance Show GregorianDay where
show (GregorianDay y m d) = (if y > 0 then show y else (show (1 - y) ++ "BCE")) ++ "-" ++ (show2 m) ++ "-" ++ (show2 d)
@@ -30,7 +26,6 @@ findMonthDay :: [Int] -> Int -> (Int,Int)
findMonthDay (n:ns) yd | yd > n = (\(m,d) -> (m + 1,d)) (findMonthDay ns (yd - n))
findMonthDay _ yd = (1,yd)
-
monthLengths :: Bool -> [Int]
monthLengths isleap =
[31,if isleap then 29 else 28,31,30,31,30,31,31,30,31,30,31]
diff --git a/test/CurrentTime.hs b/test/CurrentTime.hs
index 2bb3f11..ae00fae 100644
--- a/test/CurrentTime.hs
+++ b/test/CurrentTime.hs
@@ -8,7 +8,6 @@ main :: IO ()
main = do
now <- getCurrentTime
putStrLn (show (utctDay now) ++ "," ++ show (utctDayTime now))
- putStrLn (show (encodeLocalUTC utc now :: GregorianTime))
+ putStrLn (show (encodeUTC utc now :: CalendarTime))
myzone <- getCurrentTimezone
- putStrLn ("timezone: " ++ show myzone)
- putStrLn (show (encodeLocalUTC myzone now :: GregorianTime))
+ putStrLn (show (encodeUTC myzone now :: CalendarTime))
diff --git a/test/ShowDST.hs b/test/ShowDST.hs
index 655beca..a061060 100644
--- a/test/ShowDST.hs
+++ b/test/ShowDST.hs
@@ -19,7 +19,7 @@ findTransition a b = do
return (tp ++ tq)
showZoneTime :: Timezone -> UTCTime -> String
-showZoneTime zone time = (show (encodeLocalUTC zone time :: GregorianTime)) ++ " " ++ (show zone)
+showZoneTime zone time = show (encodeUTC zone time :: CalendarTime)
showTransition :: (UTCTime,Timezone,Timezone) -> String
showTransition (time,zone1,zone2) = (showZoneTime zone1 time) ++ " => " ++ (showZoneTime zone2 time)
@@ -28,7 +28,7 @@ main :: IO ()
main = do
now <- getCurrentTime
zone <- getTimezone now
- let year = cdYear (dtDay (encodeLocalUTC zone now))
+ let year = gregYear (dtDay (encodeLocalUTC zone now))
putStrLn ("DST adjustments for " ++ show year ++ ":")
let t0 = monthBeginning zone year 1
let t1 = monthBeginning zone year 4
diff --git a/test/TestFormat.hs b/test/TestFormat.hs
index fbb1b7d..d4a7675 100644
--- a/test/TestFormat.hs
+++ b/test/TestFormat.hs
@@ -70,7 +70,7 @@ times = [baseTime0] ++ (fmap getDay [0..23]) ++ (fmap getDay [0..100]) ++
compareFormat :: String -> Timezone -> UTCTime -> IO ()
compareFormat fmt zone time = let
- ctime = encodeUTC zone time :: ZonedGregorianTime
+ ctime = encodeUTC zone time :: CalendarTime
haskellText = formatTime locale fmt ctime
in do
unixText <- unixFormatTime fmt zone time
diff --git a/test/TestTime.hs b/test/TestTime.hs
index 13a1ead..908ad88 100644
--- a/test/TestTime.hs
+++ b/test/TestTime.hs
@@ -40,7 +40,7 @@ showUTCTime (UTCTime d t) = show d ++ "," ++ show t
myzone :: Timezone
myzone = hoursToTimezone (- 8)
-leapSec1998Cal :: GregorianTime
+leapSec1998Cal :: DayAndTime GregorianDay
leapSec1998Cal = DayAndTime (GregorianDay 1998 12 31) (TimeOfDay 23 59 60.5)
leapSec1998 :: UTCTime
@@ -52,7 +52,7 @@ testUTC = do
showCal 51178
putStrLn (show leapSec1998Cal)
putStrLn (showUTCTime leapSec1998)
- let lsMineCal = encodeLocalUTC myzone leapSec1998 :: GregorianTime
+ let lsMineCal = encodeLocalUTC myzone leapSec1998 :: DayAndTime GregorianDay
putStrLn (show lsMineCal)
let lsMine = decodeLocalUTC myzone lsMineCal
putStrLn (showUTCTime lsMine)
@@ -66,12 +66,12 @@ poslong = 120
testUT1 :: IO ()
testUT1 = do
putStrLn ""
- putStrLn (show (encodeLocalUT1 0 51604.0 :: GregorianTime))
- putStrLn (show (encodeLocalUT1 0 51604.5 :: GregorianTime))
- putStrLn (show (encodeLocalUT1 neglong 51604.0 :: GregorianTime))
- putStrLn (show (encodeLocalUT1 neglong 51604.5 :: GregorianTime))
- putStrLn (show (encodeLocalUT1 poslong 51604.0 :: GregorianTime))
- putStrLn (show (encodeLocalUT1 poslong 51604.5 :: GregorianTime))
+ putStrLn (show (encodeLocalUT1 0 51604.0 :: DayAndTime GregorianDay))
+ putStrLn (show (encodeLocalUT1 0 51604.5 :: DayAndTime GregorianDay))
+ putStrLn (show (encodeLocalUT1 neglong 51604.0 :: DayAndTime GregorianDay))
+ putStrLn (show (encodeLocalUT1 neglong 51604.5 :: DayAndTime GregorianDay))
+ putStrLn (show (encodeLocalUT1 poslong 51604.0 :: DayAndTime GregorianDay))
+ putStrLn (show (encodeLocalUT1 poslong 51604.5 :: DayAndTime GregorianDay))
main :: IO ()
main = do
More information about the ghc-commits
mailing list