module Data.Time.LocalTime.Internal.TimeZone
(
TimeZone(..)
, timeZoneOffsetString
, timeZoneOffsetString'
, timeZoneOffsetString''
, minutesToTimeZone
, hoursToTimeZone
, utc
, getTimeZone
, getCurrentTimeZone
) where
import Control.DeepSeq
import Data.Data
import Data.Time.Calendar.Private
import Data.Time.Clock.Internal.UTCTime
import Data.Time.Clock.POSIX
import Data.Time.Clock.System
import Foreign
import Foreign.C
data TimeZone = TimeZone
{ timeZoneMinutes :: Int
, timeZoneSummerOnly :: Bool
, timeZoneName :: String
} deriving (Eq, Ord, Data, Typeable)
instance NFData TimeZone where
rnf (TimeZone m so n) = rnf m `seq` rnf so `seq` rnf n `seq` ()
minutesToTimeZone :: Int -> TimeZone
minutesToTimeZone m = TimeZone m False ""
hoursToTimeZone :: Int -> TimeZone
hoursToTimeZone i = minutesToTimeZone (60 * i)
showT :: Bool -> PadOption -> Int -> String
showT False opt t = showPaddedNum opt ((div t 60) * 100 + (mod t 60))
showT True opt t = let
opt' =
case opt of
NoPad -> NoPad
Pad i c -> Pad (max 0 $ i 3) c
in showPaddedNum opt' (div t 60) ++ ":" ++ show2 (mod t 60)
timeZoneOffsetString'' :: Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' colon opt (TimeZone t _ _)
| t < 0 = '-' : (showT colon opt (negate t))
timeZoneOffsetString'' colon opt (TimeZone t _ _) = '+' : (showT colon opt t)
timeZoneOffsetString' :: Maybe Char -> TimeZone -> String
timeZoneOffsetString' Nothing = timeZoneOffsetString'' False NoPad
timeZoneOffsetString' (Just c) = timeZoneOffsetString'' False $ Pad 4 c
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString = timeZoneOffsetString'' False (Pad 4 '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
getTimeZoneCTime :: CTime -> IO TimeZone
getTimeZoneCTime ctime =
with
0
(\pdst ->
with
nullPtr
(\pcname -> do
secs <- get_current_timezone_seconds ctime 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)))
toCTime :: Int64 -> IO CTime
toCTime t = let
tt = fromIntegral t
t' = fromIntegral tt
in if t' == t
then return $ CTime tt
else fail "Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"
getTimeZoneSystem :: SystemTime -> IO TimeZone
getTimeZoneSystem t = do
ctime <- toCTime $ systemSeconds t
getTimeZoneCTime ctime
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone t = do
ctime <- toCTime $ floor $ utcTimeToPOSIXSeconds t
getTimeZoneCTime ctime
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone = getSystemTime >>= getTimeZoneSystem