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

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
    { -- | The number of minutes offset from UTC. Positive means local time will be later in the day than UTC.
      TimeZone -> Int
timeZoneMinutes :: Int
    , -- | Is this time zone just persisting for the summer?
      TimeZone -> Bool
timeZoneSummerOnly :: Bool
    , -- | The name of the zone, typically a three- or four-letter acronym.
      TimeZone -> String
timeZoneName :: String
    }
    deriving (TimeZone -> TimeZone -> Bool
(TimeZone -> TimeZone -> Bool)
-> (TimeZone -> TimeZone -> Bool) -> Eq TimeZone
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TimeZone -> TimeZone -> Bool
== :: TimeZone -> TimeZone -> Bool
$c/= :: TimeZone -> TimeZone -> Bool
/= :: 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
$ccompare :: TimeZone -> TimeZone -> Ordering
compare :: TimeZone -> TimeZone -> Ordering
$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
>= :: TimeZone -> TimeZone -> Bool
$cmax :: TimeZone -> TimeZone -> TimeZone
max :: TimeZone -> TimeZone -> TimeZone
$cmin :: TimeZone -> TimeZone -> TimeZone
min :: TimeZone -> TimeZone -> TimeZone
Ord, Typeable TimeZone
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 -> Constr
TimeZone -> DataType
(forall b. Data b => b -> b) -> TimeZone -> 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)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TimeZone -> c TimeZone
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TimeZone
$ctoConstr :: TimeZone -> Constr
toConstr :: TimeZone -> Constr
$cdataTypeOf :: TimeZone -> DataType
dataTypeOf :: TimeZone -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeZone)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TimeZone)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TimeZone)
$cgmapT :: (forall b. Data b => b -> b) -> TimeZone -> TimeZone
gmapT :: (forall b. Data b => b -> b) -> TimeZone -> TimeZone
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
gmapQl :: forall r r'.
(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
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TimeZone -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TimeZone -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> TimeZone -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeZone -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TimeZone -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TimeZone -> m TimeZone
gmapM :: forall (m :: * -> *).
Monad m =>
(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
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(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
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TimeZone -> m 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 () -> () -> ()
forall a b. a -> b -> b
`seq` Bool -> ()
forall a. NFData a => a -> ()
rnf Bool
so () -> () -> ()
forall a b. a -> b -> b
`seq` String -> ()
forall a. NFData a => a -> ()
rnf String
n () -> () -> ()
forall a b. a -> b -> b
`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 a. String -> IO a
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 a. a -> IO a
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)
                )
        )

-- there's no instance Bounded CTime, so this is the easiest way to check for overflow
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
     in if Int64
t' Int64 -> Int64 -> Bool
forall a. Eq a => a -> a -> Bool
== Int64
t
            then CTime -> IO CTime
forall a. a -> IO a
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 a. String -> IO a
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 b. Integral b => POSIXTime -> b
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 a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SystemTime -> IO TimeZone
getTimeZoneSystem