ghc/lib/hbc/Time.hs

   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 #if __HASKELL1__ < 3
  13 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] ++
  14                                            zipWith3 (\ a b c -> (a,b):=c) (repeat True)  [1..] [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31])
  15 #else
  16 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] ++
  17                                            zipWith3 (\ a b c -> ((a,b),c)) (repeat True)  [1..] [31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31])
  18 #endif
  19
  20 dblToTime :: Double -> Time
  21 dblToTime d =
  22         let t = truncate d :: Int
  23             (days, rem)  = t `quotRem` (60*60*24)
  24             (hour, rem') = rem `quotRem` (60*60)
  25             (min,  sec)  = rem' `quotRem` 60
  26             wday         = (days+3) `mod` 7
  27             (year, days')= until (\ (y, d) -> d < daysin y) (\ (y, d) -> (y+1, d - daysin y)) (1970, days)
  28             (mon, day)   = until (\ (m, d) -> d < monthlen!(isleap year, m)) (\ (m, d) -> (m+1, d - monthlen!(isleap year, m))) (1, days')
  29         in  Time year mon (day+1) hour min sec (d - fromInt t) wday
  30
  31 timeToDbl :: Time -> Double
  32 timeToDbl (Time year mon day hour min sec sdec _) =
  33         let year'  = year - 1970
  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) * 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","Wed","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 #if defined(__YALE_HASKELL__)
  51 -- For those of you who don't have fromInt
  52 fromInt = fromInteger . toInteger
  53 #endif