#include "HsConfigure.h"
module Data.Time.LocalTime.TimeZone
(
TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',minutesToTimeZone,hoursToTimeZone,utc,
getTimeZone,getCurrentTimeZone
) where
import Data.Time.Calendar.Private
import Data.Time.Clock
import Data.Time.Clock.POSIX
#if __GLASGOW_HASKELL__ >= 709
import Foreign
#else
import Foreign.Safe
#endif
import Foreign.C
import Control.DeepSeq
import Data.Typeable
#if LANGUAGE_Rank2Types
import Data.Data
#endif
data TimeZone = TimeZone {
timeZoneMinutes :: Int,
timeZoneSummerOnly :: Bool,
timeZoneName :: String
} deriving (Eq,Ord
#if LANGUAGE_DeriveDataTypeable
#if LANGUAGE_Rank2Types
,Data, Typeable
#endif
#endif
)
instance NFData TimeZone where
rnf (TimeZone m so n) = m `deepseq` so `deepseq` n `deepseq` ()
minutesToTimeZone :: Int -> TimeZone
minutesToTimeZone m = TimeZone m False ""
hoursToTimeZone :: Int -> TimeZone
hoursToTimeZone i = minutesToTimeZone (60 * i)
showT :: NumericPadOption -> Int -> String
showT opt t = show4 opt ((div t 60) * 100 + (mod t 60))
timeZoneOffsetString' :: NumericPadOption -> TimeZone -> String
timeZoneOffsetString' opt (TimeZone t _ _) | t < 0 = '-':(showT opt (negate t))
timeZoneOffsetString' opt (TimeZone t _ _) = '+':(showT opt t)
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString = timeZoneOffsetString' (Just '0')
instance Show TimeZone where
show zone@(TimeZone _ _ "") = timeZoneOffsetString zone
show (TimeZone _ _ name) = name
utc :: TimeZone
utc = TimeZone 0 False "UTC"
foreign import ccall unsafe "HsTime.h get_current_timezone_seconds" get_current_timezone_seconds :: CTime -> Ptr CInt -> Ptr CString -> IO CLong
posixToCTime :: POSIXTime -> CTime
posixToCTime = fromInteger . floor
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone time = with 0 (\pdst -> with nullPtr (\pcname -> do
secs <- get_current_timezone_seconds (posixToCTime (utcTimeToPOSIXSeconds time)) pdst pcname
case secs of
0x80000000 -> fail "localtime_r failed"
_ -> do
dst <- peek pdst
cname <- peek pcname
name <- peekCString cname
return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name)
))
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone = getCurrentTime >>= getTimeZone