{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}
module Data.Time.LocalTime.TimeZone.Olson.Parse
(
getTimeZoneSeriesFromOlsonFile,
getOlsonFromFile,
olsonToTimeZoneSeries,
getOlson,
OlsonError
)
where
import Data.Time.LocalTime.TimeZone.Olson.Types
import Data.Time.LocalTime.TimeZone.Series (TimeZoneSeries(..))
import Data.Time (TimeZone(TimeZone))
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Binary.Get (Get, runGet, getWord8, getWord32be, getWord64be,
getByteString, getRemainingLazyByteString)
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)
data OlsonError = OlsonError String
deriving Typeable
instance Show OlsonError where
show :: OlsonError -> String
show (OlsonError String
msg) = String
msg
instance Exception OlsonError
olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries
olsonToTimeZoneSeries :: OlsonData -> Maybe TimeZoneSeries
olsonToTimeZoneSeries (OlsonData [Transition]
ttimes ttinfos :: [TtInfo String]
ttinfos@(TtInfo String
dflt0:[TtInfo String]
_) [LeapInfo]
_ Maybe String
_) =
([(UTCTime, TimeZone)] -> TimeZoneSeries)
-> Maybe [(UTCTime, TimeZone)] -> Maybe TimeZoneSeries
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries
TimeZoneSeries (TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries)
-> TimeZone -> [(UTCTime, TimeZone)] -> TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ TtInfo String -> TimeZone
mkTZ TtInfo String
dflt) (Maybe [(UTCTime, TimeZone)] -> Maybe TimeZoneSeries)
-> ([Transition] -> Maybe [(UTCTime, TimeZone)])
-> [Transition]
-> Maybe TimeZoneSeries
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition -> Maybe (UTCTime, TimeZone))
-> [Transition] -> Maybe [(UTCTime, TimeZone)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ([TtInfo String] -> Transition -> Maybe (UTCTime, TimeZone)
lookupTZ [TtInfo String]
ttinfos) ([Transition] -> Maybe [(UTCTime, TimeZone)])
-> ([Transition] -> [Transition])
-> [Transition]
-> Maybe [(UTCTime, TimeZone)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Transition] -> [Transition]
uniqTimes ([Transition] -> [Transition])
-> ([Transition] -> [Transition]) -> [Transition] -> [Transition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition -> Transition -> Ordering)
-> [Transition] -> [Transition]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Transition -> Transition -> Ordering
futureToPast ([Transition] -> Maybe TimeZoneSeries)
-> [Transition] -> Maybe TimeZoneSeries
forall a b. (a -> b) -> a -> b
$ [Transition]
ttimes
where
dflt :: TtInfo String
dflt = TtInfo String -> Maybe (TtInfo String) -> TtInfo String
forall a. a -> Maybe a -> a
fromMaybe TtInfo String
dflt0 (Maybe (TtInfo String) -> TtInfo String)
-> ([TtInfo String] -> Maybe (TtInfo String))
-> [TtInfo String]
-> TtInfo String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TtInfo String] -> Maybe (TtInfo String)
forall a. [a] -> Maybe a
listToMaybe ([TtInfo String] -> TtInfo String)
-> [TtInfo String] -> TtInfo String
forall a b. (a -> b) -> a -> b
$ (TtInfo String -> Bool) -> [TtInfo String] -> [TtInfo String]
forall a. (a -> Bool) -> [a] -> [a]
filter TtInfo String -> Bool
forall abbr. TtInfo abbr -> Bool
isStd [TtInfo String]
ttinfos
isStd :: TtInfo abbr -> Bool
isStd (TtInfo Int
_ Bool
isdst TransitionType
_ abbr
_) = Bool -> Bool
not Bool
isdst
mkTZ :: TtInfo String -> TimeZone
mkTZ (TtInfo Int
utoff Bool
isdst TransitionType
_ String
abbr) =
Int -> Bool -> String -> TimeZone
TimeZone ((Int
utoff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
30) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
60) Bool
isdst String
abbr
lookupTZ :: [TtInfo String] -> Transition -> Maybe (UTCTime, TimeZone)
lookupTZ [TtInfo String]
ttinfos Transition
ttime = (TtInfo String -> (UTCTime, TimeZone))
-> Maybe (TtInfo String) -> Maybe (UTCTime, TimeZone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((,) (UTCTime -> TimeZone -> (UTCTime, TimeZone))
-> UTCTime -> TimeZone -> (UTCTime, TimeZone)
forall a b. (a -> b) -> a -> b
$ Transition -> UTCTime
toUTC Transition
ttime) (TimeZone -> (UTCTime, TimeZone))
-> (TtInfo String -> TimeZone)
-> TtInfo String
-> (UTCTime, TimeZone)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TtInfo String -> TimeZone
mkTZ) (Maybe (TtInfo String) -> Maybe (UTCTime, TimeZone))
-> ([TtInfo String] -> Maybe (TtInfo String))
-> [TtInfo String]
-> Maybe (UTCTime, TimeZone)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [TtInfo String] -> Maybe (TtInfo String)
forall a. [a] -> Maybe a
listToMaybe ([TtInfo String] -> Maybe (UTCTime, TimeZone))
-> [TtInfo String] -> Maybe (UTCTime, TimeZone)
forall a b. (a -> b) -> a -> b
$
Int -> [TtInfo String] -> [TtInfo String]
forall a. Int -> [a] -> [a]
drop (Transition -> Int
transIndex Transition
ttime) [TtInfo String]
ttinfos
toUTC :: Transition -> UTCTime
toUTC = POSIXTime -> UTCTime
posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Transition -> POSIXTime) -> Transition -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> POSIXTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> POSIXTime)
-> (Transition -> Integer) -> Transition -> POSIXTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> Integer
transTime
uniqTimes :: [Transition] -> [Transition]
uniqTimes = ([Transition] -> Transition) -> [[Transition]] -> [Transition]
forall a b. (a -> b) -> [a] -> [b]
map [Transition] -> Transition
forall a. [a] -> a
last ([[Transition]] -> [Transition])
-> ([Transition] -> [[Transition]]) -> [Transition] -> [Transition]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Transition -> Transition -> Bool)
-> [Transition] -> [[Transition]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Integer -> Integer -> Bool)
-> (Transition -> Integer) -> Transition -> Transition -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Transition -> Integer
transTime)
futureToPast :: Transition -> Transition -> Ordering
futureToPast = (Transition -> Integer) -> Transition -> Transition -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((Transition -> Integer) -> Transition -> Transition -> Ordering)
-> (Transition -> Integer) -> Transition -> Transition -> Ordering
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Num a => a -> a
negate (Integer -> Integer)
-> (Transition -> Integer) -> Transition -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transition -> Integer
transTime
olsonToTimeZoneSeries OlsonData
_ = Maybe TimeZoneSeries
forall a. Maybe a
Nothing
getTimeZoneSeriesFromOlsonFile :: FilePath -> IO TimeZoneSeries
getTimeZoneSeriesFromOlsonFile :: String -> IO TimeZoneSeries
getTimeZoneSeriesFromOlsonFile String
fp = String -> IO OlsonData
getOlsonFromFile String
fp IO OlsonData
-> (OlsonData -> IO TimeZoneSeries) -> IO TimeZoneSeries
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
IO TimeZoneSeries
-> (TimeZoneSeries -> IO TimeZoneSeries)
-> Maybe TimeZoneSeries
-> IO TimeZoneSeries
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> String -> IO TimeZoneSeries
forall a. String -> String -> IO a
throwOlson String
fp String
"no timezone found in OlsonData") TimeZoneSeries -> IO TimeZoneSeries
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe TimeZoneSeries -> IO TimeZoneSeries)
-> (OlsonData -> Maybe TimeZoneSeries)
-> OlsonData
-> IO TimeZoneSeries
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
OlsonData -> Maybe TimeZoneSeries
olsonToTimeZoneSeries
getOlsonFromFile :: FilePath -> IO OlsonData
getOlsonFromFile :: String -> IO OlsonData
getOlsonFromFile String
fp = do
Either ErrorCall OlsonData
e <- IO OlsonData -> IO (Either ErrorCall OlsonData)
forall e a. Exception e => IO a -> IO (Either e a)
try (IO OlsonData -> IO (Either ErrorCall OlsonData))
-> (IO ByteString -> IO OlsonData)
-> IO ByteString
-> IO (Either ErrorCall OlsonData)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> OlsonData) -> IO ByteString -> IO OlsonData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Get OlsonData -> ByteString -> OlsonData
forall a. Get a -> ByteString -> a
runGet (Get OlsonData -> ByteString -> OlsonData)
-> Get OlsonData -> ByteString -> OlsonData
forall a b. (a -> b) -> a -> b
$ SizeLimits -> Get OlsonData
getOlson SizeLimits
defaultLimits) (IO ByteString -> IO (Either ErrorCall OlsonData))
-> IO ByteString -> IO (Either ErrorCall OlsonData)
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
L.readFile String
fp
(ErrorCall -> IO OlsonData)
-> (OlsonData -> IO OlsonData)
-> Either ErrorCall OlsonData
-> IO OlsonData
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> ErrorCall -> IO OlsonData
forall a. String -> ErrorCall -> IO a
formatError String
fp) OlsonData -> IO OlsonData
forall (m :: * -> *) a. Monad m => a -> m a
return Either ErrorCall OlsonData
e
formatError :: FilePath -> ErrorCall -> IO a
formatError :: String -> ErrorCall -> IO a
formatError String
fp ErrorCall
e = String -> String -> IO a
forall a. String -> String -> IO a
throwOlson String
fp (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$ ErrorCall -> String
forall a. Show a => a -> String
show ErrorCall
e
getOlson :: SizeLimits -> Get OlsonData
getOlson :: SizeLimits -> Get OlsonData
getOlson SizeLimits
limits = do
(Word8
version, OlsonData
part1) <- Bool -> SizeLimits -> Get Integer -> Get (Word8, OlsonData)
forall a.
Integral a =>
Bool -> SizeLimits -> Get a -> Get (Word8, OlsonData)
getOlsonPart Bool
True SizeLimits
limits Get Integer
get32bitInteger
case () of
()
_ | Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0 -> OlsonData -> Get OlsonData
forall (m :: * -> *) a. Monad m => a -> m a
return OlsonData
part1
| Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
50 Bool -> Bool -> Bool
|| Word8
version Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
51 -> do
(Word8
_, OlsonData
part2) <- Bool -> SizeLimits -> Get Integer -> Get (Word8, OlsonData)
forall a.
Integral a =>
Bool -> SizeLimits -> Get a -> Get (Word8, OlsonData)
getOlsonPart Bool
False SizeLimits
limits Get Integer
get64bitInteger
OlsonData
posixTZ <- Get OlsonData
getPosixTZ
OlsonData -> Get OlsonData
forall (m :: * -> *) a. Monad m => a -> m a
return (OlsonData -> Get OlsonData) -> OlsonData -> Get OlsonData
forall a b. (a -> b) -> a -> b
$ OlsonData
part1 OlsonData -> OlsonData -> OlsonData
forall a. Monoid a => a -> a -> a
`mappend` OlsonData
part2 OlsonData -> OlsonData -> OlsonData
forall a. Monoid a => a -> a -> a
`mappend` OlsonData
posixTZ
| Bool
otherwise -> do
let msg :: String
msg = String
"getOlson: invalid tzfile version " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Word8] -> String
toASCII [Word8
version]
(OlsonData -> Bool) -> String -> OlsonData -> Get OlsonData
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify (Bool -> OlsonData -> Bool
forall a b. a -> b -> a
const Bool
False) String
msg OlsonData
forall a. HasCallStack => a
undefined
getOlsonPart :: Integral a => Bool -> SizeLimits -> Get a ->
Get (Word8, OlsonData)
getOlsonPart :: Bool -> SizeLimits -> Get a -> Get (Word8, OlsonData)
getOlsonPart Bool
verifyMagic SizeLimits
limits Get a
getTime = do
String
magic <- (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Word8] -> String
toASCII ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) (Get ByteString -> Get String) -> Get ByteString -> Get String
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
4
Bool -> Get () -> Get ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
verifyMagic (Get () -> Get ()) -> Get () -> Get ()
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> String -> String -> Get ()
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m ()
verify_ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"TZif") String
"missing magic number" String
magic
Word8
version <- Get Word8
getWord8
Int -> Get Word8 -> Get ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ Int
15 Get Word8
getWord8
Int
tzh_ttisutcnt <- Get Int
get32bitInt
Int
tzh_ttisstdcnt <- Get Int
get32bitInt
Int
tzh_leapcnt <- Get Int
get32bitInt
Get Int -> (Int -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxLeaps) String
"too many leap second specifications"
Int
tzh_timecnt <- Get Int
get32bitInt
Get Int -> (Int -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxTimes) String
"too many timezone transitions"
Int
tzh_typecnt <- Get Int
get32bitInt
Get Int -> (Int -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxTypes) String
"too many timezone type specifications"
(Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxTypes) String
"too many isut specifiers" Int
tzh_ttisutcnt
(Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxTypes) String
"too many isstd specifiers" Int
tzh_ttisstdcnt
Int
tzh_charcnt <- Get Int
get32bitInt
Get Int -> (Int -> Get Int) -> Get Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Int -> Bool) -> String -> Int -> Get Int
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify ((SizeLimits -> Maybe Int) -> Int -> Bool
forall a. Ord a => (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe Int
maxAbbrChars) String
"too many tilezone specifiers"
[Integer]
times <- ([a] -> [Integer]) -> Get [a] -> Get [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> Integer) -> [a] -> [Integer]
forall a b. (a -> b) -> [a] -> [b]
map a -> Integer
forall a. Integral a => a -> Integer
toInteger) (Get [a] -> Get [Integer]) -> Get [a] -> Get [Integer]
forall a b. (a -> b) -> a -> b
$ Int -> Get a -> Get [a]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_timecnt Get a
getTime
[Int]
indexes <- Int -> Get Int -> Get [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_timecnt Get Int
get8bitInt
[TtInfo Int]
ttinfos <- Int -> Get (TtInfo Int) -> Get [TtInfo Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_typecnt Get (TtInfo Int)
getTtInfo
String
abbr_chars <- (ByteString -> String) -> Get ByteString -> Get String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([Word8] -> String
toASCII ([Word8] -> String)
-> (ByteString -> [Word8]) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
B.unpack) (Get ByteString -> Get String) -> Get ByteString -> Get String
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteString Int
tzh_charcnt
[LeapInfo]
leaps <- Int -> Get LeapInfo -> Get [LeapInfo]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_leapcnt (Get LeapInfo -> Get [LeapInfo]) -> Get LeapInfo -> Get [LeapInfo]
forall a b. (a -> b) -> a -> b
$ Get a -> Get LeapInfo
forall a. Integral a => Get a -> Get LeapInfo
getLeapInfo Get a
getTime
[Bool]
isstds <- Int -> Get Bool -> Get [Bool]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_ttisstdcnt Get Bool
getBool
[Bool]
isuts <- Int -> Get Bool -> Get [Bool]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
tzh_ttisutcnt Get Bool
getBool
(Word8, OlsonData) -> Get (Word8, OlsonData)
forall (m :: * -> *) a. Monad m => a -> m a
return
(Word8
version,
[Transition]
-> [TtInfo String] -> [LeapInfo] -> Maybe String -> OlsonData
OlsonData
((Integer -> Int -> Transition)
-> [Integer] -> [Int] -> [Transition]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Integer -> Int -> Transition
Transition [Integer]
times [Int]
indexes)
((TtInfo Int -> TtInfo String) -> [TtInfo Int] -> [TtInfo String]
forall a b. (a -> b) -> [a] -> [b]
map ((TtInfo Int -> String -> TtInfo String)
-> String -> TtInfo Int -> TtInfo String
forall a b c. (a -> b -> c) -> b -> a -> c
flip TtInfo Int -> String -> TtInfo String
lookupAbbr String
abbr_chars) ([TtInfo Int] -> [TtInfo String])
-> ([TransitionType] -> [TtInfo Int])
-> [TransitionType]
-> [TtInfo String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TtInfo Int -> TransitionType -> TtInfo Int)
-> [TtInfo Int] -> [TransitionType] -> [TtInfo Int]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith TtInfo Int -> TransitionType -> TtInfo Int
forall abbr. TtInfo abbr -> TransitionType -> TtInfo abbr
setTtype [TtInfo Int]
ttinfos ([TransitionType] -> [TtInfo String])
-> [TransitionType] -> [TtInfo String]
forall a b. (a -> b) -> a -> b
$
(Bool -> Bool -> TransitionType)
-> [Bool] -> [Bool] -> [TransitionType]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Bool -> TransitionType
boolsToTType
([Bool]
isstds [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) ([Bool]
isuts [Bool] -> [Bool] -> [Bool]
forall a. [a] -> [a] -> [a]
++ Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False)
)
[LeapInfo]
leaps
Maybe String
forall a. Maybe a
Nothing
)
where
withinLimit :: (SizeLimits -> Maybe a) -> a -> Bool
withinLimit SizeLimits -> Maybe a
limit a
value = Bool -> (a -> Bool) -> Maybe a -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (a
value a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<=) (Maybe a -> Bool) -> Maybe a -> Bool
forall a b. (a -> b) -> a -> b
$ SizeLimits -> Maybe a
limit SizeLimits
limits
lookupAbbr :: TtInfo Int -> String -> TtInfo String
lookupAbbr (TtInfo Int
utoff Bool
isdst TransitionType
ttype Int
abbrind) =
Int -> Bool -> TransitionType -> String -> TtInfo String
forall abbr. Int -> Bool -> TransitionType -> abbr -> TtInfo abbr
TtInfo Int
utoff Bool
isdst TransitionType
ttype (String -> TtInfo String) -> ShowS -> String -> TtInfo String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\NUL') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
abbrind
setTtype :: TtInfo abbr -> TransitionType -> TtInfo abbr
setTtype TtInfo abbr
ttinfo TransitionType
ttype = TtInfo abbr
ttinfo {tt_ttype :: TransitionType
tt_ttype = TransitionType
ttype}
boolsToTType :: Bool -> Bool -> TransitionType
boolsToTType Bool
_ Bool
isut | Bool
isut = TransitionType
UTC
boolsToTType Bool
isstd Bool
_
| Bool
isstd = TransitionType
Std
| Bool
otherwise = TransitionType
Wall
getPosixTZ :: Get OlsonData
getPosixTZ :: Get OlsonData
getPosixTZ = do
Get Word8
getWord8 Get Word8 -> (Word8 -> Get Word8) -> Get Word8
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Word8 -> Bool) -> String -> Word8 -> Get Word8
forall (m :: * -> *) a.
Monad m =>
(a -> Bool) -> String -> a -> m a
verify (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
10)
String
"POSIX TZ string not preceded by newline"
ByteString
posixTZ <- (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Word8 -> Bool) -> ByteString -> ByteString
L.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
10)) Get ByteString
getRemainingLazyByteString
OlsonData -> Get OlsonData
forall (m :: * -> *) a. Monad m => a -> m a
return (OlsonData -> Get OlsonData)
-> (Maybe String -> OlsonData) -> Maybe String -> Get OlsonData
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Transition]
-> [TtInfo String] -> [LeapInfo] -> Maybe String -> OlsonData
OlsonData [] [] [] (Maybe String -> Get OlsonData) -> Maybe String -> Get OlsonData
forall a b. (a -> b) -> a -> b
$ do
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
L.null ByteString
posixTZ)
String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> ([Word8] -> String) -> [Word8] -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> String
toASCII ([Word8] -> Maybe String) -> [Word8] -> Maybe String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
L.unpack ByteString
posixTZ
getTtInfo :: Get (TtInfo Int)
getTtInfo :: Get (TtInfo Int)
getTtInfo = do
Int
utoff <- Get Int
get32bitInt
Bool
isdst <- Get Bool
getBool
Int
abbrind <- Get Int
get8bitInt
TtInfo Int -> Get (TtInfo Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (TtInfo Int -> Get (TtInfo Int)) -> TtInfo Int -> Get (TtInfo Int)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> TransitionType -> Int -> TtInfo Int
forall abbr. Int -> Bool -> TransitionType -> abbr -> TtInfo abbr
TtInfo Int
utoff Bool
isdst TransitionType
Wall Int
abbrind
getLeapInfo :: Integral a => Get a -> Get LeapInfo
getLeapInfo :: Get a -> Get LeapInfo
getLeapInfo Get a
getTime = do
Integer
lTime <- (a -> Integer) -> Get a -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> Integer
forall a. Integral a => a -> Integer
toInteger Get a
getTime
Int
lOffset <- Get Int
get32bitInt
LeapInfo -> Get LeapInfo
forall (m :: * -> *) a. Monad m => a -> m a
return (LeapInfo -> Get LeapInfo) -> LeapInfo -> Get LeapInfo
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> LeapInfo
LeapInfo Integer
lTime Int
lOffset
get8bitInt :: Get Int
get8bitInt :: Get Int
get8bitInt = (Word8 -> Int) -> Get Word8 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word8
getWord8
getInt32 :: Get Int32
getInt32 :: Get Int32
getInt32 = (Word32 -> Int32) -> Get Word32 -> Get Int32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word32 -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word32
getWord32be
get32bitInt :: Get Int
get32bitInt :: Get Int
get32bitInt = (Int32 -> Int) -> Get Int32 -> Get Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int32
getInt32
get32bitInteger :: Get Integer
get32bitInteger :: Get Integer
get32bitInteger = (Int32 -> Integer) -> Get Int32 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int32 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int32
getInt32
getInt64 :: Get Int64
getInt64 :: Get Int64
getInt64 = (Word64 -> Int64) -> Get Word64 -> Get Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Word64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Word64
getWord64be
get64bitInteger :: Get Integer
get64bitInteger :: Get Integer
get64bitInteger = (Int64 -> Integer) -> Get Int64 -> Get Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Get Int64
getInt64
getBool :: Get Bool
getBool :: Get Bool
getBool = (Word8 -> Bool) -> Get Word8 -> Get Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) Get Word8
getWord8
toASCII :: [Word8] -> String
toASCII :: [Word8] -> String
toASCII = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Char) -> (Word8 -> Int) -> Word8 -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral)
verify :: Monad m => (a -> Bool) -> String -> a -> m a
verify :: (a -> Bool) -> String -> a -> m a
verify a -> Bool
pred String
msg a
val
| a -> Bool
pred a
val = a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
val
| Bool
otherwise = String -> m a
forall a. HasCallStack => String -> a
error String
msg
verify_ :: Monad m => (a -> Bool) -> String -> a -> m ()
verify_ :: (a -> Bool) -> String -> a -> m ()
verify_ a -> Bool
pred String
msg a
val
| a -> Bool
pred a
val = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = String -> m ()
forall a. HasCallStack => String -> a
error String
msg
throwOlson :: FilePath -> String -> IO a
throwOlson :: String -> String -> IO a
throwOlson String
fp String
msg = OlsonError -> IO a
forall a e. Exception e => e -> a
throw (OlsonError -> IO a) -> (String -> OlsonError) -> String -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> OlsonError
OlsonError (String -> IO a) -> String -> IO a
forall a b. (a -> b) -> a -> b
$
String
fp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": invalid timezone file: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msg