{-# LANGUAGE TemplateHaskell #-}
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)
loadTZFile :: FilePath
-> 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)
mkTZS :: TimeZoneSeries
-> 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) |]