-- |
-- Module      : Data.Time.Zones.TH
-- Copyright   : (C) 2014 Mihaly Barasz
-- License     : Apache-2.0, see LICENSE
-- Maintainer  : Janus Troelsen <ysangkok@gmail.com>
-- Stability   : experimental
--
-- /Example usage:/
--
-- >
-- >{-# LANGUAGE TemplateHaskell #-}
-- >
-- >import Data.Time
-- >import Data.Time.Zones
-- >import Data.Time.Zones.TH
-- >
-- >tzBudapest :: TZ
-- >tzBudapest = $(includeTZFromDB "Europe/Budapest")
-- >
-- >tzLosAngeles :: TZ
-- >tzLosAngeles = $(includeTZFromDB "America/Los_Angeles")
-- >
-- >main :: IO ()
-- >main = do
-- >  t <- getCurrentTime
-- >  putStrLn $ "Time in Budapest: " ++ show (utcToLocalTimeTZ tzBudapest t)
-- >  putStrLn $ "Time in Los Angeles: " ++ show (utcToLocalTimeTZ tzLosAngeles t)
--

{-# LANGUAGE TemplateHaskell #-}

module Data.Time.Zones.TH (
  includeTZFromDB,
  includeSystemTZ,
  includeTZFromFile,
  ) where

import Control.DeepSeq
import qualified Data.ByteString.Lazy.Char8 as BL
import Data.Time.Zones.Files
import Data.Time.Zones.Read
import Language.Haskell.TH

-- | Generate a `TZ` definition from an entry out of the time zone
-- database shipped with this package.
includeTZFromDB :: String -> Q Exp
includeTZFromDB :: String -> Q Exp
includeTZFromDB String
tzName = do
  ByteString
desc <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO String
timeZonePathFromDB String
tzName IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
BL.readFile
  ByteString -> Q Exp
parseTZ ByteString
desc

-- | Generate a `TZ` definition from a system time zone information file.
--
-- See also: `loadSystemTZ` for details on how system time zone files
-- are located.
--
-- Note, this is unlikely to work on non-posix systems (e.g.,
-- Windows), use `includeTZFromDB` or `includeTZFromFile` instead.
includeSystemTZ :: String -> Q Exp
includeSystemTZ :: String -> Q Exp
includeSystemTZ String
tzName = do
  ByteString
desc <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO String
pathForSystemTZ String
tzName IO String -> (String -> IO ByteString) -> IO ByteString
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO ByteString
BL.readFile
  ByteString -> Q Exp
parseTZ ByteString
desc

-- | Generate a `TZ` definition from the given time zone information file.
includeTZFromFile :: FilePath -> Q Exp
includeTZFromFile :: String -> Q Exp
includeTZFromFile String
fname = do
  ByteString
desc <- IO ByteString -> Q ByteString
forall a. IO a -> Q a
runIO (IO ByteString -> Q ByteString) -> IO ByteString -> Q ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
BL.readFile String
fname
  ByteString -> Q Exp
parseTZ ByteString
desc

--------------------------------------------------------------------------------
-- Template Haskell helper functions.

-- Why the round-trip through `String`? Why don't we generate a fully
-- expanded definition of `TZ`?
--
-- First, we want a definition that is stored compactly in the
-- resulting binary, and 'String' literals are stored as C strings.
--
-- Secondly, vectors (which are the internal representation of TZ)
-- don't have literal representation, so we couldn't produce a
-- fully-evaluated representation anyway. Also, it would be much more
-- complicated.
--
parseTZ :: BL.ByteString -> Q Exp
parseTZ :: ByteString -> Q Exp
parseTZ ByteString
desc = do
  -- Check that the description actually parses, so if there's a bug
  -- we fail at compile time and not at run time:
  ByteString -> TZ
parseOlson ByteString
desc TZ -> Q () -> Q ()
forall a b. NFData a => a -> b -> b
`deepseq` () -> Q ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  [| parseOlson (BL.pack $(stringE $ BL.unpack desc)) |]