{-# LINE 1 "System/Time.hsc" #-}
{-# LINE 2 "System/Time.hsc" #-}
{-# LANGUAGE Trustworthy #-}
{-# LINE 4 "System/Time.hsc" #-}
module System.Time
(
ClockTime(..)
, getClockTime
, TimeDiff(..)
, noTimeDiff
, diffClockTimes
, addToClockTime
, normalizeTimeDiff
, timeDiffToString
, formatTimeDiff
, CalendarTime(..)
, Month(..)
, Day(..)
, toCalendarTime
, toUTCTime
, toClockTime
, calendarTimeToString
, formatCalendarTime
) where
{-# LINE 111 "System/Time.hsc" #-}
{-# LINE 113 "System/Time.hsc" #-}
import Prelude
import Data.Ix
import System.Locale
import Foreign
import System.IO.Unsafe (unsafePerformIO)
{-# LINE 124 "System/Time.hsc" #-}
import Foreign.C
{-# LINE 126 "System/Time.hsc" #-}
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 ClockTime = TOD Integer Integer
deriving (Eq, Ord)
instance Show ClockTime where
showsPrec _ t = showString (calendarTimeToString
(unsafePerformIO (toCalendarTime t)))
data CalendarTime
= CalendarTime {
ctYear :: Int
, ctMonth :: Month
, ctDay :: Int
, ctHour :: Int
, ctMin :: Int
, ctSec :: Int
, ctPicosec :: Integer
, ctWDay :: Day
, ctYDay :: Int
, ctTZName :: String
, ctTZ :: Int
, ctIsDST :: Bool
}
deriving (Eq,Ord,Read,Show)
data TimeDiff
= TimeDiff {
tdYear :: Int,
tdMonth :: Int,
tdDay :: Int,
tdHour :: Int,
tdMin :: Int,
tdSec :: Int,
tdPicosec :: Integer
}
deriving (Eq,Ord,Read,Show)
noTimeDiff :: TimeDiff
noTimeDiff = TimeDiff 0 0 0 0 0 0 0
realToInteger :: Real a => a -> Integer
realToInteger ct = round (realToFrac ct :: Double)
getClockTime :: IO ClockTime
{-# LINE 239 "System/Time.hsc" #-}
{-# LINE 244 "System/Time.hsc" #-}
type Timeval_tv_sec = CTime
type Timeval_tv_usec = CSUSeconds
{-# LINE 247 "System/Time.hsc" #-}
getClockTime = do
allocaBytes (16) $ \ p_timeval -> do
{-# LINE 250 "System/Time.hsc" #-}
throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr
sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p_timeval :: IO Timeval_tv_sec
{-# LINE 252 "System/Time.hsc" #-}
usec <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p_timeval :: IO Timeval_tv_usec
{-# LINE 253 "System/Time.hsc" #-}
return (TOD (realToInteger sec) ((realToInteger usec) * 1000000))
{-# LINE 269 "System/Time.hsc" #-}
addToClockTime :: TimeDiff -> ClockTime -> ClockTime
addToClockTime (TimeDiff year mon day hour minute sec psec)
(TOD c_sec c_psec) =
let
sec_diff = toInteger sec +
60 * toInteger minute +
3600 * toInteger hour +
24 * 3600 * toInteger day
(d_sec, d_psec) = (c_psec + psec) `quotRem` 1000000000000
cal = toUTCTime (TOD (c_sec + sec_diff + d_sec) d_psec)
new_mon = fromEnum (ctMonth cal) + r_mon
month' = fst tmp
yr_diff = snd tmp
tmp
| new_mon < 0 = (toEnum (12 + new_mon), (-1))
| new_mon > 11 = (toEnum (new_mon `mod` 12), 1)
| otherwise = (toEnum new_mon, 0)
(r_yr, r_mon) = mon `quotRem` 12
year' = ctYear cal + year + r_yr + yr_diff
in
toClockTime cal{ctMonth=month', ctYear=year'}
diffClockTimes :: ClockTime -> ClockTime -> TimeDiff
diffClockTimes (TOD sa pa) (TOD sb pb) =
noTimeDiff{ tdSec = fromIntegral (sa - sb)
, tdPicosec = pa - pb
}
normalizeTimeDiff :: TimeDiff -> TimeDiff
normalizeTimeDiff td =
let
rest0 = toInteger (tdSec td)
+ 60 * (toInteger (tdMin td)
+ 60 * (toInteger (tdHour td)
+ 24 * (toInteger (tdDay td)
+ 30 * toInteger (tdMonth td)
+ 365 * toInteger (tdYear td))))
(diffYears, rest1) = rest0 `quotRem` (365 * 24 * 3600)
(diffMonths, rest2) = rest1 `quotRem` (30 * 24 * 3600)
(diffDays, rest3) = rest2 `quotRem` (24 * 3600)
(diffHours, rest4) = rest3 `quotRem` 3600
(diffMins, diffSecs) = rest4 `quotRem` 60
in
td{ tdYear = fromInteger diffYears
, tdMonth = fromInteger diffMonths
, tdDay = fromInteger diffDays
, tdHour = fromInteger diffHours
, tdMin = fromInteger diffMins
, tdSec = fromInteger diffSecs
}
{-# LINE 351 "System/Time.hsc" #-}
zone :: Ptr CTm -> IO (Ptr CChar)
gmtoff :: Ptr CTm -> IO CLong
{-# LINE 361 "System/Time.hsc" #-}
zone x = ((\hsc_ptr -> peekByteOff hsc_ptr 48)) x
{-# LINE 362 "System/Time.hsc" #-}
gmtoff x = ((\hsc_ptr -> peekByteOff hsc_ptr 40)) x
{-# LINE 363 "System/Time.hsc" #-}
{-# LINE 410 "System/Time.hsc" #-}
{-# LINE 411 "System/Time.hsc" #-}
toCalendarTime :: ClockTime -> IO CalendarTime
{-# LINE 422 "System/Time.hsc" #-}
toCalendarTime = clockToCalendarTime_reentrant (_throwAwayReturnPointer localtime_r) False
{-# LINE 426 "System/Time.hsc" #-}
toUTCTime :: ClockTime -> CalendarTime
{-# LINE 434 "System/Time.hsc" #-}
toUTCTime = unsafePerformIO . clockToCalendarTime_reentrant (_throwAwayReturnPointer gmtime_r) True
{-# LINE 438 "System/Time.hsc" #-}
{-# LINE 463 "System/Time.hsc" #-}
_throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm))
-> (Ptr CTime -> Ptr CTm -> IO ( ))
_throwAwayReturnPointer fun x y = fun x y >> return ()
{-# LINE 475 "System/Time.hsc" #-}
{-# LINE 477 "System/Time.hsc" #-}
clockToCalendarTime_reentrant :: (Ptr CTime -> Ptr CTm -> IO ()) -> Bool -> ClockTime
-> IO CalendarTime
clockToCalendarTime_reentrant fun is_utc (TOD secs psec) = do
with (fromIntegral secs :: CTime) $ \ p_timer -> do
allocaBytes (56) $ \ p_tm -> do
{-# LINE 482 "System/Time.hsc" #-}
fun p_timer p_tm
clockToCalendarTime_aux is_utc p_tm psec
{-# LINE 485 "System/Time.hsc" #-}
clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime
clockToCalendarTime_aux is_utc p_tm psec = do
sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) p_tm :: IO CInt
{-# LINE 489 "System/Time.hsc" #-}
minute <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) p_tm :: IO CInt
{-# LINE 490 "System/Time.hsc" #-}
hour <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) p_tm :: IO CInt
{-# LINE 491 "System/Time.hsc" #-}
mday <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) p_tm :: IO CInt
{-# LINE 492 "System/Time.hsc" #-}
mon <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) p_tm :: IO CInt
{-# LINE 493 "System/Time.hsc" #-}
year <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) p_tm :: IO CInt
{-# LINE 494 "System/Time.hsc" #-}
wday <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) p_tm :: IO CInt
{-# LINE 495 "System/Time.hsc" #-}
yday <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) p_tm :: IO CInt
{-# LINE 496 "System/Time.hsc" #-}
isdst <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) p_tm :: IO CInt
{-# LINE 497 "System/Time.hsc" #-}
zone' <- zone p_tm
tz <- gmtoff p_tm
tzname' <- peekCString zone'
let month | mon >= 0 && mon <= 11 = toEnum (fromIntegral mon)
| otherwise = error ("toCalendarTime: illegal month value: " ++ show mon)
return (CalendarTime
(1900 + fromIntegral year)
month
(fromIntegral mday)
(fromIntegral hour)
(fromIntegral minute)
(fromIntegral sec)
psec
(toEnum (fromIntegral wday))
(fromIntegral yday)
(if is_utc then "UTC" else tzname')
(if is_utc then 0 else fromIntegral tz)
(if is_utc then False else isdst /= 0))
{-# LINE 519 "System/Time.hsc" #-}
toClockTime :: CalendarTime -> ClockTime
{-# LINE 532 "System/Time.hsc" #-}
toClockTime (CalendarTime year mon mday hour minute sec psec
_wday _yday _tzname tz _isdst) =
let isDst = -1 :: CInt in
if psec < 0 || psec > 999999999999 then
error "Time.toClockTime: picoseconds out of range"
else if tz < -43200 || tz > 50400 then
error "Time.toClockTime: timezone offset out of range"
else
unsafePerformIO $ do
allocaBytes (56) $ \ p_tm -> do
{-# LINE 549 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) p_tm (fromIntegral sec :: CInt)
{-# LINE 550 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 4)) p_tm (fromIntegral minute :: CInt)
{-# LINE 551 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) p_tm (fromIntegral hour :: CInt)
{-# LINE 552 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 12)) p_tm (fromIntegral mday :: CInt)
{-# LINE 553 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) p_tm (fromIntegral (fromEnum mon) :: CInt)
{-# LINE 554 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 20)) p_tm (fromIntegral year - 1900 :: CInt)
{-# LINE 555 "System/Time.hsc" #-}
((\hsc_ptr -> pokeByteOff hsc_ptr 32)) p_tm isDst
{-# LINE 556 "System/Time.hsc" #-}
t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input")
(mktime p_tm)
gmtoffset <- gmtoff p_tm
let res = realToInteger t - fromIntegral tz + fromIntegral gmtoffset
return (TOD res psec)
{-# LINE 574 "System/Time.hsc" #-}
calendarTimeToString :: CalendarTime -> String
calendarTimeToString = formatCalendarTime defaultTimeLocale "%c"
formatCalendarTime :: TimeLocale -> String -> CalendarTime -> String
formatCalendarTime l fmt cal@(CalendarTime year mon day hour minute sec _
wday yday tzname' _ _) =
doFmt fmt
where doFmt ('%':'-':cs) = doFmt ('%':cs)
doFmt ('%':'_':cs) = doFmt ('%':cs)
doFmt ('%':c:cs) = decode c ++ doFmt cs
doFmt (c:cs) = c : doFmt cs
doFmt "" = ""
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 + 1)
decode 'k' = show2' hour
decode 'l' = show2' (to12 hour)
decode 'M' = show2 minute
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' = let TOD esecs _ = toClockTime cal in show esecs
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 '%' = "%"
decode c = [c]
show2, show2', show3 :: Int -> String
show2 x
| x' < 10 = '0': show x'
| otherwise = show x'
where x' = x `rem` 100
show2' x
| x' < 10 = ' ': show x'
| otherwise = show x'
where x' = x `rem` 100
show3 x = show (x `quot` 100) ++ show2 (x `rem` 100)
to12 :: Int -> Int
to12 h = let h' = h `mod` 12 in if h' == 0 then 12 else h'
timeDiffToString :: TimeDiff -> String
timeDiffToString = formatTimeDiff defaultTimeLocale "%c"
formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
formatTimeDiff l fmt (TimeDiff year month day hour minute sec _)
= doFmt fmt
where
doFmt "" = ""
doFmt ('%':'-':cs) = doFmt ('%':cs)
doFmt ('%':'_':cs) = doFmt ('%':cs)
doFmt ('%':c:cs) = decode c ++ doFmt cs
doFmt (c:cs) = c : doFmt cs
decode spec =
case spec of
'B' -> fst (months l !! fromEnum month)
'b' -> snd (months l !! fromEnum month)
'h' -> snd (months l !! fromEnum month)
'c' -> defaultTimeDiffFmt
'C' -> show2 (year `quot` 100)
'D' -> doFmt "%m/%d/%y"
'd' -> show2 day
'e' -> show2' day
'H' -> show2 hour
'I' -> show2 (to12 hour)
'k' -> show2' hour
'l' -> show2' (to12 hour)
'M' -> show2 minute
'm' -> show2 (fromEnum month + 1)
'n' -> "\n"
'p' -> (if hour < 12 then fst else snd) (amPm l)
'R' -> doFmt "%H:%M"
'r' -> doFmt (time12Fmt l)
'T' -> doFmt "%H:%M:%S"
't' -> "\t"
'S' -> show2 sec
's' -> show2 sec
'X' -> doFmt (timeFmt l)
'x' -> doFmt (dateFmt l)
'Y' -> show year
'y' -> show2 (year `rem` 100)
'%' -> "%"
c -> [c]
defaultTimeDiffFmt =
foldr (\ (v,s) rest ->
(if v /= 0
then show v ++ ' ':(addS v s)
++ if null rest then "" else ", "
else "") ++ rest
)
""
(zip [year, month, day, hour, minute, sec] (intervals l))
addS v s = if abs v == 1 then fst s else snd s
{-# LINE 728 "System/Time.hsc" #-}
type CTm = ()
{-# LINE 734 "System/Time.hsc" #-}
foreign import ccall unsafe "HsTime.h __hscore_localtime_r"
localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
{-# LINE 740 "System/Time.hsc" #-}
{-# LINE 741 "System/Time.hsc" #-}
foreign import ccall unsafe "HsTime.h __hscore_gmtime_r"
gmtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
{-# LINE 747 "System/Time.hsc" #-}
foreign import ccall unsafe "time.h mktime"
mktime :: Ptr CTm -> IO CTime
{-# LINE 751 "System/Time.hsc" #-}
type CTimeVal = ()
type CTimeZone = ()
foreign import ccall unsafe "HsTime.h __hscore_gettimeofday"
gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt
{-# LINE 765 "System/Time.hsc" #-}
{-# LINE 766 "System/Time.hsc" #-}