[commit: packages/time] master: add ShowDST test program (445ae81)

[git at git.haskell.org]

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

On branch  : master
Link       : http://git.haskell.org/packages/time.git/commitdiff/445ae81631df6ed4ab222f104783cddd2d3e4737

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

commit 445ae81631df6ed4ab222f104783cddd2d3e4737
Author: Ashley Yakeley <ashley at semantic.org>
Date:   Thu Apr 28 03:12:16 2005 -0700

    add ShowDST test program
    
    darcs-hash:20050428101216-ac6dd-b195b5ad2f9d60f5ad650762d377d465f535a991


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

445ae81631df6ed4ab222f104783cddd2d3e4737
 Makefile   |  7 ++++++-
 ShowDST.hs | 42 ++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/Makefile b/Makefile
index 44f6935..46f48b9 100644
--- a/Makefile
+++ b/Makefile
@@ -1,4 +1,4 @@
-default: TestFixed.diff CurrentTime.run TestTime.diff TimeZone.diff doc
+default: test doc CurrentTime.run ShowDST.run
 
 SRCS = Data/Fixed.hs System/Time/Clock.hs System/Time/TAI.hs System/Time/Calendar.hs
 
@@ -11,6 +11,9 @@ TestTime: TestTime.o libTimeLib.a
 CurrentTime: CurrentTime.o libTimeLib.a
 	ghc $^ -o $@
 
+ShowDST: ShowDST.o libTimeLib.a
+	ghc $^ -o $@
+
 TimeZone: TimeZone.o libTimeLib.a
 	ghc $^ -o $@
 
@@ -25,6 +28,8 @@ libTimeLib.a: $(patsubst %.hs,%.o,$(SRCS)) timestuff.o
 	ar cru $@ $^
 	ranlib $@
 
+test: TestFixed.diff TestTime.diff TimeZone.diff
+
 clean:
 	rm -rf TimeZone TimeZone.ref CurrentTime TestTime TestFixed doc haddock *.out *.a *.o *.hi $(patsubst %.hs,%.o,$(SRCS)) $(patsubst %.hs,%.hi,$(SRCS)) Makefile.bak
 
diff --git a/ShowDST.hs b/ShowDST.hs
new file mode 100644
index 0000000..7b2dda1
--- /dev/null
+++ b/ShowDST.hs
@@ -0,0 +1,42 @@
+module Main where
+
+import System.Time.Clock
+import System.Time.Calendar
+
+monthBeginning :: Timezone -> Integer -> Int -> UTCTime
+monthBeginning zone year month = calendarToUTC zone
+	(CalendarTime (CalendarDay year month 1) midnight)
+
+findTransition :: UTCTime -> UTCTime -> IO [(UTCTime,Timezone,Timezone)]
+findTransition a b = do
+	za <- getTimezone a
+	zb <- getTimezone b
+	if za == zb then return [] else do
+		let c = addUTCTime ((diffUTCTime b a) / 2) a
+		if a == c then return [(b,za,zb)] else do
+			tp <- findTransition a c
+			tq <- findTransition c b
+			return (tp ++ tq)
+
+showZoneTime :: Timezone -> UTCTime -> String
+showZoneTime zone time = (show (utcToCalendar zone time)) ++ " " ++ (show zone)
+
+showTransition :: (UTCTime,Timezone,Timezone) -> String
+showTransition (time,zone1,zone2) = (showZoneTime zone1 time) ++ " => " ++ (showZoneTime zone2 time)
+
+main :: IO ()
+main = do
+	now <- getCurrentTime
+	zone <- getTimezone now
+	let year = cdYear (ctDay (utcToCalendar zone now))
+	putStrLn ("DST adjustments for " ++ show year ++ ":")
+	let t0 = monthBeginning zone year 1
+	let t1 = monthBeginning zone year 4
+	let t2 = monthBeginning zone year 7
+	let t3 = monthBeginning zone year 10
+	let t4 = monthBeginning zone (year + 1) 1
+	tr1 <- findTransition t0 t1
+	tr2 <- findTransition t1 t2
+	tr3 <- findTransition t2 t3
+	tr4 <- findTransition t3 t4
+	mapM_ (putStrLn . showTransition) (tr1 ++ tr2 ++ tr3 ++ tr4)