{-# OPTIONS_HADDOCK hide #-}
module Data.Time.LocalTime.TimeZone.Olson.Render
(
renderTimeZoneSeriesToOlsonFile,
timeZoneSeriesToOlson,
renderOlsonToFile,
verifyOlsonLimits,
putOlson,
extractOlsonV1
)
where
import Data.Time.LocalTime.TimeZone.Olson.Types
import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(TimeZoneSeries))
import Data.Time (TimeZone(TimeZone, timeZoneSummerOnly, timeZoneName))
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
import Data.Binary.Put (Put, runPut, putByteString, putWord8, flush,
putWord32be, putWord64be)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import Data.List (partition, sortBy, sort, group)
import Data.Ord (comparing)
import Data.Word (Word8)
import Data.Maybe (listToMaybe, maybeToList, isNothing, fromMaybe, catMaybes)
import Data.Monoid (mempty)
import Control.Monad (guard, replicateM_, unless)
renderTimeZoneSeriesToOlsonFile :: FilePath -> TimeZoneSeries -> IO ()
renderTimeZoneSeriesToOlsonFile :: FilePath -> TimeZoneSeries -> IO ()
renderTimeZoneSeriesToOlsonFile FilePath
fp = FilePath -> OlsonData -> IO ()
renderOlsonToFile FilePath
fp (OlsonData -> IO ())
-> (TimeZoneSeries -> OlsonData) -> TimeZoneSeries -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
OlsonData -> Maybe OlsonData -> OlsonData
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> OlsonData
forall a. HasCallStack => FilePath -> a
error FilePath
"Cannot render TimeZoneSeries: default is summer time") (Maybe OlsonData -> OlsonData)
-> (TimeZoneSeries -> Maybe OlsonData)
-> TimeZoneSeries
-> OlsonData
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
TimeZoneSeries -> Maybe OlsonData
timeZoneSeriesToOlson
timeZoneSeriesToOlson :: TimeZoneSeries -> Maybe OlsonData
timeZoneSeriesToOlson :: TimeZoneSeries -> Maybe OlsonData
timeZoneSeriesToOlson (TimeZoneSeries TimeZone
dflt [(UTCTime, TimeZone)]
pairs)
| TimeZone -> Bool
timeZoneSummerOnly TimeZone
dflt Bool -> Bool -> Bool
&& Bool -> Bool
not ((TimeZone -> Bool) -> [TimeZone] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all TimeZone -> Bool
timeZoneSummerOnly ([TimeZone] -> Bool) -> [TimeZone] -> Bool
forall a b. (a -> b) -> a -> b
$ ((UTCTime, TimeZone) -> TimeZone)
-> [(UTCTime, TimeZone)] -> [TimeZone]
forall a b. (a -> b) -> [a] -> [b]
map (UTCTime, TimeZone) -> TimeZone
forall a b. (a, b) -> b
snd [(UTCTime, TimeZone)]
pairs)
= Maybe OlsonData
forall a. Maybe a
Nothing
| Bool
otherwise = OlsonData -> Maybe OlsonData
forall a. a -> Maybe a
Just (OlsonData -> Maybe OlsonData) -> OlsonData -> Maybe OlsonData
forall a b. (a -> b) -> a -> b
$
[Transition]
-> [TtInfo FilePath] -> [LeapInfo] -> Maybe FilePath -> OlsonData
OlsonData
[Integer -> Int -> Transition
Transition Integer
secs Int
ttinfo |
(UTCTime
t, TimeZone
tz) <- [(UTCTime, TimeZone)] -> [(UTCTime, TimeZone)]
forall a. [a] -> [a]
reverse [(UTCTime, TimeZone)]
pairs,
let secs :: Integer
secs = POSIXTime -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (POSIXTime -> Integer) -> POSIXTime -> Integer
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
t,
Int
ttinfo <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
maybeToList (Maybe Int -> [Int]) -> Maybe Int -> [Int]
forall a b. (a -> b) -> a -> b
$ TtInfo FilePath -> [(TtInfo FilePath, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (TimeZone -> TtInfo FilePath
mkTT TimeZone
tz) [(TtInfo FilePath, Int)]
ttAssocs]
[TtInfo FilePath]
ttinfos
[]
Maybe FilePath
forall a. Maybe a
Nothing
where
mkTT :: TimeZone -> TtInfo FilePath
mkTT (TimeZone Int
offset Bool
isdst FilePath
abbr) =
Int -> Bool -> TransitionType -> FilePath -> TtInfo FilePath
forall abbr. Int -> Bool -> TransitionType -> abbr -> TtInfo abbr
TtInfo (Int
offsetInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
60) Bool
isdst TransitionType
Wall FilePath
abbr
dfltTT :: TtInfo FilePath
dfltTT = TimeZone -> TtInfo FilePath
mkTT TimeZone
dflt
ttAssocs :: [(TtInfo FilePath, Int)]
ttAssocs = (TtInfo FilePath
dfltTT, Int
0) (TtInfo FilePath, Int)
-> [(TtInfo FilePath, Int)] -> [(TtInfo FilePath, Int)]
forall a. a -> [a] -> [a]
:
[TtInfo FilePath] -> [Int] -> [(TtInfo FilePath, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([TtInfo FilePath] -> [TtInfo FilePath]
forall a. Eq a => [a] -> [a]
uniq ([TtInfo FilePath] -> [TtInfo FilePath])
-> ([TtInfo FilePath] -> [TtInfo FilePath])
-> [TtInfo FilePath]
-> [TtInfo FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TtInfo FilePath] -> [TtInfo FilePath]
forall a. Ord a => [a] -> [a]
sort ([TtInfo FilePath] -> [TtInfo FilePath])
-> ([TtInfo FilePath] -> [TtInfo FilePath])
-> [TtInfo FilePath]
-> [TtInfo FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TtInfo FilePath -> Bool) -> [TtInfo FilePath] -> [TtInfo FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (TtInfo FilePath -> TtInfo FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= TtInfo FilePath
dfltTT) ([TtInfo FilePath] -> [TtInfo FilePath])
-> [TtInfo FilePath] -> [TtInfo FilePath]
forall a b. (a -> b) -> a -> b
$ ((UTCTime, TimeZone) -> TtInfo FilePath)
-> [(UTCTime, TimeZone)] -> [TtInfo FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (TimeZone -> TtInfo FilePath
mkTT (TimeZone -> TtInfo FilePath)
-> ((UTCTime, TimeZone) -> TimeZone)
-> (UTCTime, TimeZone)
-> TtInfo FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTCTime, TimeZone) -> TimeZone
forall a b. (a, b) -> b
snd) [(UTCTime, TimeZone)]
pairs) [Int
1..]
ttinfos :: [TtInfo FilePath]
ttinfos = ((TtInfo FilePath, Int) -> TtInfo FilePath)
-> [(TtInfo FilePath, Int)] -> [TtInfo FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (TtInfo FilePath, Int) -> TtInfo FilePath
forall a b. (a, b) -> a
fst [(TtInfo FilePath, Int)]
ttAssocs
verifyOlsonLimits :: SizeLimits -> OlsonData -> Bool
verifyOlsonLimits :: SizeLimits -> OlsonData -> Bool
verifyOlsonLimits SizeLimits
limits (OlsonData [Transition]
transs [TtInfo FilePath]
ttinfos [LeapInfo]
leaps Maybe FilePath
_) =
(SizeLimits -> Maybe Int) -> [Transition] -> Bool
forall a. (SizeLimits -> Maybe Int) -> [a] -> Bool
withinLimit SizeLimits -> Maybe Int
maxTimes [Transition]
transs Bool -> Bool -> Bool
&&
(SizeLimits -> Maybe Int) -> [TtInfo FilePath] -> Bool
forall a. (SizeLimits -> Maybe Int) -> [a] -> Bool
withinLimit SizeLimits -> Maybe Int
maxTypes [TtInfo FilePath]
ttinfos Bool -> Bool -> Bool
&&
(SizeLimits -> Maybe Int) -> [LeapInfo] -> Bool
forall a. (SizeLimits -> Maybe Int) -> [a] -> Bool
withinLimit SizeLimits -> Maybe Int
maxLeaps [LeapInfo]
leaps Bool -> Bool -> Bool
&&
(SizeLimits -> Maybe Int) -> FilePath -> Bool
forall a. (SizeLimits -> Maybe Int) -> [a] -> Bool
withinLimit SizeLimits -> Maybe Int
maxAbbrChars FilePath
abbrChars
where
withinLimit :: (SizeLimits -> Maybe Int) -> [a] -> Bool
withinLimit SizeLimits -> Maybe Int
limit [a]
items = Bool -> (Int -> Bool) -> Maybe Int -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([a] -> Bool) -> (Int -> [a]) -> Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [a] -> [a]) -> [a] -> Int -> [a]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [a] -> [a]
forall a. Int -> [a] -> [a]
drop [a]
items) (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$
SizeLimits -> Maybe Int
limit SizeLimits
limits
abbrChars :: FilePath
abbrChars = [FilePath] -> FilePath
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [FilePath]
abbrStrs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ (FilePath -> Char) -> [FilePath] -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (Char -> FilePath -> Char
forall a b. a -> b -> a
const Char
'\NUL') [FilePath]
abbrStrs
abbrStrs :: [FilePath]
abbrStrs = (TtInfo FilePath -> FilePath) -> [TtInfo FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map TtInfo FilePath -> FilePath
forall abbr. TtInfo abbr -> abbr
tt_abbr [TtInfo FilePath]
ttinfos
renderOlsonToFile :: FilePath -> OlsonData -> IO ()
renderOlsonToFile :: FilePath -> OlsonData -> IO ()
renderOlsonToFile FilePath
fp OlsonData
olson = do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (SizeLimits -> OlsonData -> Bool
verifyOlsonLimits SizeLimits
defaultLimits OlsonData
olson) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> IO ()
forall a. HasCallStack => FilePath -> a
error FilePath
"Olson timezone data exceeds size limits"
FilePath -> ByteString -> IO ()
L.writeFile FilePath
fp (ByteString -> IO ())
-> (OlsonData -> ByteString) -> OlsonData -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Put -> ByteString
runPut (Put -> ByteString)
-> (OlsonData -> Put) -> OlsonData -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OlsonData -> Put
putOlson (OlsonData -> IO ()) -> OlsonData -> IO ()
forall a b. (a -> b) -> a -> b
$ OlsonData
olson
putOlson :: OlsonData -> Put
putOlson olson :: OlsonData
olson@(OlsonData [Transition]
_ [TtInfo FilePath]
_ [LeapInfo]
_ Maybe FilePath
posix)
| Bool
fitsInVersion1 = Word8 -> (Integer -> Put) -> OlsonData -> Put
putOlsonPart Word8
0 Integer -> Put
forall a. Integral a => a -> Put
put32bitIntegral OlsonData
olson
| Bool
otherwise = do Word8 -> (Integer -> Put) -> OlsonData -> Put
putOlsonPart Word8
50 Integer -> Put
forall a. Integral a => a -> Put
put32bitIntegral OlsonData
olson1
Word8 -> (Integer -> Put) -> OlsonData -> Put
putOlsonPart Word8
50 Integer -> Put
forall a. Integral a => a -> Put
put64bitIntegral OlsonData
olson
Maybe FilePath -> Put
putPosixTZ Maybe FilePath
posix
where
olson1 :: OlsonData
olson1 = OlsonData -> OlsonData
extractOlsonV1 OlsonData
olson
fitsInVersion1 :: Bool
fitsInVersion1 = (FilePath -> Bool) -> Maybe FilePath -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe FilePath
posix Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False Bool -> Bool -> Bool
&&
OlsonData
olson1 OlsonData -> OlsonData -> Bool
forall a. Eq a => a -> a -> Bool
== OlsonData
olson {olsonPosixTZ :: Maybe FilePath
olsonPosixTZ = Maybe FilePath
forall a. Maybe a
Nothing}
extractOlsonV1 :: OlsonData -> OlsonData
(OlsonData [Transition]
transs [TtInfo FilePath]
ttinfos [LeapInfo]
leaps Maybe FilePath
_)
| Bool
allV1 = [Transition]
-> [TtInfo FilePath] -> [LeapInfo] -> Maybe FilePath -> OlsonData
OlsonData [Transition]
transs [TtInfo FilePath]
ttinfos [LeapInfo]
leaps Maybe FilePath
forall a. Maybe a
Nothing
| Bool
otherwise = [Transition]
-> [TtInfo FilePath] -> [LeapInfo] -> Maybe FilePath -> OlsonData
OlsonData [Transition]
transs1 [TtInfo FilePath]
ttinfos1 [LeapInfo]
leaps1 Maybe FilePath
forall a. Maybe a
Nothing
where
cutoff :: Integer
cutoff = Integer
0x80000000
fitsIn32bits :: Integer -> Bool
fitsIn32bits Integer
x = Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
cutoff Bool -> Bool -> Bool
&& Integer
x Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer -> Integer
forall a. Num a => a -> a
negate Integer
cutoff
leaps1 :: [LeapInfo]
leaps1 = (LeapInfo -> Bool) -> [LeapInfo] -> [LeapInfo]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Bool
fitsIn32bits (Integer -> Bool) -> (LeapInfo -> Integer) -> LeapInfo -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeapInfo -> Integer
leapTime) [LeapInfo]
leaps
transs1' :: [Transition]
transs1' = (Transition -> Bool) -> [Transition] -> [Transition]
forall a. (a -> Bool) -> [a] -> [a]
filter (Integer -> Bool
fitsIn32bits (Integer -> Bool) -> (Transition -> Integer) -> Transition -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> Integer
transTime) [Transition]
transs
allV1 :: Bool
allV1 = [LeapInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LeapInfo]
leaps1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [LeapInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LeapInfo]
leaps Bool -> Bool -> Bool
&& [Transition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transition]
transs1' Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Transition] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Transition]
transs
assoc1 :: [(Int, Int)]
assoc1 = [Int] -> [Int] -> [(Int, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip
((Int -> Int -> Ordering) -> [Int] -> [Int]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Int -> Maybe TransitionType) -> Int -> Int -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Int -> Maybe TransitionType) -> Int -> Int -> Ordering)
-> (Int -> Maybe TransitionType) -> Int -> Int -> Ordering
forall a b. (a -> b) -> a -> b
$ (TtInfo FilePath -> TransitionType)
-> Maybe (TtInfo FilePath) -> Maybe TransitionType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TtInfo FilePath -> TransitionType
forall abbr. TtInfo abbr -> TransitionType
tt_ttype (Maybe (TtInfo FilePath) -> Maybe TransitionType)
-> (Int -> Maybe (TtInfo FilePath)) -> Int -> Maybe TransitionType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TtInfo FilePath] -> Maybe (TtInfo FilePath)
forall a. [a] -> Maybe a
listToMaybe ([TtInfo FilePath] -> Maybe (TtInfo FilePath))
-> (Int -> [TtInfo FilePath]) -> Int -> Maybe (TtInfo FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> [TtInfo FilePath] -> [TtInfo FilePath])
-> [TtInfo FilePath] -> Int -> [TtInfo FilePath]
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [TtInfo FilePath] -> [TtInfo FilePath]
forall a. Int -> [a] -> [a]
drop [TtInfo FilePath]
ttinfos) ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Int] -> [Int]
forall a. Eq a => [a] -> [a]
uniq ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [Int]
forall a. Ord a => [a] -> [a]
sort ([Int] -> [Int]) -> ([Int] -> [Int]) -> [Int] -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (Transition -> Int) -> [Transition] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Transition -> Int
transIndex [Transition]
transs1')
[Int
0..]
transs1 :: [Transition]
transs1 = [Transition
t {transIndex :: Int
transIndex = Int
i} |
Transition
t <- [Transition]
transs1', Int
i <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
maybeToList (Maybe Int -> [Int]) -> Maybe Int -> [Int]
forall a b. (a -> b) -> a -> b
$ Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Transition -> Int
transIndex Transition
t) [(Int, Int)]
assoc1]
ttinfos1 :: [TtInfo FilePath]
ttinfos1 = ((Maybe Int, TtInfo FilePath) -> TtInfo FilePath)
-> [(Maybe Int, TtInfo FilePath)] -> [TtInfo FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (Maybe Int, TtInfo FilePath) -> TtInfo FilePath
forall a b. (a, b) -> b
snd ([(Maybe Int, TtInfo FilePath)] -> [TtInfo FilePath])
-> ([(Maybe Int, TtInfo FilePath)]
-> [(Maybe Int, TtInfo FilePath)])
-> [(Maybe Int, TtInfo FilePath)]
-> [TtInfo FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Maybe Int, TtInfo FilePath) -> Bool)
-> [(Maybe Int, TtInfo FilePath)] -> [(Maybe Int, TtInfo FilePath)]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Int -> Bool)
-> ((Maybe Int, TtInfo FilePath) -> Maybe Int)
-> (Maybe Int, TtInfo FilePath)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Int, TtInfo FilePath) -> Maybe Int
forall a b. (a, b) -> a
fst) ([(Maybe Int, TtInfo FilePath)] -> [(Maybe Int, TtInfo FilePath)])
-> ([(Maybe Int, TtInfo FilePath)]
-> [(Maybe Int, TtInfo FilePath)])
-> [(Maybe Int, TtInfo FilePath)]
-> [(Maybe Int, TtInfo FilePath)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
((Maybe Int, TtInfo FilePath)
-> (Maybe Int, TtInfo FilePath) -> Ordering)
-> [(Maybe Int, TtInfo FilePath)] -> [(Maybe Int, TtInfo FilePath)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Maybe Int, TtInfo FilePath) -> Maybe Int)
-> (Maybe Int, TtInfo FilePath)
-> (Maybe Int, TtInfo FilePath)
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (Maybe Int, TtInfo FilePath) -> Maybe Int
forall a b. (a, b) -> a
fst) ([(Maybe Int, TtInfo FilePath)] -> [TtInfo FilePath])
-> [(Maybe Int, TtInfo FilePath)] -> [TtInfo FilePath]
forall a b. (a -> b) -> a -> b
$ [Maybe Int] -> [TtInfo FilePath] -> [(Maybe Int, TtInfo FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Maybe Int) -> [Int] -> [Maybe Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> [(Int, Int)] -> Maybe Int)
-> [(Int, Int)] -> Int -> Maybe Int
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> [(Int, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup [(Int, Int)]
assoc1) [Int
0..]) [TtInfo FilePath]
ttinfos
putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put
putOlsonPart :: Word8 -> (Integer -> Put) -> OlsonData -> Put
putOlsonPart Word8
version Integer -> Put
putTime (OlsonData [Transition]
transs [TtInfo FilePath]
ttinfos [LeapInfo]
leaps Maybe FilePath
_) = do
FilePath -> FilePath -> Put
putASCII FilePath
"magic number" FilePath
"TZif"
Word8 -> Put
putWord8 Word8
version
ByteString -> Put
putByteString (ByteString -> Put) -> ([Word8] -> ByteString) -> [Word8] -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> Put) -> [Word8] -> Put
forall a b. (a -> b) -> a -> b
$ Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
15 Word8
0
Int -> Put -> Put
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
2 (Put -> Put) -> Put -> Put
forall a b. (a -> b) -> a -> b
$ [TtInfo Int] -> Put
forall a. [a] -> Put
putCount [TtInfo Int]
ttinfosWithTtype
[LeapInfo] -> Put
forall a. [a] -> Put
putCount [LeapInfo]
leaps
[Transition] -> Put
forall a. [a] -> Put
putCount [Transition]
transs
[TtInfo FilePath] -> Put
forall a. [a] -> Put
putCount [TtInfo FilePath]
ttinfos
Int -> Put
forall a. Integral a => a -> Put
put32bitIntegral Int
abbrChars
(Transition -> Put) -> [Transition] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Integer -> Put
putTime (Integer -> Put) -> (Transition -> Integer) -> Transition -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> Integer
transTime ) [Transition]
transs
(Transition -> Put) -> [Transition] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int -> Put
forall a. Integral a => a -> Put
put8bitIntegral (Int -> Put) -> (Transition -> Int) -> Transition -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> Int
transIndex) [Transition]
transs
(TtInfo Int -> Put) -> [TtInfo Int] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ TtInfo Int -> Put
putTtInfo [TtInfo Int]
ttinfosIndexed
(FilePath -> Put) -> [FilePath] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> Put
putAbbr [FilePath]
abbrStrings
(LeapInfo -> Put) -> [LeapInfo] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((Integer -> Put) -> LeapInfo -> Put
forall a. Integral a => (a -> Put) -> LeapInfo -> Put
putLeapInfo Integer -> Put
putTime) [LeapInfo]
leaps
(TtInfo Int -> Put) -> [TtInfo Int] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Put
putBool (Bool -> Put) -> (TtInfo Int -> Bool) -> TtInfo Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionType -> TransitionType -> Bool
forall a. Eq a => a -> a -> Bool
== TransitionType
Std) (TransitionType -> Bool)
-> (TtInfo Int -> TransitionType) -> TtInfo Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TtInfo Int -> TransitionType
forall abbr. TtInfo abbr -> TransitionType
tt_ttype) [TtInfo Int]
ttinfosWithTtype
(TtInfo Int -> Put) -> [TtInfo Int] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Bool -> Put
putBool (Bool -> Put) -> (TtInfo Int -> Bool) -> TtInfo Int -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TransitionType -> TransitionType -> Bool
forall a. Eq a => a -> a -> Bool
== TransitionType
UTC) (TransitionType -> Bool)
-> (TtInfo Int -> TransitionType) -> TtInfo Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TtInfo Int -> TransitionType
forall abbr. TtInfo abbr -> TransitionType
tt_ttype) [TtInfo Int]
ttinfosWithTtype
where
putCount :: [a] -> Put
putCount = Int -> Put
forall a. Integral a => a -> Put
put32bitIntegral (Int -> Put) -> ([a] -> Int) -> [a] -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
ttinfosWithTtype :: [TtInfo Int]
ttinfosWithTtype = (TtInfo Int -> Bool) -> [TtInfo Int] -> [TtInfo Int]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((TransitionType -> TransitionType -> Bool
forall a. Ord a => a -> a -> Bool
<= TransitionType
UTC) (TransitionType -> Bool)
-> (TtInfo Int -> TransitionType) -> TtInfo Int -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TtInfo Int -> TransitionType
forall abbr. TtInfo abbr -> TransitionType
tt_ttype) [TtInfo Int]
ttinfosIndexed
abbrStrings :: [FilePath]
abbrStrings = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
uniq ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Ord a => [a] -> [a]
sort ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (TtInfo FilePath -> FilePath) -> [TtInfo FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map TtInfo FilePath -> FilePath
forall abbr. TtInfo abbr -> abbr
tt_abbr [TtInfo FilePath]
ttinfos
abbrChars :: Int
abbrChars = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
abbrStrings) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [FilePath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
abbrStrings
putAbbr :: FilePath -> Put
putAbbr FilePath
abbr = FilePath -> FilePath -> Put
putASCII FilePath
"time zone abbreviation" FilePath
abbr Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Word8 -> Put
putWord8 Word8
0
abbrAssocs :: [(FilePath, Int)]
abbrAssocs = [FilePath] -> [Int] -> [(FilePath, Int)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
abbrStrings ([Int] -> [(FilePath, Int)])
-> ([Int] -> [Int]) -> [Int] -> [(FilePath, Int)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> [Int] -> [Int]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
0 ([Int] -> [(FilePath, Int)]) -> [Int] -> [(FilePath, Int)]
forall a b. (a -> b) -> a -> b
$
(FilePath -> Int) -> [FilePath] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (Int -> Int) -> (FilePath -> Int) -> FilePath -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [FilePath]
abbrStrings
ttinfosIndexed :: [TtInfo Int]
ttinfosIndexed = [Int -> Bool -> TransitionType -> Int -> TtInfo Int
forall abbr. Int -> Bool -> TransitionType -> abbr -> TtInfo abbr
TtInfo Int
gmtoff Bool
isdst TransitionType
ttype Int
i |
TtInfo Int
gmtoff Bool
isdst TransitionType
ttype FilePath
abbr <- [TtInfo FilePath]
ttinfos,
Int
i <- Maybe Int -> [Int]
forall a. Maybe a -> [a]
maybeToList (Maybe Int -> [Int]) -> Maybe Int -> [Int]
forall a b. (a -> b) -> a -> b
$ FilePath -> [(FilePath, Int)] -> Maybe Int
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup FilePath
abbr [(FilePath, Int)]
abbrAssocs]
putPosixTZ :: Maybe String -> Put
putPosixTZ :: Maybe FilePath -> Put
putPosixTZ Maybe FilePath
posix = do
Word8 -> Put
putWord8 Word8
10
FilePath -> FilePath -> Put
putASCII FilePath
"POSIX TZ string"(FilePath -> Put) -> FilePath -> Put
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
"" Maybe FilePath
posix
Word8 -> Put
putWord8 Word8
10
putTtInfo :: TtInfo Int -> Put
putTtInfo :: TtInfo Int -> Put
putTtInfo TtInfo Int
tt = do
Int -> Put
forall a. Integral a => a -> Put
put32bitIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ TtInfo Int -> Int
forall abbr. TtInfo abbr -> Int
tt_gmtoff TtInfo Int
tt
Bool -> Put
putBool (Bool -> Put) -> Bool -> Put
forall a b. (a -> b) -> a -> b
$ TtInfo Int -> Bool
forall abbr. TtInfo abbr -> Bool
tt_isdst TtInfo Int
tt
Int -> Put
forall a. Integral a => a -> Put
put8bitIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ TtInfo Int -> Int
forall abbr. TtInfo abbr -> abbr
tt_abbr TtInfo Int
tt
putLeapInfo :: Integral a => (a -> Put) -> LeapInfo -> Put
putLeapInfo :: (a -> Put) -> LeapInfo -> Put
putLeapInfo a -> Put
putTime LeapInfo
leap = do
a -> Put
putTime (a -> Put) -> (Integer -> a) -> Integer -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Put) -> Integer -> Put
forall a b. (a -> b) -> a -> b
$ LeapInfo -> Integer
leapTime LeapInfo
leap
Int -> Put
forall a. Integral a => a -> Put
put32bitIntegral (Int -> Put) -> Int -> Put
forall a b. (a -> b) -> a -> b
$ LeapInfo -> Int
leapOffset LeapInfo
leap
put8bitIntegral :: Integral a => a -> Put
put8bitIntegral :: a -> Put
put8bitIntegral = Word8 -> Put
putWord8 (Word8 -> Put) -> (a -> Word8) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral
put32bitIntegral :: Integral a => a -> Put
put32bitIntegral :: a -> Put
put32bitIntegral = Word32 -> Put
putWord32be (Word32 -> Put) -> (a -> Word32) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
put64bitIntegral :: Integral a => a -> Put
put64bitIntegral :: a -> Put
put64bitIntegral = Word64 -> Put
putWord64be (Word64 -> Put) -> (a -> Word64) -> a -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral
putBool :: Bool -> Put
putBool :: Bool -> Put
putBool Bool
False = Word8 -> Put
putWord8 Word8
0
putBool Bool
True = Word8 -> Put
putWord8 Word8
1
uniq :: Eq a => [a] -> [a]
uniq :: [a] -> [a]
uniq = ([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head ([[a]] -> [a]) -> ([a] -> [[a]]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [[a]]
forall a. Eq a => [a] -> [[a]]
group
putASCII :: String -> String -> Put
putASCII :: FilePath -> FilePath -> Put
putASCII FilePath
what =
ByteString -> Put
putByteString (ByteString -> Put) -> (FilePath -> ByteString) -> FilePath -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
B.pack ([Word8] -> ByteString)
-> (FilePath -> [Word8]) -> FilePath -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Word8) -> FilePath -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int
forall p. (Ord p, Num p) => p -> p
verify (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum)
where
verify :: p -> p
verify p
c
| p
c p -> p -> Bool
forall a. Ord a => a -> a -> Bool
>= p
32 Bool -> Bool -> Bool
&& p
c p -> p -> Bool
forall a. Ord a => a -> a -> Bool
<= p
126 = p
c
| Bool
otherwise = FilePath -> p
forall a. HasCallStack => FilePath -> a
error (FilePath -> p) -> FilePath -> p
forall a b. (a -> b) -> a -> b
$ FilePath
"Cannot render TimeZoneSeries: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
what FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" contains non-ASCII characters"