[commit: packages/time] format-widths, improve-leapseconds, master, posix-perf, tasty, wip/travis: CalendarTime synonym with convenience functions (f853253)

git at git.haskell.org git at git.haskell.org
Mon Feb 20 21:08:22 UTC 2017


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

On branches: format-widths,improve-leapseconds,master,posix-perf,tasty,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