tz 0.0.0.1 → 0.0.0.2
raw patch · 7 files changed
+252/−10 lines, 7 filesdep +deepseqdep +template-haskell
Dependencies added: deepseq, template-haskell
Files
- Data/Time/Zones/Read.hs +40/−7
- Data/Time/Zones/TH.hs +141/−0
- Data/Time/Zones/Types.hs +5/−1
- benchmarks/benchTZ.hs +10/−0
- examples/exampleTH.hs +17/−0
- tests/testTH.hs +19/−0
- tz.cabal +20/−2
Data/Time/Zones/Read.hs view
@@ -1,5 +1,5 @@ {- |-Module : Data.Time.Zones+Module : Data.Time.Zones.Read Copyright : (C) 2014 Mihaly Barasz License : Apache-2.0, see LICENSE Maintainer : Mihaly Barasz <klao@nilcons.com>@@ -9,15 +9,22 @@ {-# LANGUAGE OverloadedStrings #-} module Data.Time.Zones.Read (+ -- * Various ways of loading `TZ` loadTZFromFile, loadSystemTZ, loadLocalTZ, loadTZFromDB,+ -- * Reading only the description, no parsing+ tzDescriptionFromFile,+ tzDescriptionFromDB,+ systemTZDescription,+ -- * Parsing Olson data olsonGet,+ parseTZDescription, ) where import Control.Applicative-import Control.Monad (unless)+import Control.Monad import Data.Binary import Data.Binary.Get import qualified Data.ByteString.Char8 as BS@@ -47,8 +54,6 @@ dir <- fromMaybe "/usr/share/zoneinfo" <$> getEnvMaybe "TZDIR" loadTZFromFile $ dir ++ "/" ++ tzName -- -- | Returns the local `TZ` based on the @TZ@ and @TZDIR@ -- environment variables. --@@ -84,17 +89,45 @@ fn <- getDataFileName $ tzName ++ ".zone" loadTZFromFile fn +tzDescriptionFromFile :: FilePath -> IO BL.ByteString+tzDescriptionFromFile fname = olsonDescription <$> BL.readFile fname++tzDescriptionFromDB :: String -> IO BL.ByteString+tzDescriptionFromDB tzName = do+ -- TODO(klao): this probably won't work on Windows.+ fn <- getDataFileName $ tzName ++ ".zone"+ tzDescriptionFromFile fn++systemTZDescription :: String -> IO BL.ByteString+systemTZDescription tzName = do+ dir <- fromMaybe "/usr/share/zoneinfo" <$> getEnvMaybe "TZDIR"+ tzDescriptionFromFile $ dir ++ "/" ++ tzName++--------------------------------------------------------------------------------+ olsonGet :: Get TZ-olsonGet = do+olsonGet = olsonGet' False++olsonGet' :: Bool -> Get TZ+olsonGet' abridged = do version <- olsonHeader case () of () | version == '\0' -> olsonGetWith 4 getTime32 () | version `elem` ['2', '3'] -> do- skipOlson0- _ <- olsonHeader+ unless abridged $ skipOlson0 >> void olsonHeader olsonGetWith 8 getTime64 -- TODO(klao): read the rule string _ -> fail $ "olsonGet: invalid version character: " ++ show version++olsonDescription :: BL.ByteString -> BL.ByteString+olsonDescription input = flip runGet input $ do+ version <- olsonHeader+ if version `elem` ['2', '3']+ then skipOlson0 >> getRemainingLazyByteString+ else return input++parseTZDescription :: BL.ByteString -> TZ+parseTZDescription = runGet (olsonGet' True) olsonHeader :: Get Char olsonHeader = do
+ Data/Time/Zones/TH.hs view
@@ -0,0 +1,141 @@+-- |+-- Module : Data.Time.Zones.TH+-- Copyright : (C) 2014 Mihaly Barasz+-- License : Apache-2.0, see LICENSE+-- Maintainer : Mihaly Barasz <klao@nilcons.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)+--++{-# OPTIONS_HADDOCK prune #-}++module Data.Time.Zones.TH (+ includeTZFromDB,+ includeSystemTZ,+ includeTZFromFile,+ -- Internal functions+ parseTZInternal,+ ) where++import Control.DeepSeq+import qualified Data.ByteString.Lazy.Char8 as BL+import Data.Time.Zones.Read+import Data.Time.Zones.Types+import Data.Version+import Language.Haskell.TH+import Language.Haskell.TH.Syntax+import Paths_tz++-- | Generate a `TZ` definition from an entry out of the time zone+-- database shipped with this package.+includeTZFromDB :: String -> Q Exp+includeTZFromDB tzName = do+ desc <- runIO $ tzDescriptionFromDB tzName+ parseTZ 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.+includeSystemTZ :: String -> Q Exp+includeSystemTZ tzName = do+ desc <- runIO $ systemTZDescription tzName+ parseTZ desc++-- | Generate a `TZ` definition from the given time zone information file.+includeTZFromFile :: FilePath -> Q Exp+includeTZFromFile fname = do+ desc <- runIO $ tzDescriptionFromFile fname+ parseTZ desc++--------------------------------------------------------------------------------+-- Template Haskell helper functions.++-- A bit of a rationale about this implementation.+--+-- 1. The implementation below is basically a convoluted version of+-- the following:+--+-- parseTZ :: BL.ByteString -> Q Exp+-- parseTZ desc =+-- [| parseTZDescription (BL.pack $(stringE $ BL.unpack desc)) |]+--+-- So, why the complications?+--+-- Why we want to _provide_ the possibility for the users to define+-- TZs with Template Haskell, we do not want to _depend_ on Template+-- Haskell in _this package_ itself. This way @tz@ can potentially be+-- cross-compiled.+--+-- 2. 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 desc = do+ -- Check that the description actually parses, so if there's a bug+ -- we fail at compile time and not at run time:+ parseTZDescription desc `deepseq` return ()+ parseTZInternalName <- getLocalName "parseTZInternal"+ appE (varE parseTZInternalName) $ stringE $ BL.unpack desc++-- Create a `Name` of the safe form that value name quoting+-- (ie. 'function) creates.+globalName :: String -> String -> String -> Name+globalName name modName package =+ Name (OccName name) (NameG VarName (PkgName package) (ModName modName))++-- This is an imperfect substitute of name quoting+-- (eg. 'parseTZInternalName), which again we are doing because we+-- don't want to use the TemplateHaskell extension.+--+-- If you have the @tz@ package installed and just using it; or if you+-- are building this package with Cabal, the parseTZInternal name is+-- found in the package "tz-<version>".+-- But, if you are just debugging things in this package and compiling+-- stuff with ghc by hand, it will be found in the "main" package. So,+-- we first construct a global name as if it were in the "main"+-- package. Then, we try to reify it, which will fail in the normal+-- (first) case, in which case we fall back to "tz-<version>".+getLocalName :: String -> Q Name+getLocalName functionName = do+ let nameInPackage = globalName functionName "Data.Time.Zones.TH"+ recover (return $ nameInPackage $ "tz-" ++ showVersion version) $ do+ let name = nameInPackage "main"+ _ <- reify name+ return name++-- Internal function used by spliced `TZ` definitions+--+-- This function has to be exported, so that it can be found at the+-- place of splicing.+parseTZInternal :: String -> TZ+{-# INLINE parseTZInternal #-}+parseTZInternal = parseTZDescription . BL.pack
Data/Time/Zones/Types.hs view
@@ -1,5 +1,5 @@ {- |-Module : Data.Time.Zones+Module : Data.Time.Zones.Types Copyright : (C) 2014 Mihaly Barasz License : Apache-2.0, see LICENSE Maintainer : Mihaly Barasz <klao@nilcons.com>@@ -10,6 +10,7 @@ TZ(..), ) where +import Control.DeepSeq import Data.Int import qualified Data.Vector.Unboxed as VU import qualified Data.Vector as VB@@ -22,3 +23,6 @@ -- stored? _tzInfos :: !(VB.Vector (Bool, String)) -- (summer, name) } deriving (Eq,Show)++instance NFData TZ where+ rnf (TZ { _tzInfos = infos }) = rnf infos
benchmarks/benchTZ.hs view
@@ -24,6 +24,11 @@ mkUTC y m d hh mm ss = UTCTime (fromGregorian y m d) (timeOfDayToTime $ TimeOfDay hh mm ss) +utcToLocalTimeIO :: UTCTime -> IO LocalTime+utcToLocalTimeIO ut = do+ tz <- getTimeZone ut+ return $ utcToLocalTime tz ut+ utcToLocalNano :: TZ -> Int64 -> Int64 {-# INLINE utcToLocalNano #-} utcToLocalNano tz t = t + 1000000000 * fromIntegral diff@@ -51,6 +56,11 @@ bench "past" $ nf (utcToLocalTime cetTZ) ut0, bench "now" $ nf (utcToLocalTime cetTZ) ut1, bench "future" $ nf (utcToLocalTime cetTZ) ut2+ ],+ bgroup "fullUTCToLocalTime" [+ bench "past" $ nfIO (utcToLocalTimeIO ut0),+ bench "now" $ nfIO (utcToLocalTimeIO ut1),+ bench "future" $ nfIO (utcToLocalTimeIO ut2) ], bgroup "utcToLocalTimeTZ" [ bench "past" $ nf (utcToLocalTimeTZ tz) ut0,
+ examples/exampleTH.hs view
@@ -0,0 +1,17 @@+{-# 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)
+ tests/testTH.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE TemplateHaskell #-}++import Data.Time.Zones+import Data.Time.Zones.TH+import Test.Framework.Providers.HUnit+import Test.Framework.TH+import Test.HUnit hiding (Test, assert)++tzBudapest :: TZ+tzBudapest = $(includeSystemTZ "Europe/Budapest")++case_Budapest_is_Budapest :: IO ()+case_Budapest_is_Budapest = do+ readBp <- loadSystemTZ "Europe/Budapest"+ tzBudapest @?= readBp++main :: IO ()+main = do+ $defaultMainGenerator
tz.cabal view
@@ -1,5 +1,5 @@ Name: tz-Version: 0.0.0.1+Version: 0.0.0.2 License: Apache-2.0 License-File: LICENSE Author: Mihaly Barasz, Gergely Risko@@ -35,6 +35,7 @@ Extra-Source-Files: README.md+ examples/*.hs Source-Repository head Type: git@@ -44,7 +45,8 @@ Exposed-Modules: Data.Time.Zones, Data.Time.Zones.Types,- Data.Time.Zones.Read+ Data.Time.Zones.Read,+ Data.Time.Zones.TH Other-Modules: Paths_tz Default-Language: Haskell2010 GHC-Options: -Wall@@ -52,6 +54,8 @@ base >= 4 && < 5, binary >= 0.5 && < 0.8, bytestring >= 0.9 && < 0.11,+ deepseq >= 1.1 && < 2,+ template-haskell >= 2.6 && < 2.9, time >= 1.2 && < 1.5, vector >= 0.9 && < 0.11 @@ -73,6 +77,20 @@ test-framework-th >= 0.2 && < 0.4, time >= 1.2 && < 1.5, unix >= 2.6 && < 3++Test-Suite th-test+ Default-Language: Haskell2010+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: tests+ Main-Is: testTH.hs+ GHC-Options: -Wall+ Build-Depends:+ tz,+ base >= 4 && < 5,+ HUnit >= 1.2 && < 1.3,+ test-framework >= 0.4 && < 1,+ test-framework-hunit >= 0.2 && < 0.4,+ test-framework-th >= 0.2 && < 0.4 Benchmark bench Default-Language: Haskell2010