{-# LANGUAGE Safe #-}
{-# LANGUAGE ForeignFunctionInterface #-}

module Data.Time.LocalTime.Internal.TimeZone
    (
    -- * Time zones
      TimeZone(..)
    , timeZoneOffsetString
    , timeZoneOffsetString'
    , timeZoneOffsetString''
    , minutesToTimeZone
    , hoursToTimeZone
    , utc
    -- getting the locale time zone
    , 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

-- | A TimeZone is a whole number of minutes offset from UTC, together with a name and a \"just for summer\" flag.
data TimeZone = TimeZone
    { TimeZone -> Int
timeZoneMinutes :: Int
    -- ^ The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.
    , TimeZone -> Bool
timeZoneSummerOnly :: Bool
    -- ^ Is this time zone just persisting for the summer?
    , TimeZone -> String
timeZoneName :: String
    -- ^ The name of the zone, typically a three- or four-letter acronym.
    } deriving (TimeZone -> TimeZone -> Bool
(TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> Bool) -> Eq TimeZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TimeZone -> TimeZone -> Bool
$c/= :: TimeZone -> TimeZone -> Bool
== :: TimeZone -> TimeZone -> Bool
$c== :: TimeZone -> TimeZone -> Bool
Eq, Eq TimeZone
Eq TimeZone
-> (TimeZone -> TimeZone -> Ordering)
-> (TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> TimeZone)
-> (TimeZone -> TimeZone -> TimeZone)
-> Ord TimeZone
TimeZone -> TimeZone -> Bool
TimeZone -> TimeZone -> Ordering
TimeZone -> TimeZone -> TimeZone
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TimeZone -> TimeZone -> TimeZone
$cmin :: TimeZone -> TimeZone -> TimeZone
max :: TimeZone -> TimeZone -> TimeZone
$cmax :: TimeZone -> TimeZone -> TimeZone
>= :: TimeZone -> TimeZone -> Bool
$c>= :: TimeZone -> TimeZone -> Bool
> :: TimeZone -> TimeZone -> Bool
$c> :: TimeZone -> TimeZone -> Bool
<= :: TimeZone -> TimeZone -> Bool
$c<= :: TimeZone -> TimeZone -> Bool
< :: TimeZone -> TimeZone -> Bool
$c< :: TimeZone -> TimeZone -> Bool
compare :: TimeZone -> TimeZone -> Ordering
$ccompare :: TimeZone -> TimeZone -> Ordering
$cp1Ord :: Eq TimeZone
Ord, Typeable TimeZone
DataType
Constr
Typeable TimeZone
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TimeZone -> c TimeZone)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TimeZone)
-> (TimeZone -> Constr)
-> (TimeZone -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TimeZone))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone))
-> ((forall b. Data b => b -> b) -> TimeZone -> TimeZone)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeZone -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TimeZone -> r)
-> (forall u. (forall d. Data d => d -> u) -> TimeZone -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> TimeZone -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone)
-> Data TimeZone
TimeZone -> DataType
TimeZone -> Constr
(forall b. Data b => b -> b) -> TimeZone -> TimeZone
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TimeZone -> u
forall u. (forall d. Data d => d -> u) -> TimeZone -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeZone)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone)
$cTimeZone :: Constr
$tTimeZone :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
gmapMp :: (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
gmapM :: (forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
gmapQi :: Int -> (forall d. Data d => d -> u) -> TimeZone -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeZone -> u
gmapQ :: (forall d. Data d => d -> u) -> TimeZone -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeZone -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
gmapT :: (forall b. Data b => b -> b) -> TimeZone -> TimeZone
$cgmapT :: (forall b. Data b => b -> b) -> TimeZone -> TimeZone
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TimeZone)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeZone)
dataTypeOf :: TimeZone -> DataType
$cdataTypeOf :: TimeZone -> DataType
toConstr :: TimeZone -> Constr
$ctoConstr :: TimeZone -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
$cp1Data :: Typeable TimeZone
Data, Typeable)

instance NFData TimeZone where
    rnf :: TimeZone -> ()
rnf (TimeZone Int
m Bool
so String
n) = Int -> ()
forall a. NFData a => a -> ()
rnf Int
m () -> () -> ()
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
so () -> () -> ()
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
n () -> () -> ()
`seq` ()

-- | Create a nameless non-summer timezone for this number of minutes.
minutesToTimeZone :: Int -> TimeZone
minutesToTimeZone :: Int -> TimeZone
minutesToTimeZone Int
m = Int -> Bool -> String -> TimeZone
TimeZone Int
m Bool
False String
""

-- | Create a nameless non-summer timezone for this number of hours.
hoursToTimeZone :: Int -> TimeZone
hoursToTimeZone :: Int -> TimeZone
hoursToTimeZone Int
i = Int -> TimeZone
minutesToTimeZone (Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
i)

showT :: Bool -> PadOption -> Int -> String
showT :: Bool -> PadOption -> Int -> String
showT Bool
False PadOption
opt Int
t = PadOption -> Int -> String
forall t. ShowPadded t => PadOption -> t -> String
showPaddedNum PadOption
opt ((Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
t Int
60) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
t Int
60))
showT Bool
True PadOption
opt Int
t = let
    opt' :: PadOption
opt' =
        case PadOption
opt of
            PadOption
NoPad -> PadOption
NoPad
            Pad Int
i Char
c -> Int -> Char -> PadOption
Pad (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) Char
c
    in PadOption -> Int -> String
forall t. ShowPadded t => PadOption -> t -> String
showPaddedNum PadOption
opt' (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div Int
t Int
60) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall t. ShowPadded t => t -> String
show2 (Int -> Int -> Int
forall a. Integral a => a -> a -> a
mod Int
t Int
60)

timeZoneOffsetString'' :: Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' :: Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' Bool
colon PadOption
opt (TimeZone Int
t Bool
_ String
_)
    | Int
t Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: (Bool -> PadOption -> Int -> String
showT Bool
colon PadOption
opt (Int -> Int
forall a. Num a => a -> a
negate Int
t))
timeZoneOffsetString'' Bool
colon PadOption
opt (TimeZone Int
t Bool
_ String
_) = Char
'+' Char -> String -> String
forall a. a -> [a] -> [a]
: (Bool -> PadOption -> Int -> String
showT Bool
colon PadOption
opt Int
t)

-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime), with arbitrary padding.
timeZoneOffsetString' :: Maybe Char -> TimeZone -> String
timeZoneOffsetString' :: Maybe Char -> TimeZone -> String
timeZoneOffsetString' Maybe Char
Nothing = Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' Bool
False PadOption
NoPad
timeZoneOffsetString' (Just Char
c) = Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' Bool
False (PadOption -> TimeZone -> String)
-> PadOption -> TimeZone -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> PadOption
Pad Int
4 Char
c

-- | Text representing the offset of this timezone, such as \"-0800\" or \"+0400\" (like @%z@ in formatTime).
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString :: TimeZone -> String
timeZoneOffsetString = Bool -> PadOption -> TimeZone -> String
timeZoneOffsetString'' Bool
False (Int -> Char -> PadOption
Pad Int
4 Char
'0')

-- | This only shows the time zone name, or offset if the name is empty.
instance Show TimeZone where
    show :: TimeZone -> String
show zone :: TimeZone
zone@(TimeZone Int
_ Bool
_ String
"") = TimeZone -> String
timeZoneOffsetString TimeZone
zone
    show (TimeZone Int
_ Bool
_ String
name) = String
name

-- | The UTC time zone.
utc :: TimeZone
utc :: TimeZone
utc = Int -> Bool -> String -> TimeZone
TimeZone Int
0 Bool
False String
"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 -> IO TimeZone
getTimeZoneCTime CTime
ctime =
    CInt -> (Ptr CInt -> IO TimeZone) -> IO TimeZone
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
        CInt
0
        (\Ptr CInt
pdst ->
             Ptr CChar -> (Ptr (Ptr CChar) -> IO TimeZone) -> IO TimeZone
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with
                 Ptr CChar
forall a. Ptr a
nullPtr
                 (\Ptr (Ptr CChar)
pcname -> do
                      CLong
secs <- CTime -> Ptr CInt -> Ptr (Ptr CChar) -> IO CLong
get_current_timezone_seconds CTime
ctime Ptr CInt
pdst Ptr (Ptr CChar)
pcname
                      case CLong
secs of
                          CLong
0x80000000 -> String -> IO TimeZone
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"localtime_r failed"
                          CLong
_ -> do
                              CInt
dst <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pdst
                              Ptr CChar
cname <- Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
pcname
                              String
name <- Ptr CChar -> IO String
peekCString Ptr CChar
cname
                              TimeZone -> IO TimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Bool -> String -> TimeZone
TimeZone (Int -> Int -> Int
forall a. Integral a => a -> a -> a
div (CLong -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CLong
secs) Int
60) (CInt
dst CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
1) String
name)))

toCTime :: Int64 -> IO CTime
toCTime :: Int64 -> IO CTime
toCTime Int64
t = let
    tt :: Int64
tt = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
t
    t' :: Int64
t' = Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
tt
    -- there's no instance Bounded CTime, so this is the easiest way to check for overflow
    in if Int64
t' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
t
           then CTime -> IO CTime
forall (m :: * -> *) a. Monad m => a -> m a
return (CTime -> IO CTime) -> CTime -> IO CTime
forall a b. (a -> b) -> a -> b
$ Int64 -> CTime
CTime Int64
tt
           else String -> IO CTime
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"

-- | Get the local time-zone for a given time (varying as per summertime adjustments).
getTimeZoneSystem :: SystemTime -> IO TimeZone
getTimeZoneSystem :: SystemTime -> IO TimeZone
getTimeZoneSystem SystemTime
t = do
    CTime
ctime <- Int64 -> IO CTime
toCTime (Int64 -> IO CTime) -> Int64 -> IO CTime
forall a b. (a -> b) -> a -> b
$ SystemTime -> Int64
systemSeconds SystemTime
t
    CTime -> IO TimeZone
getTimeZoneCTime CTime
ctime

-- | Get the local time-zone for a given time (varying as per summertime adjustments).
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone UTCTime
t = do
    CTime
ctime <- Int64 -> IO CTime
toCTime (Int64 -> IO CTime) -> Int64 -> IO CTime
forall a b. (a -> b) -> a -> b
$ POSIXTime -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
floor (POSIXTime -> Int64) -> POSIXTime -> Int64
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t
    CTime -> IO TimeZone
getTimeZoneCTime CTime
ctime

-- | Get the current time-zone.
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone :: IO TimeZone
getCurrentTimeZone = IO SystemTime
getSystemTime IO SystemTime -> (SystemTime -> IO TimeZone) -> IO TimeZone
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SystemTime -> IO TimeZone
getTimeZoneSystem