@@ -2,42 +2,37 @@
2-----------------------------------------------------------------------------
2-----------------------------------------------------------------------------
4-- Module : Data.Time.LocalTime.TimeZone.Olson.Render
4-- Module : Data.Time.LocalTime.TimeZone.Olson.Render
5−-- Copyright : Yitzchak Gale 2018
5+-- Copyright : Yitzchak Gale 2010
7-- Maintainer : Yitzchak Gale <gale@sefer.org>
7-- Maintainer : Yitzchak Gale <gale@sefer.org>
8-- Portability : portable
8-- Portability : portable
10−-- Render Olson timezone data in the standard binary format as used in
10+-- Render Olson timezone data in the standard binary format as
11−-- Olson timezone files, and as specified by the tzfile(5) man page on
11+-- used in Olson timezone files, and as specified by the
12−-- Unix-like systems. For more information about this format, see
12+-- tzfile(5) man page on Unix-like systems. For more information
13−-- <http://www.twinsun.com/tz/tz-link.htm>.
13+-- about this format, see http://www.twinsun.com/tz/tz-link.htm.
15−{- Copyright (c) 2018ZZ Yitzchak Gale. All rights reserved.
16+Copyright (c) 2010 Yitzchak Gale. All rights reserved.
16−For licensing information, see the BSD3-style license in the file
17+For licensing information, see the file LICENSE that was
17−LICENSE that was originally distributed by the author together with
18+originally distributed by the author together with this file.
20module Data.Time.LocalTime.TimeZone.Olson.Render
21module Data.Time.LocalTime.TimeZone.Olson.Render
22− -- * Rendering Olson timezone files
23+ -- * Rendering Olson timezone data
23 -- | If any of the transition times or leap second times specified
24 -- | If any of the transition times or leap second times specified
24 -- require more than a 32-bit integer to represent as a Unix
25 -- require more than a 32-bit integer to represent as a Unix
25 -- timestamp, or if a POSIX-style TZ string is specified, timezone
26 -- timestamp, or if a POSIX-style TZ string is specified, timezone
26 -- data is rendered using Version 2 format. Otherwise, the timezone data
27 -- data is rendered using Version 2 format. Otherwise, the timezone data
27 -- is rendered using Version 1 format.
28 -- is rendered using Version 1 format.
28− renderTimeZoneSeriesToOlsonFile,
29− timeZoneSeriesToOlson,
30 renderOlsonToFile,
29 renderOlsonToFile,
33− extractOlsonV1
31+ splitOlson
37import Data.Time.LocalTime.TimeZone.Olson.Types
35import Data.Time.LocalTime.TimeZone.Olson.Types
38−import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(TimeZoneSeries))
39−import Data.Time (TimeZone(TimeZone, timeZoneSummerOnly, timeZoneName))
40−import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
41import Data.Binary.Put (Put, runPut, putByteString, putWord8, flush,
36import Data.Binary.Put (Put, runPut, putByteString, putWord8, flush,
42 putWord32be, putWord64be)
37 putWord32be, putWord64be)
43import qualified Data.ByteString as B
38import qualified Data.ByteString as B
@@ -45,117 +40,78 @@ import qualified Data.ByteString.Lazy as L
45import Data.List (partition, sortBy, sort, group)
40import Data.List (partition, sortBy, sort, group)
46import Data.Ord (comparing)
41import Data.Ord (comparing)
47import Data.Word (Word8)
42import Data.Word (Word8)
48−import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe, catMaybes)
43+import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe)
49import Data.Monoid (mempty)
44import Data.Monoid (mempty)
50−import Control.Monad (guard, replicateM_, unless)
45+import Control.Monad (guard, replicateM_)
52−-- | Render a @TimeZoneSeries@ as a binary Olson timezone file.
54−-- If the values in the Olson timezone data exceed the standard size
55−-- limits (see 'defaultLimits'), this function throws an
56−-- exception. For other behavior, use 'timeZoneSeriesToOlson',
57−-- 'verifyOlsonLimits', 'putOlson' and 'Data.Binary.Put.runPut'
59−renderTimeZoneSeriesToOlsonFile :: FilePath -> TimeZoneSeries -> IO ()
60−renderTimeZoneSeriesToOlsonFile fp = renderOlsonToFile fp .
61− fromMaybe (error "Cannot render TimeZoneSeries: default is summer time") .
62− timeZoneSeriesToOlson
64−-- | Convert a @TimeZoneSeries@ to @OlsonData@ for rendering.
65−timeZoneSeriesToOlson :: TimeZoneSeries -> Maybe OlsonData
66−timeZoneSeriesToOlson (TimeZoneSeries dflt pairs)
67− | timeZoneSummerOnly dflt && not (all timeZoneSummerOnly $ map snd pairs)
71− [Transition secs ttinfo |
72− (t, tz) <- reverse pairs,
73− let secs = round $ utcTimeToPOSIXSeconds t,
74− ttinfo <- maybeToList $ lookup (mkTT tz) ttAssocs]
79− mkTT (TimeZone offset isdst abbr) =
80− TtInfo (offset*60) isdst Wall abbr
82− ttAssocs = (dfltTT, 0) :
83− zip (uniq . sort . filter (/= dfltTT) $ map (mkTT . snd) pairs) [1..]
84− ttinfos = map fst ttAssocs
86−-- | Check whether @OlsonData@ is within size limits.
87−verifyOlsonLimits :: SizeLimits -> OlsonData -> Bool
88−verifyOlsonLimits limits (OlsonData transs ttinfos leaps _) =
89− withinLimit maxTimes transs &&
90− withinLimit maxTypes ttinfos &&
91− withinLimit maxLeaps leaps &&
92− withinLimit maxAbbrChars abbrChars
94− withinLimit limit items = maybe True (null . flip drop items) $
96− abbrChars = concat abbrStrs ++ map (const '\NUL') abbrStrs
97− abbrStrs = map tt_abbr ttinfos
99-- | Render Olson timezone data as a binary Olson timezone file
48-- | Render Olson timezone data as a binary Olson timezone file
101−-- If the values in the Olson timezone data exceed the standard size
102−-- limits (see 'defaultLimits'), this function throws an
103−-- exception. For other behavior, use 'verifyOlsonLimits', 'putOlson'
104−-- and 'Data.Binary.Put.runPut' directly.
105renderOlsonToFile :: FilePath -> OlsonData -> IO ()
49renderOlsonToFile :: FilePath -> OlsonData -> IO ()
106−renderOlsonToFile fp olson = do
107− unless (verifyOlsonLimits defaultLimits olson) $
108− error "Olson timezone data exceeds size limits"
109− L.writeFile fp . runPut . putOlson $ olson
50+renderOlsonToFile fp = L.writeFile fp . runPut . putOlson
111-- | Render Olson timezone data in binary Olson timezone file format
52-- | Render Olson timezone data in binary Olson timezone file format
112-- as a lazy @ByteString@
53-- as a lazy @ByteString@
113−putOlson olson@(OlsonData _ _ _ posix)
54+putOlson :: OlsonData -> Put
114− | fitsInVersion1 = putOlsonPart 0 put32bitIntegral olson
55+putOlson olson = do
115− | otherwise = do putOlsonPart 50 put32bitIntegral olson1
56+ putASCII "TZif"
116− putOlsonPart 50 put64bitIntegral olson
57+ putWord8 version
117− putPosixTZ posix
58+ putByteString . B.pack $ replicate 15 0 -- padding nulls
59+ putOlsonParts version olson1 olson2 posix
119− olson1 = extractOlsonV1 olson
62+ (olson1, olson2, posix) = splitOlson olson
120− fitsInVersion1 = fmap null posix /= Just False &&
63+ version
121− olson1 == olson {olsonPosixTZ = Nothing}
64+ | olson2 /= mempty = 50
122−
65+ | otherwise = maybe 0 (const 50) $ posix >>= guard . not . null
67+-- | Split Olson timezone data into three parts: timezone data that can
123−-- | Extract Olson timezone data that can be rendered using Version 1 format
68+-- be rendered using Version 1 format, timezone data that can only be
69+-- rendered using Version 2 format, and the POSIX-style TZ string
124−extractOlsonV1 :: OlsonData -> OlsonData
71+splitOlson :: OlsonData -> (OlsonData, OlsonData, Maybe String)
125−extractOlsonV1 (OlsonData transs ttinfos leaps _)
126− | allV1 = OlsonData transs ttinfos leaps Nothing
72+splitOlson (OlsonData transs ttinfos leaps posix) =
127− | otherwise = OlsonData transs1 ttinfos1 leaps1 Nothing
73+ (OlsonData transs1 ttinfos1 leaps1 Nothing,
74+ OlsonData transs2 ttinfos2 leaps2 Nothing,
129 cutoff = 0x80000000 -- 2^31
77 cutoff = 0x80000000 -- 2^31
130− fitsIn32bits x = x < cutoff && x >= negate cutoff
78+ ( leaps1 , leaps2 ) = partition ((>= cutoff) . leapTime) leaps
131− leaps1 = filter (fitsIn32bits . leapTime) leaps
132− transs1' = filter (fitsIn32bits . transTime) transs
79+ (transs1', transs2') = partition ((>= cutoff) . transTime) transs
133− allV1 = length leaps1 == length leaps && length transs1' == length transs
80+ assoc1 = mkAssoc [0] transs1'
134− assoc1 = zip
81+ assoc2 = mkAssoc [] transs2'
82+ transs1 = mkTranss transs1' assoc1
83+ transs2 = mkTranss transs2' assoc2
84+ ttinfos1 = mkTtinfos assoc1
85+ ttinfos2 = mkTtinfos assoc2
86+ mkAssoc prepend transs' = zip
135 (sortBy (comparing $ fmap tt_ttype . listToMaybe . flip drop ttinfos) .
87 (sortBy (comparing $ fmap tt_ttype . listToMaybe . flip drop ttinfos) .
136− uniq . sort . (0 :) $ map transIndex transs1')
88+ uniq . sort . (prepend ++) $ map transIndex transs')
138− transs1 = [t {transIndex = i} |
90+ mkTranss transs' assoc = [t {transIndex = i} |
139− t <- transs1', i <- maybeToList $ lookup (transIndex t) assoc1]
91+ t <- transs', i <- maybeToList $ lookup (transIndex t) assoc]
140− ttinfos1 = map snd . dropWhile (isNothing . fst) .
92+ mkTtinfos assoc = map snd . dropWhile (isNothing . fst) .
141− sortBy (comparing fst) $ zip (map (flip lookup assoc1) [0..]) ttinfos
93+ sortBy (comparing fst) $ zip (map (flip lookup assoc) [0..]) ttinfos
95+putOlsonParts :: Word8 -> OlsonData -> OlsonData -> Maybe String -> Put
96+putOlsonParts 0 olson1 _ _ = putOlsonPart put32bitIntegral olson1
97+putOlsonParts _ olson1 olson2 posix = do
98+ putOlsonPart put32bitIntegral olson1
99+ putOlsonPart put64bitIntegral olson2
143−putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put
102+putOlsonPart :: (Integer -> Put) -> OlsonData -> Put
144−putOlsonPart version putTime (OlsonData transs ttinfos leaps _) = do
103+putOlsonPart putTime (OlsonData transs ttinfos leaps _) = do
145− putASCII "magic number" "TZif"
147− putByteString . B.pack $ replicate 15 0 -- padding nulls
148 replicateM_ 2 $ putCount ttinfosWithTtype
104 replicateM_ 2 $ putCount ttinfosWithTtype
149− -- tzh_ttisgmtcnt
105+ -- tzh_ttisgmtcnt
150− -- tzh_ttisstdcnt
106+ -- tzh_ttisstdcnt
151− putCount leaps -- tzh_leapcnt
107+ putCount leaps -- tzh_leapcnt
152− putCount transs -- tzh_timecnt
108+ putCount transs -- tzh_timecnt
153− putCount ttinfos -- tzh_typecnt
109+ putCount ttinfos -- tzh_typecnt
154− put32bitIntegral abbrChars -- tzh_charcnt
110+ putCount abbrChars -- tzh_charcnt
155 mapM_ (putTime . transTime ) transs
111 mapM_ (putTime . transTime ) transs
156 mapM_ (put8bitIntegral . transIndex) transs
112 mapM_ (put8bitIntegral . transIndex) transs
157 mapM_ putTtInfo ttinfosIndexed
113 mapM_ putTtInfo ttinfosIndexed
158− mapM_ putAbbr abbrStrings
114+ putASCII abbrChars
159 mapM_ (putLeapInfo putTime) leaps
115 mapM_ (putLeapInfo putTime) leaps
160 mapM_ (putBool . (== Std) . tt_ttype) ttinfosWithTtype -- isstd
116 mapM_ (putBool . (== Std) . tt_ttype) ttinfosWithTtype -- isstd
161 mapM_ (putBool . (== UTC) . tt_ttype) ttinfosWithTtype -- isgmt
117 mapM_ (putBool . (== UTC) . tt_ttype) ttinfosWithTtype -- isgmt
@@ -163,18 +119,16 @@ putOlsonPart version putTime (OlsonData transs ttinfos leaps _) = do
163 putCount = put32bitIntegral . length
119 putCount = put32bitIntegral . length
164 ttinfosWithTtype = takeWhile ((<= UTC) . tt_ttype) ttinfosIndexed
120 ttinfosWithTtype = takeWhile ((<= UTC) . tt_ttype) ttinfosIndexed
165 abbrStrings = uniq . sort $ map tt_abbr ttinfos
121 abbrStrings = uniq . sort $ map tt_abbr ttinfos
166− abbrChars = sum (map length abbrStrings) + length abbrStrings
167− putAbbr abbr = putASCII "time zone abbreviation" abbr >> putWord8 0
168− abbrAssocs = zip abbrStrings . scanl (+) 0 $
169− map ((+ 1) . length) abbrStrings
122+ abbrChars = concatMap (++ "\NUL") abbrStrings
170 ttinfosIndexed = [TtInfo gmtoff isdst ttype i |
123 ttinfosIndexed = [TtInfo gmtoff isdst ttype i |
171 TtInfo gmtoff isdst ttype abbr <- ttinfos,
124 TtInfo gmtoff isdst ttype abbr <- ttinfos,
172− i <- maybeToList $ lookup abbr abbrAssocs]
125+ i <- maybeToList . lookup abbr . zip abbrStrings .
126+ scanl (+) 0 $ map ((+ 1) . length) abbrStrings]
174putPosixTZ :: Maybe String -> Put
128putPosixTZ :: Maybe String -> Put
175putPosixTZ posix = do
129putPosixTZ posix = do
176 putWord8 10
130 putWord8 10
177− putASCII "POSIX TZ string"$ fromMaybe "" posix
131+ putASCII $ fromMaybe "" posix
178 putWord8 10
132 putWord8 10
180putTtInfo :: TtInfo Int -> Put
134putTtInfo :: TtInfo Int -> Put
@@ -207,11 +161,5 @@ putBool True = putWord8 1
207uniq :: Eq a => [a] -> [a]
161uniq :: Eq a => [a] -> [a]
208uniq = map head . group
162uniq = map head . group
210−putASCII :: String -> String -> Put
164+putASCII :: String -> Put
212− putByteString . B.pack . map (fromIntegral . verify . fromEnum)
165+putASCII = putByteString . B.pack . map (fromIntegral . fromEnum)
215− | c >= 32 && c <= 126 = c
216− | otherwise = error $ "Cannot render TimeZoneSeries: " ++
217− what ++ " contains non-ASCII characters"