{-# LINE 1 "Data/Time/ZoneInfo.hsc" #-}
-- | Provides access to the Olson zone-info database, using an adapted version of the Olson zone-info library.
{-# LINE 2 "Data/Time/ZoneInfo.hsc" #-}

module Data.Time.ZoneInfo (
    ZoneInfo,
    initZoneInfo,
    utcZoneInfo,
    newZoneInfo,
    getZoneName,
    getZoneMinutes,
    posixToZonedTime,
    utcToZonedTime',
    localToPOSIXZoned,
    localToUTCZoned,
    convertTimeZone
) where


{-# LINE 18 "Data/Time/ZoneInfo.hsc" #-}

import Data.Fixed
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Data.Time.LocalTime

import Foreign
import Foreign.C

data CZoneInfo
type ZoneInfo = ForeignPtr CZoneInfo

-- Foreign ctime interface.

-- struct tm

type CTm = ()

foreign import ccall unsafe "olson_init"
  c_init :: CString -> IO CInt

foreign import ccall unsafe "olson_gmt"
  c_gmt :: IO (Ptr CZoneInfo)

foreign import ccall unsafe "olson_create"
  c_create :: CString -> IO (Ptr CZoneInfo)

foreign import ccall unsafe "&olson_destroy"
  c_destroy :: FunPtr (Ptr CZoneInfo -> IO ())

foreign import ccall unsafe "olson_localtime"
  c_localtime :: Ptr CZoneInfo -> Ptr CTime -> Ptr CTm -> IO (Ptr CTm)

foreign import ccall unsafe "olson_mktime"
  c_mktime :: Ptr CZoneInfo -> Ptr CTm -> IO CTime

foreign import ccall unsafe "olson_gmtoff"
  c_gmtoff :: Ptr CZoneInfo -> CInt -> IO CLong

foreign import ccall unsafe "olson_zone"
  c_zone :: Ptr CZoneInfo -> CInt -> IO (Ptr CChar)

-- Private conversions.

toPico :: Real a => a -> Pico -> Pico
toPico i =
    (+) (realToFrac i)

posixToUTCTime :: POSIXTime -> UTCTime
posixToUTCTime =
    posixSecondsToUTCTime

utcToPOSIXTime :: UTCTime -> POSIXTime
utcToPOSIXTime =
    utcTimeToPOSIXSeconds

cToPOSIXTime :: CTime -> Pico -> POSIXTime
cToPOSIXTime ct =
    realToFrac . toPico ct

-- Day

dayToCTm :: Ptr CTm -> Day -> IO ()
dayToCTm tm day = do

    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) tm (fromIntegral year - 1900 :: CInt)
{-# LINE 85 "Data/Time/ZoneInfo.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) tm (fromIntegral mon - 1 :: CInt)
{-# LINE 86 "Data/Time/ZoneInfo.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) tm (fromIntegral mday :: CInt)
{-# LINE 87 "Data/Time/ZoneInfo.hsc" #-}
    return ()

  where
    (year, mon, mday) = toGregorian day

ctmToDay :: Ptr CTm -> IO Day
ctmToDay tm = do

    year <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) tm :: IO CInt
{-# LINE 96 "Data/Time/ZoneInfo.hsc" #-}
    mon <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) tm :: IO CInt
{-# LINE 97 "Data/Time/ZoneInfo.hsc" #-}
    mday <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) tm :: IO CInt
{-# LINE 98 "Data/Time/ZoneInfo.hsc" #-}

    return $ fromGregorian (fromIntegral year + 1900)
              (fromIntegral mon + 1) (fromIntegral mday)

-- TimeOfDay

timeOfDayToCTm :: Ptr CTm -> TimeOfDay -> IO ()
timeOfDayToCTm tm tod = do

    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) tm (fromIntegral hour :: CInt)
{-# LINE 108 "Data/Time/ZoneInfo.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) tm (fromIntegral min' :: CInt)
{-# LINE 109 "Data/Time/ZoneInfo.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 0)) tm (truncate sec :: CInt)
{-# LINE 110 "Data/Time/ZoneInfo.hsc" #-}

    return ()

  where
    hour = todHour tod
    min' = todMin tod
    sec = todSec tod

ctmToTimeOfDay :: Ptr CTm -> Pico -> IO TimeOfDay
ctmToTimeOfDay tm psec = do

    hour <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) tm :: IO CInt
{-# LINE 122 "Data/Time/ZoneInfo.hsc" #-}
    min' <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) tm :: IO CInt
{-# LINE 123 "Data/Time/ZoneInfo.hsc" #-}
    sec <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) tm :: IO CInt
{-# LINE 124 "Data/Time/ZoneInfo.hsc" #-}

    return $ TimeOfDay (fromIntegral hour) (fromIntegral min')
               (toPico sec psec)

-- TimeZone

ctmToTimeZone :: Ptr CZoneInfo -> Ptr CTm -> IO TimeZone
ctmToTimeZone zi tm = do

    isdst <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) tm :: IO CInt
{-# LINE 134 "Data/Time/ZoneInfo.hsc" #-}
    gmtoff <- c_gmtoff zi isdst
    zone <- c_zone zi isdst >>= peekCString

    return $ TimeZone (fromIntegral $ div gmtoff 60) (isdst /= 0) zone

ctmToZonedTime :: Ptr CZoneInfo -> Ptr CTm -> Pico -> IO ZonedTime
ctmToZonedTime zi tm psec = do

    day <- ctmToDay tm
    tod <- ctmToTimeOfDay tm psec
    zone <- ctmToTimeZone zi tm

    return $ ZonedTime (LocalTime day tod) zone

-- CTime

ctimeToZonedTime :: Ptr CZoneInfo -> Ptr CTime -> Pico -> IO ZonedTime
ctimeToZonedTime zi ct psec = do
    allocaBytes (44) $ \ tm -> do
{-# LINE 153 "Data/Time/ZoneInfo.hsc" #-}
                                c_localtime zi ct tm
                                ctmToZonedTime zi tm psec

-- ZoneInfo finalizer.

newZoneInfoFinalizer :: Ptr CZoneInfo -> IO ZoneInfo
newZoneInfoFinalizer =
    newForeignPtr c_destroy

-- Exports.

-- | Initialise the zone-info library.  A path to the zone-info database may
-- be specified.  Otherwise, the TZDIR environment variable, or a reasonable
-- default, will be used.  An 'IOError' will be thrown on failure.

initZoneInfo :: Maybe String -> IO ()

initZoneInfo Nothing = do
    throwErrnoIf_ (< 0) "Data.Time.ZoneInfo.initZoneInfo" io
  where
    io = c_init nullPtr

initZoneInfo (Just s) = do
    throwErrnoIf_ (< 0) "Data.Time.ZoneInfo.initZoneInfo" io
  where
    io = withCString s c_init

-- | 'ZoneInfo' for the UTC time-zone.

utcZoneInfo :: ZoneInfo
utcZoneInfo =
    unsafePerformIO $ c_gmt >>= newZoneInfoFinalizer

-- | Create new 'ZoneInfo', given a suitable Olson identifier or time-zone
-- specification.  If the zone-info database cannot be found, or the time-zone
-- not recognised, then an 'IOError' will be thrown.

newZoneInfo :: String -> IO ZoneInfo
newZoneInfo s = do
    throwErrnoIfNull "Data.Time.ZoneInfo.newZoneInfo" io
    io >>= newZoneInfoFinalizer
  where
    io = withCString s c_create

-- | Returns the zone-name for either the standard or daylight saving zone,
-- depending on the 'isdst' argument.

getZoneName :: ZoneInfo -> Bool -> IO (String)
getZoneName zi isdst = do
    c_zone zi' isdst' >>= peekCString
  where
    zi' = unsafeForeignPtrToPtr zi
    isdst' = if isdst then 1 else 0

-- | Returns the UTC offset for either the standard or daylight saving zone,
-- depending on the 'isdst' argument.

getZoneMinutes :: ZoneInfo -> Bool -> IO Int
getZoneMinutes zi isdst = do

    tz <- c_gmtoff zi' isdst'
    return $ fromIntegral $ div tz 60

  where
    zi' = unsafeForeignPtrToPtr zi
    isdst' = if isdst then 1 else 0

-- | Convert from 'POSIXTime' to zoned 'LocalTime'.

posixToZonedTime :: ZoneInfo -> POSIXTime -> IO ZonedTime
posixToZonedTime zi pt = do

  -- "with" creates a Ptr CTime.

    with (fromInteger sec :: CTime) $ \ ct -> do
                           ctimeToZonedTime zi' ct (realToFrac psec)
  where
    zi' = unsafeForeignPtrToPtr zi
    (sec, psec) = divMod' pt 1

-- | Convert from 'UTCTime' to zoned 'LocalTime'.

utcToZonedTime' :: ZoneInfo -> UTCTime -> IO ZonedTime
utcToZonedTime' zi =
   posixToZonedTime zi . utcToPOSIXTime

-- | Convert 'LocalTime' to a daylight saving adjusted pair.

localToPOSIXZoned :: ZoneInfo -> LocalTime -> IO (POSIXTime, ZonedTime)
localToPOSIXZoned zi lt =
    allocaBytes (44) $ \ tm -> do
{-# LINE 244 "Data/Time/ZoneInfo.hsc" #-}
      dayToCTm tm day
      timeOfDayToCTm tm tod
      ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) tm (-1 :: CInt)
{-# LINE 247 "Data/Time/ZoneInfo.hsc" #-}
      ct <- c_mktime zi' tm
      zt <- ctmToZonedTime zi' tm psec
      return (cToPOSIXTime ct psec, zt)

  where
    zi' = unsafeForeignPtrToPtr zi
    day = localDay lt
    tod = localTimeOfDay lt
    sec = todSec tod
    psec = mod' sec 1

-- | Convert 'LocalTime' to a daylight saving adjusted pair.

localToUTCZoned :: ZoneInfo -> LocalTime -> IO (UTCTime, ZonedTime)
localToUTCZoned zi lt = do
    (pt, zi') <- localToPOSIXZoned zi lt
    return (posixToUTCTime pt, zi')

-- | Convert the 'LocalTime' argument from the source to destination
-- 'TimeZone'.

convertTimeZone :: ZoneInfo -> LocalTime -> ZoneInfo -> IO ZonedTime
convertTimeZone src lt dst = do
    (pt, _) <- localToPOSIXZoned src lt
    posixToZonedTime dst pt