timezone-olson 0.1.0 → 0.1.1
raw patch · 4 files changed
+57/−56 lines, 4 files
Files
- Data/Time/LocalTime/TimeZone/Olson/Parse.hs +7/−2
- Data/Time/LocalTime/TimeZone/Olson/Render.hs +44/−51
- Data/Time/LocalTime/TimeZone/Olson/Types.hs +5/−2
- timezone-olson.cabal +1/−1
Data/Time/LocalTime/TimeZone/Olson/Parse.hs view
@@ -39,9 +39,12 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L import Data.Monoid (mappend)+import Data.List (sortBy, groupBy) import Data.Maybe (listToMaybe, fromMaybe) import Data.Word (Word8) import Data.Int (Int32, Int64)+import Data.Ord (comparing)+import Data.Function (on) import Data.Typeable (Typeable) import Control.Monad (guard, replicateM, replicateM_, when) import Control.Exception.Extensible (try, throw, Exception, ErrorCall)@@ -57,8 +60,8 @@ -- | Convert parsed Olson timezone data into a @TimeZoneSeries@. olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries olsonToTimeZoneSeries (OlsonData ttimes ttinfos@(dflt0:_) _ _) =- fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) $- reverse ttimes+ fmap (TimeZoneSeries $ mkTZ dflt) . mapM (lookupTZ ttinfos) .+ uniqTimes . sortBy futureToPast $ ttimes where dflt = fromMaybe dflt0 . listToMaybe $ filter isStd ttinfos isStd (TtInfo _ isdst _ _) = not isdst@@ -67,6 +70,8 @@ lookupTZ ttinfos ttime = fmap (((,) $ toUTC ttime) . mkTZ) . listToMaybe $ drop (transIndex ttime) ttinfos toUTC = posixSecondsToUTCTime . fromIntegral . transTime+ uniqTimes = map last . groupBy ((==) `on` transTime)+ futureToPast = comparing $ negate . transTime olsonToTimeZoneSeries _ = Nothing -- | Read timezone data from a binary Olson timezone file and convert
Data/Time/LocalTime/TimeZone/Olson/Render.hs view
@@ -30,7 +30,7 @@ renderOlsonToFile, verifyOlsonLimits, putOlson,- splitOlson+ extractOlsonV1 ) where @@ -69,9 +69,9 @@ | otherwise = Just $ OlsonData [Transition secs ttinfo |- (t, tzs) <- reverse pairs,+ (t, tz) <- reverse pairs, let secs = round $ utcTimeToPOSIXSeconds t,- ttinfo <- maybeToList $ lookup (mkTT tzs) ttAssocs]+ ttinfo <- maybeToList $ lookup (mkTT tz) ttAssocs] ttinfos [] Nothing@@ -110,66 +110,52 @@ -- | Render Olson timezone data in binary Olson timezone file format -- as a lazy @ByteString@-putOlson :: OlsonData -> Put-putOlson olson = putOlsonParts version olson1 olson2 posix >> flush+putOlson olson@(OlsonData _ _ _ posix)+ | fitsInVersion1 = putOlsonPart 0 put32bitIntegral olson+ | otherwise = do putOlsonPart 50 put32bitIntegral olson1+ putOlsonPart 50 put64bitIntegral olson+ putPosixTZ posix where- (olson1, olson2, posix) = splitOlson olson- version- | olson2 /= mempty = 50- | otherwise = maybe 0 (const 50) $ posix >>= guard . not . null+ olson1 = extractOlsonV1 olson+ fitsInVersion1 = fmap null posix /= Just False &&+ olson1 == olson {olsonPosixTZ = Nothing} --- | Split Olson timezone data into three parts: timezone data that can--- be rendered using Version 1 format, timezone data that can only be--- rendered using Version 2 format, and the POSIX-style TZ string--- if specified-splitOlson :: OlsonData -> (OlsonData, OlsonData, Maybe String)-splitOlson (OlsonData transs ttinfos leaps posix) =- (OlsonData transs1 ttinfos1 leaps1 Nothing,- OlsonData transs2 ttinfos2 leaps2 Nothing,- posix)+-- | Extract Olson timezone data that can be rendered using Version 1 format+extractOlsonV1 :: OlsonData -> OlsonData+extractOlsonV1 (OlsonData transs ttinfos leaps _)+ | allV1 = OlsonData transs ttinfos leaps Nothing+ | otherwise = OlsonData transs1 ttinfos1 leaps1 Nothing where cutoff = 0x80000000 -- 2^31 fitsIn32bits x = x < cutoff && x >= negate cutoff- ( leaps1 , leaps2 ) = partition (fitsIn32bits . leapTime) leaps- (transs1', transs2') = partition (fitsIn32bits . transTime) transs- assoc1 = mkAssoc [0] transs1'- assoc2 = mkAssoc [] transs2'- transs1 = mkTranss transs1' assoc1- transs2 = mkTranss transs2' assoc2- ttinfos1 = mkTtinfos assoc1- ttinfos2 = mkTtinfos assoc2- mkAssoc prepend transs' = zip+ leaps1 = filter (fitsIn32bits . leapTime) leaps+ transs1' = filter (fitsIn32bits . transTime) transs+ allV1 = length leaps1 == length leaps && length transs1' == length transs+ assoc1 = zip (sortBy (comparing $ fmap tt_ttype . listToMaybe . flip drop ttinfos) .- uniq . sort . (prepend ++) $ map transIndex transs')+ uniq . sort . (0 :) $ map transIndex transs1') [0..]- mkTranss transs' assoc = [t {transIndex = i} |- t <- transs', i <- maybeToList $ lookup (transIndex t) assoc]- mkTtinfos assoc = map snd . dropWhile (isNothing . fst) .- sortBy (comparing fst) $ zip (map (flip lookup assoc) [0..]) ttinfos--putOlsonParts :: Word8 -> OlsonData -> OlsonData -> Maybe String -> Put-putOlsonParts 0 olson1 _ _ = putOlsonPart 0 put32bitIntegral olson1-putOlsonParts v2 olson1 olson2 posix = do- putOlsonPart v2 put32bitIntegral olson1- putOlsonPart v2 put64bitIntegral olson2- putPosixTZ posix+ transs1 = [t {transIndex = i} |+ t <- transs1', i <- maybeToList $ lookup (transIndex t) assoc1]+ ttinfos1 = map snd . dropWhile (isNothing . fst) .+ sortBy (comparing fst) $ zip (map (flip lookup assoc1) [0..]) ttinfos putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put putOlsonPart version putTime (OlsonData transs ttinfos leaps _) = do- putASCII "TZif"+ putASCII "magic number" "TZif" putWord8 version putByteString . B.pack $ replicate 15 0 -- padding nulls replicateM_ 2 $ putCount ttinfosWithTtype- -- tzh_ttisgmtcnt- -- tzh_ttisstdcnt- putCount leaps -- tzh_leapcnt- putCount transs -- tzh_timecnt- putCount ttinfos -- tzh_typecnt- putCount abbrChars -- tzh_charcnt+ -- tzh_ttisgmtcnt+ -- tzh_ttisstdcnt+ putCount leaps -- tzh_leapcnt+ putCount transs -- tzh_timecnt+ putCount ttinfos -- tzh_typecnt+ put32bitIntegral abbrChars -- tzh_charcnt mapM_ (putTime . transTime ) transs mapM_ (put8bitIntegral . transIndex) transs mapM_ putTtInfo ttinfosIndexed- putASCII abbrChars+ mapM_ putAbbr abbrStrings mapM_ (putLeapInfo putTime) leaps mapM_ (putBool . (== Std) . tt_ttype) ttinfosWithTtype -- isstd mapM_ (putBool . (== UTC) . tt_ttype) ttinfosWithTtype -- isgmt@@ -177,7 +163,8 @@ putCount = put32bitIntegral . length ttinfosWithTtype = takeWhile ((<= UTC) . tt_ttype) ttinfosIndexed abbrStrings = uniq . sort $ map tt_abbr ttinfos- abbrChars = concatMap (++ "\NUL") abbrStrings+ abbrChars = sum (map length abbrStrings) + length abbrStrings+ putAbbr abbr = putASCII "time zone abbreviation" abbr >> putWord8 0 abbrAssocs = zip abbrStrings . scanl (+) 0 $ map ((+ 1) . length) abbrStrings ttinfosIndexed = [TtInfo gmtoff isdst ttype i |@@ -187,7 +174,7 @@ putPosixTZ :: Maybe String -> Put putPosixTZ posix = do putWord8 10- putASCII $ fromMaybe "" posix+ putASCII "POSIX TZ string"$ fromMaybe "" posix putWord8 10 putTtInfo :: TtInfo Int -> Put@@ -220,5 +207,11 @@ uniq :: Eq a => [a] -> [a] uniq = map head . group -putASCII :: String -> Put-putASCII = putByteString . B.pack . map (fromIntegral . fromEnum)+putASCII :: String -> String -> Put+putASCII what =+ putByteString . B.pack . map (fromIntegral . verify . fromEnum)+ where+ verify c+ | c >= 32 && c <= 126 = c+ | otherwise = error $ "Cannot render TimeZoneSeries: " +++ what ++ " contains non-ASCII characters"
Data/Time/LocalTime/TimeZone/Olson/Types.hs view
@@ -65,8 +65,11 @@ instance Monoid OlsonData where mempty = OlsonData [] [] [] Nothing- mappend (OlsonData a b c d ) (OlsonData a' b' c' d')- = OlsonData (a++a') (b++b') (c++c') (d `mplus` d')+ mappend (OlsonData a b c d ) (OlsonData a' b' c' d') =+ OlsonData (a ++ map (shiftBy $ length b) a')+ (b ++ b') (c ++ c') (d `mplus` d')+ where+ shiftBy n trans = trans {transIndex = n + transIndex trans} -- | A @Transition@ represents a moment when the clocks change in a -- timezone. It consists of a Unix timestamp value that indicates the
timezone-olson.cabal view
@@ -7,7 +7,7 @@ -- The package version. See the Haskell package versioning policy -- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for -- standards guiding when and how versions should be incremented.-Version: 0.1.0+Version: 0.1.1 -- A short (one-line) description of the package. Synopsis: A pure Haskell parser and renderer for binary Olson timezone files