{-# OPTIONS -fno-warn-unused-imports #-}
{-# LANGUAGE ForeignFunctionInterface #-}
#include "HsConfigure.h"
module Data.Time.LocalTime.Internal.TimeZone
(
TimeZone(..),timeZoneOffsetString,timeZoneOffsetString',timeZoneOffsetString'',minutesToTimeZone,hoursToTimeZone,utc,
getTimeZone,getCurrentTimeZone
) where
import Data.Time.Calendar.Private
import Data.Time.Clock.System
import Data.Time.Clock.POSIX
import Data.Time.Clock.Internal.UTCTime
#if __GLASGOW_HASKELL__ >= 709 || __GLASGOW_HASKELL__ < 702
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) = 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 :: PadOption -> Int -> String
showT opt t = showPaddedNum opt ((div t 60) * 100 + (mod t 60))
timeZoneOffsetString'' :: PadOption -> TimeZone -> String
timeZoneOffsetString'' opt (TimeZone t _ _) | t < 0 = '-':(showT opt (negate t))
timeZoneOffsetString'' opt (TimeZone t _ _) = '+':(showT opt t)
timeZoneOffsetString' :: Maybe Char -> TimeZone -> String
timeZoneOffsetString' Nothing = timeZoneOffsetString'' NoPad
timeZoneOffsetString' (Just c) = timeZoneOffsetString'' $ Pad 4 c
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString = timeZoneOffsetString'' (Pad 4 '0')
instance Show TimeZone where
show zone@(TimeZone _ _ "") = timeZoneOffsetString zone
show (TimeZone _ _ name) = name
utc :: TimeZone
utc = TimeZone 0 False "UTC"
{-# CFILES cbits/HsTime.c #-}
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