home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacHaskell 2.2 / progs / lib / hbc / Time.hs < prev    next >
Encoding:
Text File  |  1994-09-27  |  2.1 KB  |  52 lines  |  [TEXT/YHS2]
  1. module Time(Time(..), dblToTime, timeToDbl, timeToString) where
  2. --               year mon  day  hour min  sec  ...    wday
  3. data Time = Time Int  Int  Int  Int  Int  Int  Double Int deriving (Eq, Ord, Text)
  4.  
  5. isleap :: Int -> Bool
  6. isleap n = n `rem` 4 == 0            -- good enough for the UNIX time span
  7.  
  8. daysin :: Int -> Int
  9. daysin n = if isleap n then 366 else 365
  10.  
  11. monthlen :: Array (Bool, Int) Int
  12. 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] ++
  13.                        zipWith3 (\ a b c -> (a,b):=c) (repeat True)  [1..] [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31])
  14.  
  15. -- Time zone offset in minutes
  16. tzOffset = 120        -- Swedish DST
  17.  
  18. dblToTime :: Double -> Time
  19. dblToTime d = 
  20.     let t = truncate d :: Int
  21.         offset       = tzOffset        -- timezone
  22.         (days, rem)  = (t+offset*60) `quotRem` (60*60*24)
  23.         (hour, rem') = rem `quotRem` (60*60)
  24.         (min,  sec)  = rem' `quotRem` 60
  25.         wday         = (days+3) `mod` 7
  26.         (year, days')= until (\ (y, d) -> d < daysin y) (\ (y, d) -> (y+1, d - daysin y)) (1970, days)
  27.         (mon, day)   = until (\ (m, d) -> d <= monthlen!(isleap year, m)) (\ (m, d) -> (m+1, d - monthlen!(isleap year, m))) (1, days')
  28.     in  Time year mon (day+1) hour min sec (d - fromInt t) wday
  29.  
  30. timeToDbl :: Time -> Double
  31. timeToDbl (Time year mon day hour min sec sdec _) =
  32.     let year'  = year - 1970
  33.         offset = tzOffset        -- timezone
  34.         days   = year' * 365 + (year'+1) `div` 4 + 
  35.              sum [monthlen!(isleap year, m) | m<-[1..mon-1]] + day - 1
  36.             secs   = ((days*24 + hour) * 60 + min - offset) * 60 + sec
  37.         in  fromInt secs + sdec
  38.  
  39. show2 :: Int -> String
  40. show2 x = [chr (x `quot` 10 + ord '0'), chr (x `rem` 10 + ord '0')]
  41.  
  42. weekdays = ["Mon","Tue","Wen","Thu","Fri","Sat","Sun"]
  43.  
  44. timeToString :: Time -> String
  45. timeToString (Time year mon day hour min sec sdec wday) =
  46.     show  year ++ "-" ++ show2 mon ++ "-" ++ show2 day ++ " " ++
  47.     show2 hour ++ ":" ++ show2 min ++ ":" ++ show2 sec ++ 
  48.     tail (take 5 (show sdec)) ++ " " ++ weekdays!!wday
  49.  
  50. -- For those of you who don't have fromInt
  51. fromInt = fromInteger . toInteger
  52.