-- | Provides access to the Olson zone-info database, using an adapted version of the Olson zone-info library.

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

#include "olson.h"

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 ()

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_name"
  c_name :: Ptr CZoneInfo -> IO (Ptr CChar)

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

    (#poke struct tm,tm_year) tm (fromIntegral year - 1900 :: CInt)
    (#poke struct tm,tm_mon) tm (fromIntegral mon - 1 :: CInt)
    (#poke struct tm,tm_mday) tm (fromIntegral mday :: CInt)
    return ()

  where
    (year, mon, mday) = toGregorian day

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

    year <- (#peek struct tm,tm_year) tm :: IO CInt
    mon <- (#peek struct tm,tm_mon) tm :: IO CInt
    mday <- (#peek struct tm,tm_mday) tm :: IO CInt

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

-- TimeOfDay

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

    (#poke struct tm,tm_hour) tm (fromIntegral hour :: CInt)
    (#poke struct tm,tm_min) tm (fromIntegral min' :: CInt)
    (#poke struct tm,tm_sec) tm (truncate sec :: CInt)

    return ()

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

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

    hour <- (#peek struct tm,tm_hour) tm :: IO CInt
    min' <- (#peek struct tm,tm_min) tm :: IO CInt
    sec <- (#peek struct tm,tm_sec) tm :: IO CInt

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

-- TimeZone

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

    isdst <- (#peek struct tm,tm_isdst) tm :: IO CInt
    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 (#const sizeof(struct tm)) $ \ tm -> do
                                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.

initZoneInfo :: Maybe String -> IO ()

initZoneInfo Nothing = do
    c_init nullPtr
    return ()

initZoneInfo (Just s) = do
    withCString s c_init
    return ()

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

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

-- | Create new 'ZoneInfo', given a suitable Olson specification.  If the
-- zone-info database cannot be found, or the time-zone not recognised, then
-- 'UTC' will be used.  This behaviour may be subject to change.

newZoneInfo :: String -> IO ZoneInfo
newZoneInfo s = do
    withCString s c_create >>= newZoneInfoFinalizer

-- | Convert 'ZoneInfo' to 'String'.

showZoneInfo :: ZoneInfo -> String
showZoneInfo zi =
    unsafePerformIO $ c_name zi' >>= peekCString
  where
    zi' = unsafeForeignPtrToPtr zi

-- | 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 (#const sizeof(struct tm)) $ \ tm -> do
      dayToCTm tm day
      timeOfDayToCTm tm tod
      (#poke struct tm,tm_isdst) tm (-1 :: CInt)
      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