---------------------------------------------------------------
-- Copyright (c) 2013, Enzo Haussecker. All rights reserved. --
---------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable     #-}
{-# LANGUAGE DeriveGeneric          #-}
{-# LANGUAGE MultiParamTypeClasses  #-}
{-# LANGUAGE MultiWayIf             #-}
{-# LANGUAGE NamedFieldPuns         #-}
{-# LANGUAGE RecordWildCards        #-}
{-# LANGUAGE TemplateHaskell        #-}
{-# OPTIONS -Wall                   #-}
{-# OPTIONS -fno-warn-type-defaults #-}

-- | Types and functions for local timestamps.
module Data.Time.Exts.Local (

  -- * Local Class
       Local

  -- * Local Timestamps
     , LocalDate(..)
     , LocalDateTime(..)
     , LocalDateTimeMillis(..)
     , LocalDateTimeMicros(..)
     , LocalDateTimeNanos(..)
     , LocalDateTimePicos(..)

  -- * Create Local Timestamps
     , createLocalDate
     , createLocalDateTime
     , createLocalDateTimeMillis
     , createLocalDateTimeMicros
     , createLocalDateTimeNanos
     , createLocalDateTimePicos

  -- * Get Current Local Timestamps
     , getCurrentLocalDate
     , getCurrentLocalDateTime
     , getCurrentLocalDateTimeMillis
     , getCurrentLocalDateTimeMicros
     , getCurrentLocalDateTimeNanos
     , getCurrentLocalDateTimePicos

  --   Get Current Local Timestamps Using Preloaded Transition Times
     , getCurrentLocalDate'
     , getCurrentLocalDateTime'
     , getCurrentLocalDateTimeMillis'
     , getCurrentLocalDateTimeMicros'
     , getCurrentLocalDateTimeNanos'
     , getCurrentLocalDateTimePicos'

  -- * Transition Times
     , TransitionTimes
     , getTransitionTimes

  -- * Base Conversions
     , baseUnixToUTC
     , baseUTCToUnix

     ) where

import Control.Arrow ((***))
import Control.DeepSeq (NFData)
import Data.Aeson (FromJSON, ToJSON)
import Data.Convertible (Convertible(..), convert)
import Data.Function (on)
import Data.Int (Int16, Int32, Int64)
import Data.Label (get, mkLabels, modify, set)
import Data.List (groupBy, sortBy)
import Data.Maybe (listToMaybe)
import Data.Monoid ((<>))
import Data.Ord (comparing)
import Data.Time (UTCTime(..))
import qualified Data.Time.Calendar as Calendar (Day(..))
import Data.Time.Exts.Base
import Data.Time.Exts.Unix
import Data.Time.Exts.Zone
import Data.Time.LocalTime.TimeZone.Olson
import Data.Typeable (Typeable)
import Foreign.Ptr (plusPtr)
import Foreign.Storable (Storable(..))
import GHC.Generics (Generic)
import System.Random (Random(..))
import Text.Printf (printf)

-- | A class of local timestamps.
class Local x

-- | A local date.
data LocalDate = LocalDate {
    _loc_day_base :: {-# UNPACK #-} !Int32 -- ^ days since Unix epoch
  , _loc_day_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A local date and time.
data LocalDateTime = LocalDateTime {
    _loc_sec_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds)
  , _loc_sec_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A local date and time with millisecond granularity.
data LocalDateTimeMillis = LocalDateTimeMillis {
    _loc_mil_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds)
  , _loc_mil_mill :: {-# UNPACK #-} !Int16 -- ^ milliseconds
  , _loc_mil_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A local date and time with microsecond granularity.
data LocalDateTimeMicros = LocalDateTimeMicros {
    _loc_mic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds)
  , _loc_mic_micr :: {-# UNPACK #-} !Int32 -- ^ microseconds
  , _loc_mic_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A local date and time with nanosecond granularity.
data LocalDateTimeNanos = LocalDateTimeNanos {
    _loc_nan_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds)
  , _loc_nan_nano :: {-# UNPACK #-} !Int32 -- ^ nanoseconds
  , _loc_nan_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A local date and time with picosecond granularity.
data LocalDateTimePicos = LocalDateTimePicos {
    _loc_pic_base :: {-# UNPACK #-} !Int64 -- ^ seconds since Unix epoch (including leap seconds)
  , _loc_pic_pico :: {-# UNPACK #-} !Int64 -- ^ picoseconds
  , _loc_pic_zone :: {-# UNPACK #-} !Int16 -- ^ enumerated time zone
  } deriving (Eq,Generic,Typeable)

-- | A list of transition times.
type TransitionTimes = [LocalDateTime]

mkLabels [''LocalDate
         ,''LocalDateTime
         ,''LocalDateTimeMillis
         ,''LocalDateTimeMicros
         ,''LocalDateTimeNanos
         ,''LocalDateTimePicos
         ]

instance Bounded LocalDate where
    minBound = LocalDate 0000000 00
    maxBound = LocalDate 2932896 51

instance Bounded LocalDateTime where
    minBound = LocalDateTime 000000043200 00
    maxBound = LocalDateTime 253402257624 51

instance Bounded LocalDateTimeMillis where
    minBound = LocalDateTimeMillis 000000043200 000000000000 00
    maxBound = LocalDateTimeMillis 253402257624 000000000999 51

instance Bounded LocalDateTimeMicros where
    minBound = LocalDateTimeMicros 000000043200 000000000000 00
    maxBound = LocalDateTimeMicros 253402257624 000000999999 51

instance Bounded LocalDateTimeNanos where
    minBound = LocalDateTimeNanos  000000043200 000000000000 00
    maxBound = LocalDateTimeNanos  253402257624 000999999999 51

instance Bounded LocalDateTimePicos where
    minBound = LocalDateTimePicos  000000043200 000000000000 00
    maxBound = LocalDateTimePicos  253402257624 999999999999 51

instance Convertible LocalDateTime LocalDate where
    safeConvert = Right . \ LocalDateTime{..} ->
      flip LocalDate _loc_sec_zone . fst $ decompUTCBase _loc_sec_base _loc_sec_zone

instance Convertible LocalDate Calendar.Day where
    safeConvert LocalDate{..} = Right days
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            base = _loc_day_base

instance Convertible LocalDateTime UTCTime where
    safeConvert LocalDateTime{..} = Right $ UTCTime days pico
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            pico = fromIntegral secs
            (base, secs) = decompUTCBase _loc_sec_base _loc_sec_zone

instance Convertible LocalDateTimeMillis UTCTime where
    safeConvert LocalDateTimeMillis{..} = Right $ UTCTime days pico
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            pico = fromIntegral secs + fromIntegral _loc_mil_mill / 1000
            (base, secs) = decompUTCBase _loc_mil_base _loc_mil_zone

instance Convertible LocalDateTimeMicros UTCTime where
    safeConvert LocalDateTimeMicros{..} = Right $ UTCTime days pico
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            pico = fromIntegral secs + fromIntegral _loc_mic_micr / 1000000
            (base, secs) = decompUTCBase _loc_mic_base _loc_mic_zone

instance Convertible LocalDateTimeNanos UTCTime where
    safeConvert LocalDateTimeNanos{..} = Right $ UTCTime days pico
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            pico = fromIntegral secs + fromIntegral _loc_nan_nano / 1000000000
            (base, secs) = decompUTCBase _loc_nan_base _loc_nan_zone

instance Convertible LocalDateTimePicos UTCTime where
    safeConvert LocalDateTimePicos{..} = Right $ UTCTime days pico
      where days = Calendar.ModifiedJulianDay $ toInteger base + 40587
            pico = fromIntegral secs + fromIntegral _loc_pic_pico / 1000000000000
            (base, secs) = decompUTCBase _loc_pic_base _loc_pic_zone

instance Convertible Calendar.Day LocalDate where
    safeConvert Calendar.ModifiedJulianDay{..} = Right $ LocalDate base 17
      where base = fromInteger toModifiedJulianDay - 40587

instance Convertible UTCTime LocalDateTime where
    safeConvert UTCTime{..} = Right $ LocalDateTime base 17
      where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587
            base = baseUnixToUTC $ days * 86400 + truncate utctDayTime

instance Convertible UTCTime LocalDateTimeMillis where
    safeConvert UTCTime{..} = Right $ LocalDateTimeMillis base mill 17
      where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587
            base = baseUnixToUTC $ days * 86400 + sec
            mill = truncate $ frac * 1000
            (sec, frac) = properFraction utctDayTime

instance Convertible UTCTime LocalDateTimeMicros where
    safeConvert UTCTime{..} = Right $ LocalDateTimeMicros base micr 17
      where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587
            base = baseUnixToUTC $ days * 86400 + sec
            micr = truncate $ frac * 1000000
            (sec, frac) = properFraction utctDayTime

instance Convertible UTCTime LocalDateTimeNanos where
    safeConvert UTCTime{..} = Right $ LocalDateTimeNanos base nano 17
      where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587
            base = baseUnixToUTC $ days * 86400 + sec
            nano = truncate $ frac * 1000000000
            (sec, frac) = properFraction utctDayTime

instance Convertible UTCTime LocalDateTimePicos where
    safeConvert UTCTime{..} = Right $ LocalDateTimePicos base pico 17
      where days = fromInteger (Calendar.toModifiedJulianDay utctDay) - 40587
            base = baseUnixToUTC $ days * 86400 + sec
            pico = truncate $ frac * 1000000000000
            (sec, frac) = properFraction utctDayTime

instance DateZone LocalDate where
    toDateZoneStruct = decompLocalDate
    fromDateZoneStruct DateZoneStruct{..} =
      createLocalDate _dz_year _dz_mon _dz_mday _dz_zone

instance DateTimeZone LocalDateTime where
    toDateTimeZoneStruct = decompLocalDateTime
    fromDateTimeZoneStruct DateTimeZoneStruct{..} =
      createLocalDateTime _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec _dtz_zone
      where sec = round _dtz_sec :: Second

instance DateTimeZone LocalDateTimeMillis where
    toDateTimeZoneStruct = decompLocalDateTimeMillis
    fromDateTimeZoneStruct DateTimeZoneStruct{..} =
      createLocalDateTimeMillis _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mil _dtz_zone
      where (sec, mil) = properFracMillis _dtz_sec

instance DateTimeZone LocalDateTimeMicros where
    toDateTimeZoneStruct = decompLocalDateTimeMicros
    fromDateTimeZoneStruct DateTimeZoneStruct{..} =
      createLocalDateTimeMicros _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mic _dtz_zone
      where (sec, mic) = properFracMicros _dtz_sec

instance DateTimeZone LocalDateTimeNanos where
    toDateTimeZoneStruct = decompLocalDateTimeNanos
    fromDateTimeZoneStruct DateTimeZoneStruct{..} =
      createLocalDateTimeNanos _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec nan _dtz_zone
      where (sec, nan) = properFracNanos _dtz_sec

instance DateTimeZone LocalDateTimePicos where
    toDateTimeZoneStruct = decompLocalDateTimePicos
    fromDateTimeZoneStruct DateTimeZoneStruct{..} =
      createLocalDateTimePicos _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec pic _dtz_zone
      where (sec, pic) = properFracPicos _dtz_sec

instance DateTimeMath LocalDate Day where
    timestamp `plus` days =
      if minBound <= date && date <= maxBound
      then date else error "plus: out of range"
      where date = modify loc_day_base (+ fromIntegral days) timestamp

instance DateTimeMath LocalDateTime Second where
    timestamp `plus` secs =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where time = modify loc_sec_base (+ fromIntegral secs) timestamp

instance DateTimeMath LocalDateTimeMillis Second where
    timestamp `plus` secs =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where time = modify loc_mil_base (+ fromIntegral secs) timestamp

instance DateTimeMath LocalDateTimeMicros Second where
    timestamp `plus` secs =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where time = modify loc_mic_base (+ fromIntegral secs) timestamp

instance DateTimeMath LocalDateTimeNanos Second where
    timestamp `plus` secs =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where time = modify loc_nan_base (+ fromIntegral secs) timestamp

instance DateTimeMath LocalDateTimePicos Second where
    timestamp `plus` secs =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where time = modify loc_pic_base (+ fromIntegral secs) timestamp

instance DateTimeMath LocalDateTimeMillis Millis where
    timestamp `plus` mils =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where msum = fromIntegral (get loc_mil_mill timestamp) + fromIntegral mils
            base = modify loc_mil_base (+ msum `div` 1000) timestamp
            time = set loc_mil_mill (fromIntegral $ msum `mod` 1000) base

instance DateTimeMath LocalDateTimeMicros Millis where
    timestamp `plus` mils =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where msum = fromIntegral (get loc_mic_micr timestamp) + fromIntegral mils * 1000
            base = modify loc_mic_base (+ msum `div` 1000000) timestamp
            time = set loc_mic_micr (fromIntegral $ msum `mod` 1000000) base

instance DateTimeMath LocalDateTimeNanos Millis where
    timestamp `plus` mils =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where nsum = fromIntegral (get loc_nan_nano timestamp) + fromIntegral mils * 1000000
            base = modify loc_nan_base (+ nsum `div` 1000000000) timestamp
            time = set loc_nan_nano (fromIntegral $ nsum `mod` 1000000000) base

instance DateTimeMath LocalDateTimePicos Millis where
    timestamp `plus` mils =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where psum = fromIntegral (get loc_pic_pico timestamp) + fromIntegral mils * 1000000000
            base = modify loc_pic_base (+ psum `div` 1000000000000) timestamp
            time = set loc_pic_pico (fromIntegral $ psum `mod` 1000000000000) base

instance DateTimeMath LocalDateTimeMicros Micros where
    timestamp `plus` mics =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where msum = fromIntegral (get loc_mic_micr timestamp) + fromIntegral mics
            base = modify loc_mic_base (+ msum `div` 1000000) timestamp
            time = set loc_mic_micr (fromIntegral $ msum `mod` 1000000) base

instance DateTimeMath LocalDateTimeNanos Micros where
    timestamp `plus` mics =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where nsum = fromIntegral (get loc_nan_nano timestamp) + fromIntegral mics * 1000
            base = modify loc_nan_base (+ nsum `div` 1000000000) timestamp
            time = set loc_nan_nano (fromIntegral $ nsum `mod` 1000000000) base

instance DateTimeMath LocalDateTimePicos Micros where
    timestamp `plus` mics =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where psum = fromIntegral (get loc_pic_pico timestamp) + fromIntegral mics * 1000000
            base = modify loc_pic_base (+ psum `div` 1000000000000) timestamp
            time = set loc_pic_pico (fromIntegral $ psum `mod` 1000000000000) base

instance DateTimeMath LocalDateTimeNanos Nanos where
    timestamp `plus` nans =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where nsum = fromIntegral (get loc_nan_nano timestamp) + fromIntegral nans
            base = modify loc_nan_base (+ nsum `div` 1000000000) timestamp
            time = set loc_nan_nano (fromIntegral $ nsum `mod` 1000000000) base

instance DateTimeMath LocalDateTimePicos Nanos where
    timestamp `plus` nans =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where psum = fromIntegral (get loc_pic_pico timestamp) + fromIntegral nans * 1000
            base = modify loc_pic_base (+ psum `div` 1000000000000) timestamp
            time = set loc_pic_pico (fromIntegral $ psum `mod` 1000000000000) base

instance DateTimeMath LocalDateTimePicos Picos where
    timestamp `plus` pics =
      if minBound <= time && time <= maxBound
      then time else error "plus: out of range"
      where psum = fromIntegral (get loc_pic_pico timestamp) + fromIntegral pics
            base = modify loc_pic_base (+ psum `div` 1000000000000) timestamp
            time = set loc_pic_pico (fromIntegral $ psum `mod` 1000000000000) base

instance FromJSON LocalDate
instance FromJSON LocalDateTime
instance FromJSON LocalDateTimeMillis
instance FromJSON LocalDateTimeMicros
instance FromJSON LocalDateTimeNanos
instance FromJSON LocalDateTimePicos

instance Local LocalDate
instance Local LocalDateTime
instance Local LocalDateTimeMillis
instance Local LocalDateTimeMicros
instance Local LocalDateTimeNanos
instance Local LocalDateTimePicos

instance NFData LocalDate
instance NFData LocalDateTime
instance NFData LocalDateTimeMillis
instance NFData LocalDateTimeMicros
instance NFData LocalDateTimeNanos
instance NFData LocalDateTimePicos

instance Ord LocalDate           where
    compare = comparing _loc_day_base

instance Ord LocalDateTime       where
    compare = comparing _loc_sec_base

instance Ord LocalDateTimeMillis where
    compare = comparing _loc_mil_base
           <> comparing _loc_mil_mill

instance Ord LocalDateTimeMicros where
    compare = comparing _loc_mic_base
           <> comparing _loc_mic_micr

instance Ord LocalDateTimeNanos  where
    compare = comparing _loc_nan_base
           <> comparing _loc_nan_nano

instance Ord LocalDateTimePicos  where
    compare = comparing _loc_pic_base
           <> comparing _loc_pic_pico

instance Pretty LocalDate           where pretty = prettyLocalDate
instance Pretty LocalDateTime       where pretty = prettyLocalDateTime
instance Pretty LocalDateTimeMillis where pretty = prettyLocalDateTime
instance Pretty LocalDateTimeMicros where pretty = prettyLocalDateTime
instance Pretty LocalDateTimeNanos  where pretty = prettyLocalDateTime
instance Pretty LocalDateTimePicos  where pretty = prettyLocalDateTime

instance Random LocalDate where
    random g =
      case randomR (0, 2932896) g  of { (base, g' ) ->
      case randomR (0, 0000051) g' of { (zone, g'') -> (LocalDate base zone, g'') } }
    randomR (a, b) g =
      case randomR (_loc_day_base a, _loc_day_base b) g  of { (base, g' ) ->
      case randomR (_loc_day_zone a, _loc_day_zone b) g' of { (zone, g'') -> (LocalDate base zone, g'') } }

instance Random LocalDateTime where
    random g =
      case randomR (43200, 253402257624) g  of { (base, g' ) ->
      case randomR (00000, 000000000051) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } }
    randomR (a, b) g =
      case randomR (_loc_sec_base a, _loc_sec_base b) g  of { (base, g' ) ->
      case randomR (_loc_sec_zone a, _loc_sec_zone b) g' of { (zone, g'') -> (LocalDateTime base zone, g'') } }

instance Random LocalDateTimeMillis where
    random g =
      case randomR (43200, 253402257624) g   of { (base, g'  ) ->
      case randomR (43200, 000000000999) g'  of { (mill, g'' ) ->
      case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeMillis base mill zone, g''') } } }
    randomR (a, b) g =
      case randomR (minTime, maxTime) g  of { (base_mill, g' ) -> 
      case randomR (minZone, maxZone) g' of { (zone     , g'') ->
        let (base, mill) = (***) fromInteger fromInteger $ divMod base_mill 1000
        in  (LocalDateTimeMillis base mill zone, g'') } }
        where minTime = toInteger (_loc_mil_mill a) + toInteger (_loc_mil_base a) * 1000
              maxTime = toInteger (_loc_mil_mill b) + toInteger (_loc_mil_base b) * 1000
              minZone = _loc_mil_zone a
              maxZone = _loc_mil_zone b

instance Random LocalDateTimeMicros where
    random g =
      case randomR (43200, 253402257624) g   of { (base, g'  ) ->
      case randomR (43200, 000000999999) g'  of { (micr, g'' ) ->
      case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeMicros base micr zone, g''') } } }
    randomR (a, b) g =
      case randomR (minTime, maxTime) g  of { (base_micr, g' ) -> 
      case randomR (minZone, maxZone) g' of { (zone     , g'') ->
        let (base, micr) = (***) fromInteger fromInteger $ divMod base_micr 1000000
        in  (LocalDateTimeMicros base micr zone, g'') } }
        where minTime = toInteger (_loc_mic_micr a) + toInteger (_loc_mic_base a) * 1000000
              maxTime = toInteger (_loc_mic_micr b) + toInteger (_loc_mic_base b) * 1000000
              minZone = _loc_mic_zone a
              maxZone = _loc_mic_zone b

instance Random LocalDateTimeNanos where
    random g =
      case randomR (43200, 253402257624) g   of { (base, g'  ) ->
      case randomR (43200, 000999999999) g'  of { (nano, g'' ) ->
      case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimeNanos base nano zone, g''') } } }
    randomR (a, b) g =
      case randomR (minTime, maxTime) g  of { (base_nano, g' ) -> 
      case randomR (minZone, maxZone) g' of { (zone     , g'') ->
        let (base, nano) = (***) fromInteger fromInteger $ divMod base_nano 1000000000
        in  (LocalDateTimeNanos base nano zone, g'') } }
        where minTime = toInteger (_loc_nan_nano a) + toInteger (_loc_nan_base a) * 1000000000
              maxTime = toInteger (_loc_nan_nano b) + toInteger (_loc_nan_base b) * 1000000000
              minZone = _loc_nan_zone a
              maxZone = _loc_nan_zone b

instance Random LocalDateTimePicos where
    random g =
      case randomR (43200, 253402257624) g   of { (base, g'  ) ->
      case randomR (43200, 999999999999) g'  of { (pico, g'' ) ->
      case randomR (00000, 000000000051) g'' of { (zone, g''') -> (LocalDateTimePicos base pico zone, g''') } } }
    randomR (a, b) g =
      case randomR (minTime, maxTime) g  of { (base_pico, g' ) -> 
      case randomR (minZone, maxZone) g' of { (zone     , g'') ->
        let (base, pico) = (***) fromInteger fromInteger $ divMod base_pico 1000000000000
        in  (LocalDateTimePicos base pico zone, g'') } }
        where minTime = toInteger (_loc_pic_pico a) + toInteger (_loc_pic_base a) * 1000000000000
              maxTime = toInteger (_loc_pic_pico b) + toInteger (_loc_pic_base b) * 1000000000000
              minZone = _loc_pic_zone a
              maxZone = _loc_pic_zone b

instance Show LocalDate where
    show date = printf str _dz_year _dz_mon _dz_mday abbr
      where DateZoneStruct{..} = toDateZoneStruct date
            str  = "%04d-%02d-%02d %s"
            abbr = show (convert _dz_zone :: TimeZoneAbbr)

instance Show LocalDateTime where
    show time = printf str _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec abbr
      where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
            str  = "%04d-%02d-%02d %02d:%02d:%02d %s"
            abbr = show (convert _dtz_zone :: TimeZoneAbbr)
            sec  = round _dtz_sec :: Second

instance Show LocalDateTimeMillis where
    show time = printf str _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mil abbr
      where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
            str  = "%04d-%02d-%02d %02d:%02d:%02d.%03d %s"
            abbr = show (convert _dtz_zone :: TimeZoneAbbr)
            (sec, mil) = properFracMillis _dtz_sec

instance Show LocalDateTimeMicros where
    show time = printf str _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec mic abbr
      where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
            str  = "%04d-%02d-%02d %02d:%02d:%02d.%06d %s"
            abbr = show (convert _dtz_zone :: TimeZoneAbbr)
            (sec , mic) = properFracMicros _dtz_sec

instance Show LocalDateTimeNanos where
    show time = printf str _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec nan abbr
      where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
            str  = "%04d-%02d-%02d %02d:%02d:%02d.%09d %s"
            abbr = show (convert _dtz_zone :: TimeZoneAbbr)
            (sec, nan) = properFracNanos _dtz_sec

instance Show LocalDateTimePicos where
    show time = printf str _dtz_year _dtz_mon _dtz_mday _dtz_hour _dtz_min sec pic abbr
      where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
            str  = "%04d-%02d-%02d %02d:%02d:%02d.%012d %s"
            abbr = show (convert _dtz_zone :: TimeZoneAbbr)
            (sec, pic) = properFracPicos _dtz_sec

instance Storable LocalDate where
    sizeOf  _ = 06
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 06 * n
      base <- peek . plusPtr ptr $ off
      zone <- peek . plusPtr ptr $ off + 04
      return $! LocalDate base zone
    pokeElemOff ptr  n LocalDate{..} = do
      let off = 06 * n
      poke (plusPtr ptr $ off     ) _loc_day_base
      poke (plusPtr ptr $ off + 04) _loc_day_zone

instance Storable LocalDateTime where
    sizeOf  _ = 10
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 10 * n
      base <- peek . plusPtr ptr $ off
      zone <- peek . plusPtr ptr $ off + 08
      return $! LocalDateTime base zone
    pokeElemOff ptr  n LocalDateTime{..} = do
      let off = 10 * n
      poke (plusPtr ptr $ off     ) _loc_sec_base
      poke (plusPtr ptr $ off + 08) _loc_sec_zone

instance Storable LocalDateTimeMillis where
    sizeOf  _ = 12
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 12 * n
      base <- peek . plusPtr ptr $ off
      mill <- peek . plusPtr ptr $ off + 08
      zone <- peek . plusPtr ptr $ off + 10
      return $! LocalDateTimeMillis base mill zone
    pokeElemOff ptr  n LocalDateTimeMillis{..} = do
      let off = 12 * n
      poke (plusPtr ptr $ off     ) _loc_mil_base
      poke (plusPtr ptr $ off + 08) _loc_mil_mill
      poke (plusPtr ptr $ off + 10) _loc_mil_zone

instance Storable LocalDateTimeMicros where
    sizeOf  _ = 14
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 14 * n
      base <- peek . plusPtr ptr $ off
      micr <- peek . plusPtr ptr $ off + 08
      zone <- peek . plusPtr ptr $ off + 12
      return $! LocalDateTimeMicros base micr zone
    pokeElemOff ptr  n LocalDateTimeMicros{..} = do
      let off = 14 * n
      poke (plusPtr ptr $ off     ) _loc_mic_base
      poke (plusPtr ptr $ off + 08) _loc_mic_micr
      poke (plusPtr ptr $ off + 12) _loc_mic_zone

instance Storable LocalDateTimeNanos where
    sizeOf  _ = 14
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 14 * n
      base <- peek . plusPtr ptr $ off
      nano <- peek . plusPtr ptr $ off + 08
      zone <- peek . plusPtr ptr $ off + 12
      return $! LocalDateTimeNanos base nano zone
    pokeElemOff ptr  n LocalDateTimeNanos{..} = do
      let off = 14 * n
      poke (plusPtr ptr $ off     ) _loc_nan_base
      poke (plusPtr ptr $ off + 08) _loc_nan_nano
      poke (plusPtr ptr $ off + 12) _loc_nan_zone

instance Storable LocalDateTimePicos where
    sizeOf  _ = 18
    alignment = sizeOf
    peekElemOff ptr  n = do
      let off = 18 * n
      base <- peek . plusPtr ptr $ off
      nano <- peek . plusPtr ptr $ off + 08
      zone <- peek . plusPtr ptr $ off + 16
      return $! LocalDateTimePicos base nano zone
    pokeElemOff ptr  n LocalDateTimePicos{..} = do
      let off = 18 * n
      poke (plusPtr ptr $ off     ) _loc_pic_base
      poke (plusPtr ptr $ off + 08) _loc_pic_pico
      poke (plusPtr ptr $ off + 16) _loc_pic_zone

instance ToJSON LocalDate
instance ToJSON LocalDateTime
instance ToJSON LocalDateTimeMillis
instance ToJSON LocalDateTimeMicros
instance ToJSON LocalDateTimeNanos
instance ToJSON LocalDateTimePicos

instance Zone LocalDate where
    toZone date = flip (set loc_day_zone) date . fromIntegral . fromEnum

instance Zone LocalDateTime where
    toZone time = flip (set loc_sec_zone) time . fromIntegral . fromEnum

instance Zone LocalDateTimeMillis where
    toZone time = flip (set loc_mil_zone) time . fromIntegral . fromEnum

instance Zone LocalDateTimeMicros where
    toZone time = flip (set loc_mic_zone) time . fromIntegral . fromEnum

instance Zone LocalDateTimeNanos where
    toZone time = flip (set loc_nan_zone) time . fromIntegral . fromEnum

instance Zone LocalDateTimePicos where
    toZone time = flip (set loc_pic_zone) time . fromIntegral . fromEnum

-- | Create a local date.
-- 
-- > >>> createLocalDate 2013 11 03 Pacific_Standard_Time 
-- > 2013-11-03 PST
--
createLocalDate :: Year -> Month -> Day -> TimeZone -> LocalDate
createLocalDate year month day zone =
   if minBound <= date && date <= maxBound then date
   else error "createLocalDate: date not supported"
   where date = LocalDate base . fromIntegral $ fromEnum zone
         base = fromIntegral $ epochToDate year month day

-- | Create a local date and time.
--
-- > >>> createLocalDateTime 2013 11 03 22 55 52 South_Africa_Standard_Time 
-- > 2013-11-03 22:55:52 SAST
--
createLocalDateTime :: Year -> Month -> Day -> Hour -> Minute -> Second -> TimeZone -> LocalDateTime
createLocalDateTime year month day hour minute second zone =
   if minBound <= time && time <= maxBound then time
   else error "createLocalDateTime: time not supported"
   where time = LocalDateTime base . fromIntegral $ fromEnum zone
         days = epochToDate year month day
         base = baseUnixToUTC ((fromIntegral days   * 86400)  +
                               (fromIntegral hour   * 03600)  +
                               (fromIntegral minute * 00060)  -
                               (getOffset    zone   * 00060)) + fromIntegral second

-- | Create a local date and time with millisecond granularity.
--
-- > >>> createLocalDateTimeMillis 2013 11 03 13 57 43 830 Mountain_Standard_Time
-- > 2013-11-03 13:57:43.830 MST
--
createLocalDateTimeMillis :: Year -> Month -> Day -> Hour -> Minute -> Second -> Millis -> TimeZone -> LocalDateTimeMillis
createLocalDateTimeMillis year month day hour minute second millis zone =
   if minBound <= time && time <= maxBound then time
   else error "createLocalDateTimeMillis: time not supported"
   where time = LocalDateTimeMillis base mill . fromIntegral $ fromEnum zone
         adds = fromIntegral $ millis `div` 1000
         mill = fromIntegral $ millis `mod` 1000
         days = epochToDate year month day
         base = baseUnixToUTC ((fromIntegral days   * 86400)  +
                               (fromIntegral hour   * 03600)  +
                               (fromIntegral minute * 00060)  -
                               (getOffset    zone   * 00060)) + fromIntegral second + adds

-- | Create a local date and time with microsecond granularity.
--
-- > >>> createLocalDateTimeMicros 2013 11 03 21 01 42 903539 Coordinated_Universal_Time 
-- > 2013-11-03 21:01:42.903539 UTC
--
createLocalDateTimeMicros :: Year -> Month -> Day -> Hour -> Minute -> Second -> Micros -> TimeZone -> LocalDateTimeMicros
createLocalDateTimeMicros year month day hour minute second micros zone =
   if minBound <= time && time <= maxBound then time
   else error "createLocalDateTimeMicros: time not supported"
   where time = LocalDateTimeMicros base micr . fromIntegral $ fromEnum zone
         adds = fromIntegral $ micros `div` 1000000
         micr = fromIntegral $ micros `mod` 1000000
         days = epochToDate year month day
         base = baseUnixToUTC ((fromIntegral days   * 86400)  +
                               (fromIntegral hour   * 03600)  +
                               (fromIntegral minute * 00060)  -
                               (getOffset    zone   * 00060)) + fromIntegral second + adds

-- | Create a local date and time with nanosecond granularity.
--
-- > >>> createLocalDateTimeNanos 2013 11 04 06 05 07 016715087 Japan_Standard_Time 
-- > 2013-11-04 06:05:07.016715087 JST
--
createLocalDateTimeNanos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Nanos -> TimeZone -> LocalDateTimeNanos
createLocalDateTimeNanos year month day hour minute second nanos zone =
   if minBound <= time && time <= maxBound then time
   else error "createLocalDateTimeNanos: time not supported"
   where time = LocalDateTimeNanos base nano . fromIntegral $ fromEnum zone
         adds = fromIntegral $ nanos `div` 1000000000
         nano = fromIntegral $ nanos `mod` 1000000000
         days = epochToDate year month day
         base = baseUnixToUTC ((fromIntegral days   * 86400)  +
                               (fromIntegral hour   * 03600)  +
                               (fromIntegral minute * 00060)  -
                               (getOffset    zone   * 00060)) + fromIntegral second + adds

-- | Create a local date and time with picosecond granularity.
--
-- > >>> createLocalDateTimePicos 2013 11 03 23 13 56 838238648311 Eastern_European_Time 
-- > 2013-11-03 23:13:56.838238648311 EET
--
createLocalDateTimePicos :: Year -> Month -> Day -> Hour -> Minute -> Second -> Picos -> TimeZone -> LocalDateTimePicos
createLocalDateTimePicos year month day hour minute second picos zone =
   if minBound <= time && time <= maxBound then time
   else error "createLocalDateTimePicos: time not supported"
   where time = LocalDateTimePicos base pico . fromIntegral $ fromEnum zone
         adds = fromIntegral $ picos `div` 1000000000000
         pico = fromIntegral $ picos `mod` 1000000000000
         days = epochToDate year month day
         base = baseUnixToUTC ((fromIntegral days   * 86400)  +
                               (fromIntegral hour   * 03600)  +
                               (fromIntegral minute * 00060)  -
                               (getOffset    zone   * 00060)) + fromIntegral second + adds

-- | Decompose a local date into a human-readable format.
decompLocalDate :: LocalDate -> DateZoneStruct
decompLocalDate LocalDate{..} =
   DateZoneStruct _d_year _d_mon _d_mday _d_wday zone
   where DateStruct{..} = toDateStruct date
         date = UnixDate _loc_day_base
         zone = toEnum $ fromIntegral _loc_day_zone

-- | Decompose a local date and time into a human-readable format.
decompLocalDateTime :: LocalDateTime -> DateTimeZoneStruct
decompLocalDateTime LocalDateTime{..} =
   DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone
   where DateTimeStruct{..} = toDateTimeStruct time
         (,) base leap = baseUTCToUnix _loc_sec_base
         zone = toEnum $ fromIntegral _loc_sec_zone
         time = UnixDateTime base `plus` (getOffset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap

-- | Decompose a local date and time with millisecond granularity into a human-readable format.
decompLocalDateTimeMillis :: LocalDateTimeMillis -> DateTimeZoneStruct
decompLocalDateTimeMillis LocalDateTimeMillis{..} =
   DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone
   where DateTimeStruct{..} = toDateTimeStruct time
         (,) base leap = baseUTCToUnix _loc_mil_base
         zone = toEnum $ fromIntegral _loc_mil_zone
         time = UnixDateTime base `plus` (getOffset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_mil_mill / 1000

-- | Decompose a local date and time with microsecond granularity into a human-readable format.
decompLocalDateTimeMicros :: LocalDateTimeMicros -> DateTimeZoneStruct
decompLocalDateTimeMicros LocalDateTimeMicros{..} =
   DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone
   where DateTimeStruct{..} = toDateTimeStruct time
         (,) base leap = baseUTCToUnix _loc_mic_base
         zone = toEnum $ fromIntegral _loc_mic_zone
         time = UnixDateTime base `plus` (getOffset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_mic_micr / 1000000

-- | Decompose a local date and time with nanosecond granularity into a human-readable format.
decompLocalDateTimeNanos :: LocalDateTimeNanos -> DateTimeZoneStruct
decompLocalDateTimeNanos LocalDateTimeNanos{..} =
   DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone
   where DateTimeStruct{..} = toDateTimeStruct time
         (,) base leap = baseUTCToUnix _loc_nan_base
         zone = toEnum $ fromIntegral _loc_nan_zone
         time = UnixDateTime base `plus` (getOffset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_nan_nano / 1000000000

-- | Decompose a local date and time with picosecond granularity into a human-readable format.
decompLocalDateTimePicos :: LocalDateTimePicos -> DateTimeZoneStruct
decompLocalDateTimePicos LocalDateTimePicos{..} =
   DateTimeZoneStruct _dt_year _dt_mon _dt_mday _dt_wday _dt_hour _dt_min sec zone
   where DateTimeStruct{..} = toDateTimeStruct time
         (,) base leap = baseUTCToUnix _loc_pic_base
         zone = toEnum $ fromIntegral _loc_pic_zone
         time = UnixDateTime base `plus` (getOffset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_pic_pico / 1000000000000

-- | Decompose a UTC base into day and second components.
decompUTCBase :: Int64 -> Int16 -> (Int32, Int32)
decompUTCBase locBase zone = (newBase, newSecs)
   where zoneNum = toEnum $ fromIntegral zone
         (,) nixBase leapSec = baseUTCToUnix locBase
         offBase = nixBase + 60 * getOffset zoneNum
         newBase = fromIntegral (offBase `div` 86400)
         newSecs = fromIntegral (nixBase `mod` 86400) + fromIntegral leapSec

-- | Get the current local date from the system clock.
--
-- > >>> getCurrentLocalDate London 
-- > 2013-11-03 GMT
--
getCurrentLocalDate :: City -> IO LocalDate
getCurrentLocalDate city = getTransitionTimes city >>= getCurrentLocalDateTime' >>= return . convert

-- | Get the current local date from the system clock using preloaded transition times.
--
-- > >>> ttimes <- getTransitionTimes Tokyo 
-- > >>> getCurrentLocalDate' ttimes
-- > 2013-11-04 JST
--
--   Use this function if you need to get the current local date more than once. The
--   use of preloaded transition times will avoid unnecessary parsing of Olson files. 
getCurrentLocalDate' :: TransitionTimes -> IO LocalDate
getCurrentLocalDate' ttimes = getCurrentLocalDateTime' ttimes >>= return . convert

-- | Get the current local date and time from the system clock.
--
-- > >>> getCurrentLocalDateTime New_York 
-- > 2013-11-03 16:38:16 EST
--
getCurrentLocalDateTime :: City -> IO LocalDateTime
getCurrentLocalDateTime city = getTransitionTimes city >>= getCurrentLocalDateTime'

-- | Get the current local date and time from the system clock using preloaded transition
--   times.
--
-- > >>> ttimes <- getTransitionTimes Moscow
-- > >>> getCurrentLocalDateTime' ttimes
-- > 2013-11-04 01:41:50 MSK
--
--   Use this function if you need to get the current local date and time more than once.
--   The use of preloaded transition times will avoid unnecessary parsing of Olson files. 
getCurrentLocalDateTime' :: TransitionTimes -> IO LocalDateTime
getCurrentLocalDateTime' ttimes = do
   time@(UnixDateTime unix) <- getCurrentUnixDateTime
   let  base = baseUnixToUTC unix
        f tt = _loc_sec_base tt > base
        mval = listToMaybe $ dropWhile f ttimes
        zone = maybe 17 _loc_sec_zone mval
   if   maybe True (/= convert time) nextLeap
   then return $! LocalDateTime base zone
   else let sec = round $ fromIntegral (unix `mod` 86400) / 86400
        in  return $! LocalDateTime base zone `plus` Second sec

-- | Get the current local date and time with millisecond granularity from the system clock.
--
-- > >>> getCurrentLocalDateTimeMillis Auckland
-- > 2013-11-04 10:46:13.123 NZDT
--
getCurrentLocalDateTimeMillis :: City -> IO LocalDateTimeMillis
getCurrentLocalDateTimeMillis city = getTransitionTimes city >>= getCurrentLocalDateTimeMillis'

-- | Get the current local date and time with millisecond granularity from the system clock
--   using preloaded transition times.
--
-- > >>> ttimes <- getTransitionTimes Tehran 
-- > >>> getCurrentLocalDateTimeMillis' ttimes
-- > 2013-11-04 01:20:49.435 IRST
--
--   Use this function if you need to get the current local date and time with millisecond
--   granularity more than once. The use of preloaded transition times will avoid unnecessary
--   parsing of Olson files. 
getCurrentLocalDateTimeMillis' :: TransitionTimes -> IO LocalDateTimeMillis
getCurrentLocalDateTimeMillis' ttimes = do
   time@UnixDateTimeMillis{..} <- getCurrentUnixDateTimeMillis
   let  base = baseUnixToUTC _uni_mil_base
        f tt = _loc_sec_base tt > base
        mval = listToMaybe $ dropWhile f ttimes
        zone = maybe 17 _loc_sec_zone mval
   if   maybe True (/= convert time) nextLeap
   then return $! LocalDateTimeMillis base _uni_mil_mill zone
   else let millis = round $ fromIntegral (_uni_mil_base `mod` 86400) / 86.4
        in  return $! LocalDateTimeMillis base _uni_mil_mill zone `plus` Millis millis

-- | Get the current local date and time with microsecond granularity from the system clock.
--
-- > >>> getCurrentLocalDateTimeMicros Tel_Aviv 
-- > 2013-11-03 23:55:30.935387 IST
--
getCurrentLocalDateTimeMicros :: City -> IO LocalDateTimeMicros
getCurrentLocalDateTimeMicros city = getTransitionTimes city >>= getCurrentLocalDateTimeMicros'

-- | Get the current local date and time with microsecond granularity from the system clock
--   using preloaded transition times.
--
-- > >>> ttimes <- getTransitionTimes Sao_Paulo
-- > >>> getCurrentLocalDateTimeMicros' ttimes
-- > 2013-11-03 19:58:50.405806 BRST
--
--   Use this function if you need to get the current local date and time with microsecond
--   granularity more than once. The use of preloaded transition times will avoid unnecessary
--   parsing of Olson files.
getCurrentLocalDateTimeMicros' :: TransitionTimes -> IO LocalDateTimeMicros
getCurrentLocalDateTimeMicros' ttimes = do
   time@UnixDateTimeMicros{..} <- getCurrentUnixDateTimeMicros
   let  base = baseUnixToUTC _uni_mic_base
        f tt = _loc_sec_base tt > base
        mval = listToMaybe $ dropWhile f ttimes
        zone = maybe 17 _loc_sec_zone mval
   if   maybe True (/= convert time) nextLeap
   then return $! LocalDateTimeMicros base _uni_mic_micr zone
   else let micros = round $ fromIntegral (_uni_mic_base `mod` 86400) / 0.0864
        in  return $! LocalDateTimeMicros base _uni_mic_micr zone `plus` Micros micros

-- | Get the current local date and time with nanosecond granularity from the system clock.
--
-- > >>> getCurrentLocalDateTimeNanos Brussels 
-- > 2013-11-03 23:01:07.337488000 CET
--
--   Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant
--   timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimeNanos :: City -> IO LocalDateTimeNanos
getCurrentLocalDateTimeNanos city = getTransitionTimes city >>= getCurrentLocalDateTimeNanos'

-- | Get the current local date and time with nanosecond granularity from the system clock
--   using preloaded transition times.
--
-- > >>> ttimes <- getTransitionTimes Mogadishu
-- > >>> getCurrentLocalDateTimeNanos' ttimes
-- > 2013-11-04 01:15:08.664426000 EAT
--
--   Use this function if you need to get the current local date and time with nanosecond
--   granularity more than once. The use of preloaded transition times will avoid unnecessary
--   parsing of Olson files.
--
--   Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant
--   timestamp will have nanosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimeNanos' :: TransitionTimes -> IO LocalDateTimeNanos
getCurrentLocalDateTimeNanos' ttimes = do
   time@UnixDateTimeNanos{..} <- getCurrentUnixDateTimeNanos
   let  base = baseUnixToUTC _uni_nan_base
        f tt = _loc_sec_base tt > base
        mval = listToMaybe $ dropWhile f ttimes
        zone = maybe 17 _loc_sec_zone mval
   if   maybe True (/= convert time) nextLeap
   then return $! LocalDateTimeNanos base _uni_nan_nano zone
   else let nanos = round $ fromIntegral (_uni_nan_base `mod` 86400) / 0.0000864
        in  return $! LocalDateTimeNanos base _uni_nan_nano zone `plus` Nanos nanos

-- | Get the current local date and time with picosecond granularity from the system clock.
--
-- > >>> getCurrentLocalDateTime Karachi
-- > 2013-11-04 03:18:30 PKT
--
--   Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant
--   timestamp will have picosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimePicos :: City -> IO LocalDateTimePicos
getCurrentLocalDateTimePicos city = getTransitionTimes city >>= getCurrentLocalDateTimePicos'

-- | Get the current local date and time with picosecond granularity from the system clock using
--   preloaded transition times.
--
-- > >>> ttimes <- getTransitionTimes Baghdad
-- > >>> getCurrentLocalDateTimePicos' ttimes
-- > 2013-11-04 01:20:57.502906000000 AST
--
--   Use this function if you need to get the current local date and time with picosecond
--   granularity more than once. The use of preloaded transition times will avoid unnecessary
--   parsing of Olson files.
--
--   Note that this functions calls @gettimeofday()@ behind the scenes. Therefore, the resultant
--   timestamp will have picosecond granularity, but only microsecond resolution.
getCurrentLocalDateTimePicos' :: TransitionTimes -> IO LocalDateTimePicos
getCurrentLocalDateTimePicos' ttimes = do
   time@UnixDateTimePicos{..} <- getCurrentUnixDateTimePicos
   let  base = baseUnixToUTC _uni_pic_base
        f tt = _loc_sec_base tt > base
        mval = listToMaybe $ dropWhile f ttimes
        zone = maybe 17 _loc_sec_zone mval
   if   maybe True (/= convert time) nextLeap
   then return $! LocalDateTimePicos base _uni_pic_pico zone
   else let picos = round $ fromIntegral (_uni_pic_base `mod` 86400) / 0.0000000864
        in  return $! LocalDateTimePicos base _uni_pic_pico zone `plus` Picos picos

-- | Show a Local date as a string.
prettyLocalDate :: LocalDate -> String
prettyLocalDate date =
  printf "%s, %s %s, %04d (%s)" wday mon mday _dz_year abbr
  where DateZoneStruct{..} = toDateZoneStruct date
        wday = show _dz_wday
        mon  = prettyMonth _dz_mon
        mday = prettyDay _dz_mday
        abbr = show (convert _dz_zone :: TimeZoneAbbr)

-- | Show a Local date and time as a string.
prettyLocalDateTime :: DateTimeZone dtz => dtz -> String
prettyLocalDateTime time =
  printf str hour _dtz_min ampm wday mon mday _dtz_year abbr
  where DateTimeZoneStruct{..} = toDateTimeZoneStruct time
        str  = "%d:%02d %s, %s, %s %s, %04d (%s)"
        wday = show _dtz_wday
        mon  = prettyMonth _dtz_mon
        mday = prettyDay _dtz_mday
        abbr = show (convert _dtz_zone :: TimeZoneAbbr)
        (hour, ampm) = prettyHour _dtz_hour

-- | Get a list of transition times for the given city.
getTransitionTimes :: City -> IO TransitionTimes
getTransitionTimes city = do
   let file = getOlsonFile city
   OlsonData{olsonTransitions, olsonTypes} <- getOlsonFromFile file
   let ttimes = uniquetimes $ sortBy future2past olsonTransitions
   return $! foldr (step olsonTypes) [] ttimes
   where uniquetimes = groupBy $ on (==) transTime
         future2past = comparing $ negate . transTime
         step types ~[Transition{..}] accum =
           if transTime < 0
           then [LocalDateTime 43200 zone]
           else  LocalDateTime base  zone : accum
           where TtInfo{..} = types !! transIndex
                 abbr = TimeZoneAbbr city tt_abbr
                 base = baseUnixToUTC $ fromIntegral transTime
                 zone = fromIntegral  $ fromEnum (convert abbr :: TimeZone)

-- | Convert a Unix base into a UTC base.
baseUnixToUTC :: Int64 -> Int64
baseUnixToUTC base =
   if | base >= 1341100800 -> base + 25
      | base >= 1230768000 -> base + 24
      | base >= 1136073600 -> base + 23
      | base >= 0915148800 -> base + 22
      | base >= 0867715200 -> base + 21
      | base >= 0820454400 -> base + 20
      | base >= 0773020800 -> base + 19
      | base >= 0741484800 -> base + 18
      | base >= 0709948800 -> base + 17
      | base >= 0662688000 -> base + 16
      | base >= 0631152000 -> base + 15
      | base >= 0567993600 -> base + 14
      | base >= 0489024000 -> base + 13
      | base >= 0425865600 -> base + 12
      | base >= 0394329600 -> base + 11
      | base >= 0362793600 -> base + 10
      | base >= 0315532800 -> base + 09
      | base >= 0283996800 -> base + 08
      | base >= 0252460800 -> base + 07
      | base >= 0220924800 -> base + 06
      | base >= 0189302400 -> base + 05
      | base >= 0157766400 -> base + 04
      | base >= 0126230400 -> base + 03
      | base >= 0094694400 -> base + 02
      | base >= 0078796800 -> base + 01
      | otherwise          -> base + 00

-- | Convert a UTC base into a Unix base and leap second.
baseUTCToUnix :: Int64 -> (Int64, Second)
baseUTCToUnix base =
   if | base >= 1341100825 -> (base - 0025, 0)
      | base == 1341100824 -> (01341100799, 1)
      | base >= 1230768024 -> (base - 0024, 0)
      | base == 1230768023 -> (01230767999, 1)
      | base >= 1136073623 -> (base - 0023, 0)
      | base == 1136073622 -> (01136073599, 1)
      | base >= 0915148822 -> (base - 0022, 0)
      | base == 0915148821 -> (00915148799, 1)
      | base >= 0867715221 -> (base - 0021, 0)
      | base == 0867715220 -> (00867715199, 1)
      | base >= 0820454420 -> (base - 0020, 0)
      | base == 0820454419 -> (00820454399, 1)
      | base >= 0773020819 -> (base - 0019, 0)
      | base == 0773020818 -> (00773020799, 1)
      | base >= 0741484818 -> (base - 0018, 0)
      | base == 0741484817 -> (00741484799, 1)
      | base >= 0709948817 -> (base - 0017, 0)
      | base == 0709948816 -> (00709948799, 1)
      | base >= 0662688016 -> (base - 0016, 0)
      | base == 0662688015 -> (00662687999, 1)
      | base >= 0631152015 -> (base - 0015, 0)
      | base == 0631152014 -> (00631151999, 1)
      | base >= 0567993614 -> (base - 0014, 0)
      | base == 0567993613 -> (00567993599, 1)
      | base >= 0489024013 -> (base - 0013, 0)
      | base == 0489024012 -> (00489023999, 1)
      | base >= 0425865612 -> (base - 0012, 0)
      | base == 0425865611 -> (00425865599, 1)
      | base >= 0394329611 -> (base - 0011, 0)
      | base == 0394329610 -> (00394329599, 1)
      | base >= 0362793610 -> (base - 0010, 0)
      | base == 0362793609 -> (00362793599, 1)
      | base >= 0315532809 -> (base - 0009, 0)
      | base == 0315532808 -> (00315532799, 1)
      | base >= 0283996808 -> (base - 0008, 0)
      | base == 0283996807 -> (00283996799, 1)
      | base >= 0252460807 -> (base - 0007, 0)
      | base == 0252460806 -> (00252460799, 1)
      | base >= 0220924806 -> (base - 0006, 0)
      | base == 0220924805 -> (00220924799, 1)
      | base >= 0189302405 -> (base - 0005, 0)
      | base == 0189302404 -> (00189302399, 1)
      | base >= 0157766404 -> (base - 0004, 0)
      | base == 0157766403 -> (00157766399, 1)
      | base >= 0126230403 -> (base - 0003, 0)
      | base == 0126230402 -> (00126230399, 1)
      | base >= 0094694402 -> (base - 0002, 0)
      | base == 0094694401 -> (00094694399, 1)
      | base >= 0078796801 -> (base - 0001, 0)
      | base == 0078796800 -> (00078796799, 1)
      | otherwise          -> (base - 0000, 0)

-- | The next leap second insertion date.
nextLeap :: Maybe UnixDate
nextLeap =  Nothing