#if __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE CApiFFI #-}
#endif

-----------------------------------------------------------------------------
-- |
-- Module      :  System.Time
-- Copyright   :  (c) The University of Glasgow 2001
-- License     :  BSD-style (see the file libraries/old-time/LICENSE)
--
-- Maintainer  :  libraries@haskell.org
-- Stability   :  provisional
-- Portability :  portable
--
-- The standard time library from Haskell 98.  This library is
-- deprecated, please look at @Data.Time@ in the @time@ package
-- instead.
--
-- "System.Time" provides functionality for clock times, including
-- timezone information (i.e, the functionality of \"@time.h@\",
-- adapted to the Haskell environment).  It follows RFC 1129 in its
-- use of Coordinated Universal Time (UTC).
--
-----------------------------------------------------------------------------

{-
Haskell 98 Time of Day Library
------------------------------

2000/06/17 <michael.weber@post.rwth-aachen.de>:
RESTRICTIONS:
  * min./max. time diff currently is restricted to
    [minBound::Int, maxBound::Int]

  * surely other restrictions wrt. min/max bounds


NOTES:
  * printing times

    `showTime' (used in `instance Show ClockTime') always prints time
    converted to the local timezone (even if it is taken from
    `(toClockTime . toUTCTime)'), whereas `calendarTimeToString'
    honors the tzone & tz fields and prints UTC or whatever timezone
    is stored inside CalendarTime.

    Maybe `showTime' should be changed to use UTC, since it would
    better correspond to the actual representation of `ClockTime'
    (can be done by replacing localtime(3) by gmtime(3)).


BUGS:
  * add proper handling of microsecs, currently, they're mostly
    ignored

  * `formatFOO' case of `%s' is currently broken...


TODO:
  * check for unusual date cases, like 1970/1/1 00:00h, and conversions
    between different timezone's etc.

  * check, what needs to be in the IO monad, the current situation
    seems to be a bit inconsistent to me

  * check whether `isDst = -1' works as expected on other arch's
    (Solaris anyone?)

  * add functions to parse strings to `CalendarTime' (some day...)

  * implement padding capabilities ("%_", "%-") in `formatFOO'

  * add rfc822 timezone (+0200 is CEST) representation ("%z") in `formatFOO'
-}

module System.Time
     (
        -- * Clock times

        ClockTime(..) -- non-standard, lib. report gives this as abstract
        -- instance Eq, Ord
        -- instance Show (non-standard)

     ,  getClockTime

        -- * Time differences

     ,  TimeDiff(..)
     ,  noTimeDiff      -- non-standard (but useful when constructing TimeDiff vals.)
     ,  diffClockTimes
     ,  addToClockTime

     ,  normalizeTimeDiff -- non-standard
     ,  timeDiffToString  -- non-standard
     ,  formatTimeDiff    -- non-standard

        -- * Calendar times

     ,  CalendarTime(..)
     ,  Month(..)
     ,  Day(..)
     ,  toCalendarTime
     ,  toUTCTime
     ,  toClockTime
     ,  calendarTimeToString
     ,  formatCalendarTime

     ) where

#ifdef __GLASGOW_HASKELL__
#include "HsTime.h"
#endif

import Prelude

import Data.Ix
import System.Locale
import Foreign
import System.IO.Unsafe (unsafePerformIO)

#ifdef __HUGS__
import Hugs.Time ( getClockTimePrim, toCalTimePrim, toClockTimePrim )
#else
import Foreign.C
#endif

-- One way to partition and give name to chunks of a year and a week:

-- | A month of the year.

data Month
 = January   | February | March    | April
 | May       | June     | July     | August
 | September | October  | November | December
 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)

-- | A day of the week.

data Day
 = Sunday   | Monday | Tuesday | Wednesday
 | Thursday | Friday | Saturday
 deriving (Eq, Ord, Enum, Bounded, Ix, Read, Show)

-- | A representation of the internal clock time.
-- Clock times may be compared, converted to strings, or converted to an
-- external calendar time 'CalendarTime' for I\/O or other manipulations.

data ClockTime = TOD Integer Integer
                -- ^ Construct a clock time.  The arguments are a number
                -- of seconds since 00:00:00 (UTC) on 1 January 1970,
                -- and an additional number of picoseconds.
                --
                -- In Haskell 98, the 'ClockTime' type is abstract.
               deriving (Eq, Ord)

-- When a ClockTime is shown, it is converted to a CalendarTime in the current
-- timezone and then printed.  FIXME: This is arguably wrong, since we can't
-- get the current timezone without being in the IO monad.

instance Show ClockTime where
    showsPrec _ t = showString (calendarTimeToString
                                 (unsafePerformIO (toCalendarTime t)))

{-
The numeric fields have the following ranges.

\begin{verbatim}
Value         Range             Comments
-----         -----             --------

year    -maxInt .. maxInt       [Pre-Gregorian dates are inaccurate]
day           1 .. 31
hour          0 .. 23
min           0 .. 59
sec           0 .. 61           [Allows for two leap seconds]
picosec       0 .. (10^12)-1    [This could be over-precise?]
yday          0 .. 365          [364 in non-Leap years]
tz       -43200 .. 50400        [Variation from UTC in seconds]
\end{verbatim}
-}

-- | 'CalendarTime' is a user-readable and manipulable
-- representation of the internal 'ClockTime' type.

data CalendarTime
 = CalendarTime  {
       ctYear    :: Int         -- ^ Year (pre-Gregorian dates are inaccurate)
     , ctMonth   :: Month       -- ^ Month of the year
     , ctDay     :: Int         -- ^ Day of the month (1 to 31)
     , ctHour    :: Int         -- ^ Hour of the day (0 to 23)
     , ctMin     :: Int         -- ^ Minutes (0 to 59)
     , ctSec     :: Int         -- ^ Seconds (0 to 61, allowing for up to
                                -- two leap seconds)
     , ctPicosec :: Integer     -- ^ Picoseconds
     , ctWDay    :: Day         -- ^ Day of the week
     , ctYDay    :: Int         -- ^ Day of the year
                                -- (0 to 364, or 365 in leap years)
     , ctTZName  :: String      -- ^ Name of the time zone
     , ctTZ      :: Int         -- ^ Variation from UTC in seconds
     , ctIsDST   :: Bool        -- ^ 'True' if Daylight Savings Time would
                                -- be in effect, and 'False' otherwise
 }
 deriving (Eq,Ord,Read,Show)

-- | records the difference between two clock times in a user-readable way.

data TimeDiff
 = TimeDiff {
     tdYear    :: Int,
     tdMonth   :: Int,
     tdDay     :: Int,
     tdHour    :: Int,
     tdMin     :: Int,
     tdSec     :: Int,
     tdPicosec :: Integer -- not standard
   }
   deriving (Eq,Ord,Read,Show)

-- | null time difference.

noTimeDiff :: TimeDiff
noTimeDiff = TimeDiff 0 0 0 0 0 0 0

-- -----------------------------------------------------------------------------
-- | returns the current time in its internal representation.

realToInteger :: Real a => a -> Integer
realToInteger ct = round (realToFrac ct :: Double)
  -- CTime, CClock, CUShort etc are in Real but not Fractional,
  -- so we must convert to Double before we can round it

getClockTime :: IO ClockTime
#ifdef __HUGS__
getClockTime = do
  (sec,usec) <- getClockTimePrim
  return (TOD (fromIntegral sec) ((fromIntegral usec) * 1000000))

#elif HAVE_GETTIMEOFDAY

# if defined(mingw32_HOST_OS)
type Timeval_tv_sec = CLong
type Timeval_tv_usec = CLong
# else
type Timeval_tv_sec = CTime
type Timeval_tv_usec = CSUSeconds
# endif

getClockTime = do
  allocaBytes (#const sizeof(struct timeval)) $ \ p_timeval -> do
    throwErrnoIfMinus1_ "getClockTime" $ gettimeofday p_timeval nullPtr
    sec  <- (#peek struct timeval,tv_sec)  p_timeval :: IO Timeval_tv_sec
    usec <- (#peek struct timeval,tv_usec) p_timeval :: IO Timeval_tv_usec
    return (TOD (realToInteger sec) ((realToInteger usec) * 1000000))

#elif HAVE_FTIME
getClockTime = do
  allocaBytes (#const sizeof(struct timeb)) $ \ p_timeb -> do
  ftime p_timeb
  sec  <- (#peek struct timeb,time) p_timeb :: IO CTime
  msec <- (#peek struct timeb,millitm) p_timeb :: IO CUShort
  return (TOD (realToInteger sec) (fromIntegral msec * 1000000000))

#else /* use POSIX time() */
getClockTime = do
    secs <- time nullPtr -- can't fail, according to POSIX
    return (TOD (realToInteger secs) 0)

#endif

-- -----------------------------------------------------------------------------
-- | @'addToClockTime' d t@ adds a time difference @d@ and a
-- clock time @t@ to yield a new clock time.  The difference @d@
-- may be either positive or negative.

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' t1 t2@ returns the difference between two clock
-- times @t1@ and @t2@ as a 'TimeDiff'.

diffClockTimes  :: ClockTime -> ClockTime -> TimeDiff
-- diffClockTimes is meant to be the dual to `addToClockTime'.
-- If you want to have the TimeDiff properly splitted, use
-- `normalizeTimeDiff' on this function's result
--
-- CAVEAT: see comment of normalizeTimeDiff
diffClockTimes (TOD sa pa) (TOD sb pb) =
    noTimeDiff{ tdSec     = fromIntegral (sa - sb)
                -- FIXME: can handle just 68 years...
              , tdPicosec = pa - pb
              }


-- | converts a time difference to normal form.

normalizeTimeDiff :: TimeDiff -> TimeDiff
-- FIXME: handle psecs properly
-- FIXME: ?should be called by formatTimeDiff automagically?
--
-- when applied to something coming out of `diffClockTimes', you loose
-- the duality to `addToClockTime', since a year does not always have
-- 365 days, etc.
--
-- apply this function as late as possible to prevent those "rounding"
-- errors
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
        }

#ifndef __HUGS__
-- -----------------------------------------------------------------------------
-- How do we deal with timezones on this architecture?

-- The POSIX way to do it is through the global variable tzname[].
-- But that's crap, so we do it The BSD Way if we can: namely use the
-- tm_zone and tm_gmtoff fields of struct tm, if they're available.

zone   :: Ptr CTm -> IO (Ptr CChar)
gmtoff :: Ptr CTm -> IO CLong
#if HAVE_TM_ZONE
zone x      = (#peek struct tm,tm_zone) x
gmtoff x    = (#peek struct tm,tm_gmtoff) x

#else /* ! HAVE_TM_ZONE */
# if HAVE_TZNAME || defined(_WIN32)
#  if cygwin32_HOST_OS
#   define tzname _tzname
#  endif
#  ifndef mingw32_HOST_OS
foreign import ccall unsafe "time.h &tzname" tzname :: Ptr CString
#  else
foreign import ccall unsafe "__hscore_timezone" timezone :: Ptr CLong
foreign import ccall unsafe "__hscore_tzname"   tzname :: Ptr CString
#  endif
zone x = do
  dst <- (#peek struct tm,tm_isdst) x
  if dst then peekElemOff tzname 1 else peekElemOff tzname 0
# else /* ! HAVE_TZNAME */
-- We're in trouble. If you should end up here, please report this as a bug.
#  error "Don't know how to get at timezone name on your OS."
# endif /* ! HAVE_TZNAME */

-- Get the offset in secs from UTC, if (struct tm) doesn't supply it. */
# if HAVE_DECL_ALTZONE
foreign import ccall "&altzone"  altzone  :: Ptr CTime
foreign import ccall "&timezone" timezone :: Ptr CTime
gmtoff x = do
  dst <- (#peek struct tm,tm_isdst) x
  tz <- if dst then peek altzone else peek timezone
  return (-fromIntegral (realToInteger tz))
# else /* ! HAVE_DECL_ALTZONE */

#if !defined(mingw32_HOST_OS)
foreign import ccall "time.h &timezone" timezone :: Ptr CLong
#endif

-- Assume that DST offset is 1 hour ...
gmtoff x = do
  dst <- (#peek struct tm,tm_isdst) x
  tz  <- peek timezone
   -- According to the documentation for tzset(),
   --   http://www.opengroup.org/onlinepubs/007908799/xsh/tzset.html
   -- timezone offsets are > 0 west of the Prime Meridian.
   --
   -- This module assumes the interpretation of tm_gmtoff, i.e., offsets
   -- are > 0 East of the Prime Meridian, so flip the sign.
  return (- (if dst then tz - 3600 else tz))
# endif /* ! HAVE_DECL_ALTZONE */
#endif  /* ! HAVE_TM_ZONE */
#endif /* ! __HUGS__ */

-- -----------------------------------------------------------------------------
-- | converts an internal clock time to a local time, modified by the
-- timezone and daylight savings time settings in force at the time
-- of conversion.  Because of this dependence on the local environment,
-- 'toCalendarTime' is in the 'IO' monad.

toCalendarTime :: ClockTime -> IO CalendarTime
#ifdef __HUGS__
toCalendarTime =  toCalTime False
#elif HAVE_LOCALTIME_R
toCalendarTime =  clockToCalendarTime_reentrant (_throwAwayReturnPointer localtime_r) False
#else
toCalendarTime =  clockToCalendarTime_static localtime False
#endif

-- | converts an internal clock time into a 'CalendarTime' in standard
-- UTC format.

toUTCTime :: ClockTime -> CalendarTime
#ifdef __HUGS__
toUTCTime      =  unsafePerformIO . toCalTime True
#elif HAVE_GMTIME_R
toUTCTime      =  unsafePerformIO . clockToCalendarTime_reentrant (_throwAwayReturnPointer gmtime_r) True
#else
toUTCTime      =  unsafePerformIO . clockToCalendarTime_static gmtime True
#endif

#ifdef __HUGS__
toCalTime :: Bool -> ClockTime -> IO CalendarTime
toCalTime toUTC (TOD s psecs)
  | (s > fromIntegral (maxBound :: Int)) ||
    (s < fromIntegral (minBound :: Int))
  = error ((if toUTC then "toUTCTime: " else "toCalendarTime: ") ++
           "clock secs out of range")
  | otherwise = do
    (sec,min,hour,mday,mon,year,wday,yday,isdst,zone,off) <-
                toCalTimePrim (if toUTC then 1 else 0) (fromIntegral s)
    return (CalendarTime{ ctYear=1900+year
                        , ctMonth=toEnum mon
                        , ctDay=mday
                        , ctHour=hour
                        , ctMin=min
                        , ctSec=sec
                        , ctPicosec=psecs
                        , ctWDay=toEnum wday
                        , ctYDay=yday
                        , ctTZName=(if toUTC then "UTC" else zone)
                        , ctTZ=(if toUTC then 0 else off)
                        , ctIsDST=not toUTC && (isdst/=0)
                        })
#else /* ! __HUGS__ */
_throwAwayReturnPointer :: (Ptr CTime -> Ptr CTm -> IO (Ptr CTm))
                        -> (Ptr CTime -> Ptr CTm -> IO (       ))
_throwAwayReturnPointer fun x y = fun x y >> return ()

#if !HAVE_LOCALTIME_R || !HAVE_GMTIME_R
clockToCalendarTime_static :: (Ptr CTime -> IO (Ptr CTm)) -> Bool -> ClockTime
         -> IO CalendarTime
clockToCalendarTime_static fun is_utc (TOD secs psec) = do
  with (fromIntegral secs :: CTime)  $ \ p_timer -> do
    p_tm <- fun p_timer         -- can't fail, according to POSIX
    clockToCalendarTime_aux is_utc p_tm psec
#endif

#if HAVE_LOCALTIME_R || HAVE_GMTIME_R
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 (#const sizeof(struct tm)) $ \ p_tm -> do
      fun p_timer p_tm
      clockToCalendarTime_aux is_utc p_tm psec
#endif

clockToCalendarTime_aux :: Bool -> Ptr CTm -> Integer -> IO CalendarTime
clockToCalendarTime_aux is_utc p_tm psec = do
    sec   <-  (#peek struct tm,tm_sec  ) p_tm :: IO CInt
    minute <-  (#peek struct tm,tm_min  ) p_tm :: IO CInt
    hour  <-  (#peek struct tm,tm_hour ) p_tm :: IO CInt
    mday  <-  (#peek struct tm,tm_mday ) p_tm :: IO CInt
    mon   <-  (#peek struct tm,tm_mon  ) p_tm :: IO CInt
    year  <-  (#peek struct tm,tm_year ) p_tm :: IO CInt
    wday  <-  (#peek struct tm,tm_wday ) p_tm :: IO CInt
    yday  <-  (#peek struct tm,tm_yday ) p_tm :: IO CInt
    isdst <-  (#peek struct tm,tm_isdst) p_tm :: IO CInt
    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))
#endif /* ! __HUGS__ */

-- | converts a 'CalendarTime' into the corresponding internal
-- 'ClockTime', ignoring the contents of the  'ctWDay', 'ctYDay',
-- 'ctTZName' and 'ctIsDST' fields.

toClockTime :: CalendarTime -> ClockTime
#ifdef __HUGS__
toClockTime (CalendarTime yr mon mday hour min sec psec
                          _wday _yday _tzname tz _isdst) =
  unsafePerformIO $ do
    s <- toClockTimePrim (yr-1900) (fromEnum mon) mday hour min sec tz
    return (TOD (fromIntegral s) psec)
#else /* ! __HUGS__ */
toClockTime (CalendarTime year mon mday hour minute sec psec
                          _wday _yday _tzname tz _isdst) =

     -- `isDst' causes the date to be wrong by one hour...
     -- FIXME: check, whether this works on other arch's than Linux, too...
     --
     -- so we set it to (-1) (means `unknown') and let `mktime' determine
     -- the real value...
    let isDst = -1 :: CInt in   -- if _isdst then (1::Int) else 0

    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 (#const sizeof(struct tm)) $ \ p_tm -> do
        (#poke struct tm,tm_sec  ) p_tm (fromIntegral sec  :: CInt)
        (#poke struct tm,tm_min  ) p_tm (fromIntegral minute :: CInt)
        (#poke struct tm,tm_hour ) p_tm (fromIntegral hour :: CInt)
        (#poke struct tm,tm_mday ) p_tm (fromIntegral mday :: CInt)
        (#poke struct tm,tm_mon  ) p_tm (fromIntegral (fromEnum mon) :: CInt)
        (#poke struct tm,tm_year ) p_tm (fromIntegral year - 1900 :: CInt)
        (#poke struct tm,tm_isdst) p_tm isDst
        t <- throwIf (== -1) (\_ -> "Time.toClockTime: invalid input")
                (mktime p_tm)
        --
        -- mktime expects its argument to be in the local timezone, but
        -- toUTCTime makes UTC-encoded CalendarTime's ...
        --
        -- Since there is no any_tz_struct_tm-to-time_t conversion
        -- function, we have to fake one... :-) If not in all, it works in
        -- most cases (before, it was the other way round...)
        --
        -- Luckily, mktime tells us, what it *thinks* the timezone is, so,
        -- to compensate, we add the timezone difference to mktime's
        -- result.
        --
        gmtoffset <- gmtoff p_tm
        let res = realToInteger t - fromIntegral tz + fromIntegral gmtoffset
        return (TOD res psec)
#endif /* ! __HUGS__ */

-- -----------------------------------------------------------------------------
-- Converting time values to strings.

-- | formats calendar times using local conventions.

calendarTimeToString  :: CalendarTime -> String
calendarTimeToString  =  formatCalendarTime defaultTimeLocale "%c"

-- | formats calendar times using local conventions and a formatting string.
-- The formatting string is that understood by the ISO C @strftime()@
-- function.

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) -- padding not implemented
        doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
        doFmt ('%':c:cs)   = decode c ++ doFmt cs
        doFmt (c:cs) = c : doFmt cs
        doFmt "" = ""

        decode 'A' = fst (wDays l  !! fromEnum wday) -- day of the week, full name
        decode 'a' = snd (wDays l  !! fromEnum wday) -- day of the week, abbrev.
        decode 'B' = fst (months l !! fromEnum mon)  -- month, full name
        decode 'b' = snd (months l !! fromEnum mon)  -- month, abbrev
        decode 'h' = snd (months l !! fromEnum mon)  -- ditto
        decode 'C' = show2 (year `quot` 100)         -- century
        decode 'c' = doFmt (dateTimeFmt l)           -- locale's data and time format.
        decode 'D' = doFmt "%m/%d/%y"
        decode 'd' = show2 day                       -- day of the month
        decode 'e' = show2' day                      -- ditto, padded
        decode 'H' = show2 hour                      -- hours, 24-hour clock, padded
        decode 'I' = show2 (to12 hour)               -- hours, 12-hour clock
        decode 'j' = show3 (yday + 1)                -- day of the year
        decode 'k' = show2' hour                     -- hours, 24-hour clock, no padding
        decode 'l' = show2' (to12 hour)              -- hours, 12-hour clock, no padding
        decode 'M' = show2 minute                    -- minutes
        decode 'm' = show2 (fromEnum mon+1)          -- numeric month
        decode 'n' = "\n"
        decode 'p' = (if hour < 12 then fst else snd) (amPm l) -- am or pm
        decode 'R' = doFmt "%H:%M"
        decode 'r' = doFmt (time12Fmt l)
        decode 'T' = doFmt "%H:%M:%S"
        decode 't' = "\t"
        decode 'S' = show2 sec                       -- seconds
        decode 's' = let TOD esecs _ = toClockTime cal in show esecs
                                                     -- number of secs since Epoch.
        decode 'U' = show2 ((yday + 7 - fromEnum wday) `div` 7) -- week number, starting on Sunday.
        decode 'u' = show (let n = fromEnum wday in  -- numeric day of the week (1=Monday, 7=Sunday)
                           if n == 0 then 7 else n)
        decode 'V' =                                 -- week number (as per ISO-8601.)
            let (week, days) =                       -- [yep, I've always wanted to be able to display that too.]
                   (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' =                                 -- week number, weeks starting on monday
            show2 ((yday + 7 - if fromEnum wday > 0 then
                               fromEnum wday - 1 else 6) `div` 7)
        decode 'w' = show (fromEnum wday)            -- numeric day of the week, weeks starting on Sunday.
        decode 'X' = doFmt (timeFmt l)               -- locale's preferred way of printing time.
        decode 'x' = doFmt (dateFmt l)               -- locale's preferred way of printing dates.
        decode 'Y' = show year                       -- year, including century.
        decode 'y' = show2 (year `rem` 100)          -- year, within century.
        decode 'Z' = tzname'                         -- timezone name
        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'

-- Useful extensions for formatting TimeDiffs.

-- | formats time differences using local conventions.

timeDiffToString :: TimeDiff -> String
timeDiffToString = formatTimeDiff defaultTimeLocale "%c"

-- | formats time differences using local conventions and a formatting string.
-- The formatting string is that understood by the ISO C @strftime()@
-- function.

formatTimeDiff :: TimeLocale -> String -> TimeDiff -> String
formatTimeDiff l fmt (TimeDiff year month day hour minute sec _)
 = doFmt fmt
  where
   doFmt ""         = ""
   doFmt ('%':'-':cs) = doFmt ('%':cs) -- padding not implemented
   doFmt ('%':'_':cs) = doFmt ('%':cs) -- padding not implemented
   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 -- Implementation-dependent, sez the lib doc..
      '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

#ifndef __HUGS__
-- -----------------------------------------------------------------------------
-- Foreign time interface (POSIX)

type CTm = () -- struct tm

#if HAVE_LOCALTIME_R
foreign import ccall unsafe "HsTime.h __hscore_localtime_r"
    localtime_r :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
#else
foreign import ccall unsafe "time.h localtime"
    localtime   :: Ptr CTime -> IO (Ptr CTm)
#endif
#if HAVE_GMTIME_R
foreign import ccall unsafe "HsTime.h __hscore_gmtime_r"
    gmtime_r    :: Ptr CTime -> Ptr CTm -> IO (Ptr CTm)
#else
foreign import ccall unsafe "time.h gmtime"
    gmtime      :: Ptr CTime -> IO (Ptr CTm)
#endif
foreign import capi unsafe "time.h mktime"
    mktime      :: Ptr CTm   -> IO CTime

#if HAVE_GETTIMEOFDAY
type CTimeVal = ()
type CTimeZone = ()
foreign import ccall unsafe "HsTime.h __hscore_gettimeofday"
    gettimeofday :: Ptr CTimeVal -> Ptr CTimeZone -> IO CInt
#elif HAVE_FTIME
type CTimeB = ()
#ifndef mingw32_HOST_OS
foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO CInt
#else
foreign import ccall unsafe "time.h ftime" ftime :: Ptr CTimeB -> IO ()
#endif
#else
foreign import ccall unsafe "time.h time" time :: Ptr CTime -> IO CTime
#endif
#endif /* ! __HUGS__ */