{-# LANGUAGE TemplateHaskell #-}
-- |
-- Load TimeZoneSeries from an Olson file at compile time.
--  
-- For example:
--
-- > myTimeZoneSeries :: TimeZoneSeries
-- > myTimeZoneSeries = $(loadTZFile "/usr/share/zoneinfo/Europe/Stockholm")

module Data.Time.LocalTime.TimeZone.Olson.TH 
  (
    loadTZFile
  ) where       

import Data.Ratio                          (numerator,
                                            denominator)
import Data.Time.LocalTime.TimeZone.Olson  (getTimeZoneSeriesFromOlsonFile)
import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(..))
import Data.Time.LocalTime                 (TimeZone(..))
import Data.Time                           (UTCTime(..),
                                            Day(..),
                                            DiffTime,
                                            secondsToDiffTime)
import Language.Haskell.TH                 (Q,
                                            runIO,
                                            Exp(..),
                                            mkName,
                                            Lit(..),
                                            litE,
                                            integerL)

-- | Make a splice of a TimeZoneSeries from an Olson file.
loadTZFile :: FilePath -- ^ Path to the Olson file.
           -> Q Exp
loadTZFile :: FilePath -> Q Exp
loadTZFile FilePath
zf = 
  TimeZoneSeries -> Q Exp
mkTZS (TimeZoneSeries -> Q Exp) -> Q TimeZoneSeries -> Q Exp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (IO TimeZoneSeries -> Q TimeZoneSeries
forall a. IO a -> Q a
runIO (IO TimeZoneSeries -> Q TimeZoneSeries)
-> IO TimeZoneSeries -> Q TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ FilePath -> IO TimeZoneSeries
getTimeZoneSeriesFromOlsonFile FilePath
zf)

-- | Make a splice of a TimeZoneSeries.    
mkTZS :: TimeZoneSeries -- ^ The TimeZoneSeries to be spliced
      -> Q Exp    
mkTZS :: TimeZoneSeries -> Q Exp
mkTZS (TimeZoneSeries TimeZone
def [(UTCTime, TimeZone)]
tlist) = [| TimeZoneSeries $(litTimeZone def) $(mkList tlist) |]   
  
mkList :: [(UTCTime,TimeZone)] 
       -> Q Exp  
mkList :: [(UTCTime, TimeZone)] -> Q Exp
mkList [(UTCTime, TimeZone)]
l = [| $(fmap ListE $ mapM mkPair l) |]    
    
mkPair :: (UTCTime,TimeZone) 
       -> Q Exp           
mkPair :: (UTCTime, TimeZone) -> Q Exp
mkPair (UTCTime
t,TimeZone
tz) = [| ($(litUTCTime t),$(litTimeZone tz)) |]
    
litUTCTime :: UTCTime 
           -> Q Exp  
litUTCTime :: UTCTime -> Q Exp
litUTCTime (UTCTime (ModifiedJulianDay Integer
d) DiffTime
s) = 
  [| UTCTime (ModifiedJulianDay $(litInteger d)) 
             (secondsToDiffTime $(litInteger $ diffTimeToInteger s)) |]

litInteger :: Integer
           -> Q Exp
litInteger :: Integer -> Q Exp
litInteger = Lit -> Q Exp
litE (Lit -> Q Exp) -> (Integer -> Lit) -> Integer -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Lit
integerL

diffTimeToInteger :: DiffTime 
                  -> Integer
diffTimeToInteger :: DiffTime -> Integer
diffTimeToInteger DiffTime
s =
  let r :: Rational
r = DiffTime -> Rational
forall a. Real a => a -> Rational
toRational DiffTime
s
      n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
r
      d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
r in
  (Integer
n Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
d)

litTimeZone :: TimeZone 
            -> Q Exp
litTimeZone :: TimeZone -> Q Exp
litTimeZone (TimeZone Int
m Bool
s FilePath
n) = 
  [| TimeZone $(litInteger $ toInteger m)
              $(return $ ConE $ mkName $ show s)
              $(litE $ StringL n) |]