---------------------------------------------------------------
-- 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 #-}

module Data.Time.Exts.Local (

       Local
     , LocalDate(..)
     , LocalDateTime(..)
     , LocalDateTimeMillis(..)
     , LocalDateTimeMicros(..)
     , LocalDateTimeNanos(..)
     , LocalDateTimePicos(..)

     , createLocalDate
     , createLocalDateTime
     , createLocalDateTimeMillis
     , createLocalDateTimeMicros
     , createLocalDateTimeNanos
     , createLocalDateTimePicos

     , getCurrentLocalDate
     , getCurrentLocalDateTime
     , getCurrentLocalDateTimeMillis
     , getCurrentLocalDateTimeMicros
     , getCurrentLocalDateTimeNanos
     , getCurrentLocalDateTimePicos

     , getCurrentLocalDate'
     , getCurrentLocalDateTime'
     , getCurrentLocalDateTimeMillis'
     , getCurrentLocalDateTimeMicros'
     , getCurrentLocalDateTimeNanos'
     , getCurrentLocalDateTimePicos'

     , TransitionTimes
     , getTransitionTimes

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

class Local x

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

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)

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)

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)

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)

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)

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 0
      where base = fromInteger toModifiedJulianDay - 40587

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

instance Convertible UTCTime LocalDateTimeMillis where
    safeConvert UTCTime{..} = Right $ LocalDateTimeMillis base mill 0
      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 0
      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 0
      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 0
      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 (minval, maxval) g  of { (base_mill, g' ) -> 
      case randomR (000000, 000051) g' of { (zone     , g'') ->
        let (base, mill) = (***) fromInteger fromInteger $ divMod base_mill 1000
        in  (LocalDateTimeMillis base mill zone, g'') } }
        where minval = toInteger (_loc_mil_mill a) + toInteger (_loc_mil_base a) * 1000
              maxval = toInteger (_loc_mil_mill b) + toInteger (_loc_mil_base b) * 1000

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 (minval, maxval) g  of { (base_micr, g' ) -> 
      case randomR (000000, 000051) g' of { (zone     , g'') ->
        let (base, micr) = (***) fromInteger fromInteger $ divMod base_micr 1000000
        in  (LocalDateTimeMicros base micr zone, g'') } }
        where minval = toInteger (_loc_mic_micr a) + toInteger (_loc_mic_base a) * 1000000
              maxval = toInteger (_loc_mic_micr b) + toInteger (_loc_mic_base b) * 1000000

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 (minval, maxval) g  of { (base_nano, g' ) -> 
      case randomR (000000, 000051) g' of { (zone     , g'') ->
        let (base, nano) = (***) fromInteger fromInteger $ divMod base_nano 1000000000
        in  (LocalDateTimeNanos base nano zone, g'') } }
        where minval = toInteger (_loc_nan_nano a) + toInteger (_loc_nan_base a) * 1000000000
              maxval = toInteger (_loc_nan_nano b) + toInteger (_loc_nan_base b) * 1000000000

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 (minval, maxval) g  of { (base_pico, g' ) -> 
      case randomR (000000, 000051) g' of { (zone     , g'') ->
        let (base, pico) = (***) fromInteger fromInteger $ divMod base_pico 1000000000000
        in  (LocalDateTimePicos base pico zone, g'') } }
        where minval = toInteger (_loc_pic_pico a) + toInteger (_loc_pic_base a) * 1000000000000
              maxval = toInteger (_loc_pic_pico b) + toInteger (_loc_pic_base b) * 1000000000000

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

-- | Creates a local date.
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

-- | Creates a local date and time.
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)  -
                               (offset       zone   * 00060)) + fromIntegral second

-- | Creates a local date and time with millisecond granularity.
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)  -
                               (offset       zone   * 00060)) + fromIntegral second + adds

-- | Creates a local date and time with microsecond granularity.
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)  -
                               (offset       zone   * 00060)) + fromIntegral second + adds

-- | Creates a local date and time with nanosecond granularity.
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)  -
                               (offset       zone   * 00060)) + fromIntegral second + adds

-- | Creates a local date and time with picosecond granularity.
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)  -
                               (offset       zone   * 00060)) + fromIntegral second + adds

-- | Decomposes 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

-- | Decomposes 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` (offset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap

-- | Decomposes 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` (offset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_mil_mill / 1000

-- | Decomposes 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` (offset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_mic_micr / 1000000

-- | Decomposes 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` (offset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_nan_nano / 1000000000

-- | Decomposes 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` (offset zone :: Minute)
         sec  = _dt_sec + fromIntegral leap + fromIntegral _loc_pic_pico / 1000000000000

-- | Decomposes 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 * offset zoneNum
         newBase = fromIntegral (offBase `div` 86400)
         newSecs = fromIntegral (nixBase `mod` 86400) + fromIntegral leapSec

-- | Gets the current local date from the system clock.
getCurrentLocalDate :: City -> IO LocalDate
getCurrentLocalDate city = getTransitionTimes city >>= getCurrentLocalDateTime' >>= return . convert

-- | Gets the current local date from the system clock with preloaded transition times.
getCurrentLocalDate' :: TransitionTimes -> IO LocalDate
getCurrentLocalDate' ttimes = getCurrentLocalDateTime' ttimes >>= return . convert

-- | Gets the current local date and time from the system clock.
getCurrentLocalDateTime :: City -> IO LocalDateTime
getCurrentLocalDateTime city = getTransitionTimes city >>= getCurrentLocalDateTime'

-- | Gets the current local date and time from the system clock with preloaded transition times.
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

-- | Gets the current local date and time with millisecond granularity from the system clock.
getCurrentLocalDateTimeMillis :: City -> IO LocalDateTimeMillis
getCurrentLocalDateTimeMillis city = getTransitionTimes city >>= getCurrentLocalDateTimeMillis'

-- | Gets the current local date and time with millisecond granularity from the system clock with preloaded transition times.
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

-- | Gets the current local date and time with microsecond granularity from the system clock.
getCurrentLocalDateTimeMicros :: City -> IO LocalDateTimeMicros
getCurrentLocalDateTimeMicros city = getTransitionTimes city >>= getCurrentLocalDateTimeMicros'

-- | Gets the current local date and time with microsecond granularity from the system clock with preloaded transition times.
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

-- | Gets the current local date and time with nanosecond granularity from the system clock.
getCurrentLocalDateTimeNanos :: City -> IO LocalDateTimeNanos
getCurrentLocalDateTimeNanos city = getTransitionTimes city >>= getCurrentLocalDateTimeNanos'

-- | Gets the current local date and time with nanosecond granularity from the system clock with preloaded transition times.
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

-- | Gets the current local date and time with picosecond granularity from the system clock.
getCurrentLocalDateTimePicos :: City -> IO LocalDateTimePicos
getCurrentLocalDateTimePicos city = getTransitionTimes city >>= getCurrentLocalDateTimePicos'

-- | Gets the current local date and time with picosecond granularity from the system clock with preloaded transition times.
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

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

-- | Shows 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

-- | Returns a set 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)

-- | Converts 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

-- | Converts 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