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

module Data.Time.LocalTime.Internal.Foreign (
    getTimeZone,
    getCurrentTimeZone,
) where

import Data.Time.Clock.Internal.UTCTime
import Data.Time.Clock.POSIX
import Data.Time.Clock.System
import Data.Time.LocalTime.Internal.TimeZone
import Foreign
import Foreign.C
#if defined(javascript_HOST_ARCH)
import Data.Time.Calendar.Gregorian
import Data.Time.Clock.Internal.NominalDiffTime
import Data.Time.LocalTime.Internal.LocalTime
import Data.Time.LocalTime.Internal.TimeOfDay
#endif

#if defined(javascript_HOST_ARCH)

foreign import javascript "((dy,dm,dd,th,tm,ts) => { return new Date(dy,dm,dd,th,tm,ts).getTimezoneOffset(); })"
  js_get_timezone_minutes :: Int -> Int -> Int -> Int -> Int -> Int -> IO Int

get_timezone_minutes :: UTCTime -> IO Int
get_timezone_minutes ut = let
    lt :: LocalTime
    lt = utcToLocalTime utc ut
    in case lt of
        LocalTime (YearMonthDay dy dm dd) (TimeOfDay th tm ts) ->
            js_get_timezone_minutes (fromInteger dy) (pred dm) dd th tm (floor ts)

getTimeZoneCTime :: CTime -> IO TimeZone
getTimeZoneCTime ct = do
    let
        ut :: UTCTime
        ut = posixSecondsToUTCTime $ secondsToNominalDiffTime $ fromIntegral $ fromCTime ct
    mins <- get_timezone_minutes ut
    return $ TimeZone mins False ""

fromCTime :: CTime -> Int64
fromCTime (CTime tt) = fromIntegral tt

#else
{-# 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 -> IO TimeZone) -> IO TimeZone)
-> (Ptr CInt -> IO TimeZone) -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ \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) -> IO TimeZone) -> IO TimeZone)
-> (Ptr (Ptr CChar) -> IO TimeZone) -> IO TimeZone
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
pcname -> do
            secs <- CTime -> Ptr CInt -> Ptr (Ptr CChar) -> IO CLong
get_current_timezone_seconds CTime
ctime Ptr CInt
pdst Ptr (Ptr CChar)
pcname
            case secs of
                CLong
0x80000000 -> String -> IO TimeZone
forall a. HasCallStack => String -> IO a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"localtime_r failed"
                CLong
_ -> do
                    dst <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
pdst
                    cname <- peek pcname
                    name <- peekCString cname
                    return (TimeZone (div (fromIntegral secs) 60) (dst == 1) name)
#endif

-- 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. HasCallStack => String -> IO a
forall (m :: * -> *) a.
(MonadFail m, HasCallStack) =>
String -> m a
fail String
"Data.Time.LocalTime.Internal.TimeZone.toCTime: Overflow"

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

-- | Get the configured time-zone for a given time (varying as per summertime adjustments).
--
-- On Unix systems the output of this function depends on:
--
-- 1. The value of @TZ@ environment variable (if set)
--
-- 2. The system time zone (usually configured by @\/etc\/localtime@ symlink)
--
-- For details see tzset(3) and localtime(3).
--
-- Example:
--
-- @
-- > let t = `UTCTime` (`Data.Time.Calendar.fromGregorian` 2021 7 1) 0
-- > `getTimeZone` t
-- CEST
-- > `System.Environment.setEnv` \"TZ\" \"America/New_York\" >> `getTimeZone` t
-- EDT
-- > `System.Environment.setEnv` \"TZ\" \"Europe/Berlin\" >> `getTimeZone` t
-- CEST
-- @
--
-- On Windows systems the output of this function depends on:
--
-- 1. The value of @TZ@ environment variable (if set).
-- See [here](https://docs.microsoft.com/en-us/cpp/c-runtime-library/reference/tzset) for how Windows interprets this variable.
--
-- 2. The system time zone, configured in Settings
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone :: UTCTime -> IO TimeZone
getTimeZone UTCTime
t = do
    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
    getTimeZoneCTime ctime

-- | Get the configured time-zone for the current time.
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