module Time (
ClockTime(..), -- abstract in Haskell 98
fromPosixSeconds, -- not in Haskell 98
Month(..), Day(..),
CalendarTime(CalendarTime, ctYear, ctMonth, ctDay, ctHour, ctMin, ctSec,
ctPicosec, ctWDay, ctYDay, ctTZName, ctTZ, ctIsDST),
TimeDiff(TimeDiff, tdYear, tdMonth, tdDay,
tdHour, tdMin, tdSec, tdPicosec),
getClockTime, addToClockTime, diffClockTimes,
toCalendarTime, toUTCTime, toClockTime,
calendarTimeToString, formatCalendarTime) where
import Prelude
import Ix(Ix)
import Locale --(TimeLocale(..),defaultTimeLocale)
import Char ( intToDigit )
import MonadicIO0(primGetClockTime,primToCalendarTime,primToUTCTime)
newtype ClockTime = ClockTime (Int,Int) -- (seconds,microseconds)
deriving (Eq,Ord,Show,Read)
-- The Show instance is a deviation from Haskell 98, provided for
-- compatibility with Hugs and GHC.
fromPosixSeconds ps = ClockTime (s,us) -- not in Haskell 98
where
(s,f) = properFraction ps
us = truncate (1000000*f)
data Month = January | February | March | April
| May | June | July | August
| September | October | November | December
deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
data Day = Sunday | Monday | Tuesday | Wednesday | Thursday
| Friday | Saturday
deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)
data CalendarTime = CalendarTime {
ctYear :: Int,
ctMonth :: Month,
ctDay, ctHour, ctMin, ctSec :: Int,
ctPicosec :: Integer,
ctWDay :: Day,
ctYDay :: Int,
ctTZName :: String,
ctTZ :: Int,
ctIsDST :: Bool
} deriving (Eq, Ord, Read, Show)
data TimeDiff = TimeDiff {
tdYear, tdMonth, tdDay, tdHour, tdMin, tdSec :: Int,
tdPicosec :: Integer
} deriving (Eq, Ord, Read, Show)
getClockTime :: IO ClockTime
getClockTime = ClockTime <$> primGetClockTime
addToClockTime :: TimeDiff -> ClockTime -> ClockTime
addToClockTime (TimeDiff y m d h min sec psec) (ClockTime (s,us)) =
ClockTime (s',us')
where
s' = s + sec + ds + 60*(min+60*(h+24*(d+30*m+365*y))) -- !!
(ds,us') = (us+fromInteger (psec `quot` 1000000)) `quotRem` 1000000
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes (ClockTime (s1,us1)) (ClockTime (s2,us2)) =
TimeDiff 0 0 0 0 0 (s1-s2) (toInteger (us1-us2)*1000000)
toCalendarTime :: ClockTime -> IO CalendarTime
toCalendarTime (ClockTime (s,us)) =
do (yr,mon,day,h,min,s,wd,yd,tzname,tz,dst) <- primToCalendarTime s
let ps = 1000000*fromIntegral us
return (CalendarTime yr (toEnum mon) day h min s ps (toEnum wd) yd tzname tz dst)
toUTCTime :: ClockTime -> CalendarTime
toUTCTime (ClockTime (s,us)) =
case primToUTCTime s of
(yr,mon,day,h,min,s,wd,yd,_,_,_) ->
(CalendarTime yr (toEnum mon) day h min s ps (toEnum wd) yd "UTC" 0 False)
where ps = 1000000*fromIntegral us
toClockTime :: CalendarTime -> ClockTime
toClockTime (CalendarTime yr mon day h min s ps _ _ _ tz _) =
ClockTime (es,fromInteger (ps `quot` 1000000))
where
es = s+60*(min+60*(h+24*ed))+tz
ed = jdn yr mon day-jdn 1970 January 1
jdn year month day =
y1*365 + y1 `div` 4 - y1 `div` 100 + y1 `div` 400 +
dayInYear year month +
day
where
y1=year-1
-- | O(1) calculation of how many days after January 1 the first of a month
-- starts
dayInYear =
\ year month ->
fromEnum (isLeapYear year && month>February)
+ case month of
January -> jan; February -> feb; March -> mar
April -> apr; May -> may; June -> jun
July -> jul; August -> aug; September -> sep
October -> oct; November -> nov; December -> dec
where
jan = 0; feb = jan+31; mar = feb+28
apr = mar+31; may = apr+30; jun = may+31
jul = jun+30; aug = jul+31; sep = aug+31
oct = sep+30; nov = oct+31; dec = nov+30
isLeapYear :: Int -> Bool
isLeapYear y = y `mod` 4 == 0 && y `mod` 100 /= 0 || y `mod` 400 == 0
calendarTimeToString :: CalendarTime -> String
calendarTimeToString = formatCalendarTime defaultTimeLocale "%c"
formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
formatCalendarTime l fmt ct@(CalendarTime year mon day hour min sec sdec
wday yday tzname tz _) =
doFmt fmt
where doFmt ('%':c:cs) = decode c ++ doFmt cs
doFmt (c:cs) = c : doFmt cs
doFmt "" = ""
to12 :: Int -> Int
to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
decode 'A' = fst (wDays l !! fromEnum wday) --{-
decode 'a' = snd (wDays l !! fromEnum wday)
decode 'B' = fst (months l !! fromEnum mon)
decode 'b' = snd (months l !! fromEnum mon)
decode 'h' = snd (months l !! fromEnum mon)
decode 'C' = show2 (year `quot` 100)
decode 'c' = doFmt (dateTimeFmt l)
decode 'D' = doFmt "%m/%d/%y"
decode 'd' = show2 day
decode 'e' = show2' day
decode 'H' = show2 hour
decode 'I' = show2 (to12 hour)
decode 'j' = show3 yday
decode 'k' = show2' hour
decode 'l' = show2' (to12 hour)
decode 'M' = show2 min
decode 'm' = show2 (fromEnum mon+1)
decode 'n' = "\n"
decode 'p' = (if hour < 12 then fst else snd) (amPm l)
decode 'R' = doFmt "%H:%M"
decode 'r' = doFmt (time12Fmt l)
decode 'T' = doFmt "%H:%M:%S"
decode 't' = "\t"
decode 'S' = show2 sec
--decode 's' = undefined -- Implementation-dependent
decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7)
decode 'u' = show (let n = fromEnum wday in
if n == 0 then 7 else n)
decode 'V' =
let (week, days) =
(yday + 7 - if fromEnum wday > 0 then
fromEnum wday - 1 else 6) `divMod` 7
in show2 (if days >= 4 then
week+1
else if week == 0 then 53 else week)
decode 'W' =
show2 ((yday + 7 - if fromEnum wday > 0 then
fromEnum wday - 1 else 6) `div` 7)
decode 'w' = show (fromEnum wday)
decode 'X' = doFmt (timeFmt l)
decode 'x' = doFmt (dateFmt l)
decode 'Y' = show year
decode 'y' = show2 (year `rem` 100)
decode 'Z' = tzname
decode 'z' = sign:show2 hh++show2 mm
where
sign = if tz<0 then '-' else '+'
(hh,mm) = quotRem (abs tz `quot` 60) 60
decode '%' = "%" --}
decode c = [c]
show2, show2', show3 :: Int -> String
show2 x = [intToDigit (x `quot` 10), intToDigit (x `rem` 10)]
show2' x = if x < 10 then [ ' ', intToDigit x] else show2 x
show3 x = intToDigit (x `quot` 100) : show2 (x `rem` 100)