summaryrefslogtreecommitdiff
path: root/progs/lib/hbc/Time.hs
blob: 29f3441198c97c1ead7d1f4ca824e149d39609c3 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
module Time(Time(..), dblToTime, timeToDbl, timeToString) where
--               year mon  day  hour min  sec  ...    wday
data Time = Time Int  Int  Int  Int  Int  Int  Double Int deriving (Eq, Ord, Text)

isleap :: Int -> Bool
isleap n = n `rem` 4 == 0			-- good enough for the UNIX time span

daysin :: Int -> Int
daysin n = if isleap n then 366 else 365

monthlen :: Array (Bool, Int) Int
monthlen = array ((False, 1), (True, 12)) (zipWith3 (\ a b c -> (a,b):=c) (repeat False) [1..] [31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31] ++
					   zipWith3 (\ a b c -> (a,b):=c) (repeat True)  [1..] [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31])

-- Time zone offset in minutes
tzOffset = 120		-- Swedish DST

dblToTime :: Double -> Time
dblToTime d = 
	let t = truncate d :: Int
	    offset       = tzOffset		-- timezone
	    (days, rem)  = (t+offset*60) `quotRem` (60*60*24)
	    (hour, rem') = rem `quotRem` (60*60)
	    (min,  sec)  = rem' `quotRem` 60
	    wday         = (days+3) `mod` 7
	    (year, days')= until (\ (y, d) -> d < daysin y) (\ (y, d) -> (y+1, d - daysin y)) (1970, days)
	    (mon, day)   = until (\ (m, d) -> d <= monthlen!(isleap year, m)) (\ (m, d) -> (m+1, d - monthlen!(isleap year, m))) (1, days')
	in  Time year mon (day+1) hour min sec (d - fromInt t) wday

timeToDbl :: Time -> Double
timeToDbl (Time year mon day hour min sec sdec _) =
	let year'  = year - 1970
	    offset = tzOffset		-- timezone
	    days   = year' * 365 + (year'+1) `div` 4 + 
		     sum [monthlen!(isleap year, m) | m<-[1..mon-1]] + day - 1
            secs   = ((days*24 + hour) * 60 + min - offset) * 60 + sec
        in  fromInt secs + sdec

show2 :: Int -> String
show2 x = [chr (x `quot` 10 + ord '0'), chr (x `rem` 10 + ord '0')]

weekdays = ["Mon","Tue","Wen","Thu","Fri","Sat","Sun"]

timeToString :: Time -> String
timeToString (Time year mon day hour min sec sdec wday) =
	show  year ++ "-" ++ show2 mon ++ "-" ++ show2 day ++ " " ++
	show2 hour ++ ":" ++ show2 min ++ ":" ++ show2 sec ++ 
	tail (take 5 (show sdec)) ++ " " ++ weekdays!!wday

-- For those of you who don't have fromInt
fromInt = fromInteger . toInteger