{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Data.Time.LocalTime.TimeZone.Olson.Parse
-- Copyright   :  Yitzchak Gale 2019
--
-- Maintainer  :  Yitzchak Gale <gale@sefer.org>
-- Portability :  portable
--
-- A parser for binary Olson timezone files whose format is specified
-- in RFC 8536. Functions are provided for converting the parsed data
-- into 'TimeZoneSeries' objects.

{- Copyright (c) 2019 Yitzchak Gale. All rights reserved.
For licensing information, see the BSD3-style license in the file
LICENSE that was originally distributed by the author together with
this file. -}

module Data.Time.LocalTime.TimeZone.Olson.Parse
(
 -- * Parsing Olson timezone files
 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)

-- | An exception indicating that the binary data being parsed was not
-- valid Olson timezone data
data OlsonError = OlsonError String
  deriving Typeable
instance Show OlsonError where
  show :: OlsonError -> String
show (OlsonError String
msg) = String
msg
instance Exception OlsonError

-- | Convert parsed Olson timezone data into a @TimeZoneSeries@.
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

-- | Read timezone data from a binary Olson timezone file and convert
-- it into a @TimeZoneSeries@ for use together with the types and
-- fucntions of "Data.Time". This is the function from this module
-- for which you are most likely to have use.
--
-- If the values in the Olson timezone file exceed the standard size
-- limits (see 'defaultLimits'), this function throws an
-- exception. For other behavior, use 'getOlson' and
-- 'Data.Binary.Get.runGet' directly.
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

-- | Parse a binary Olson timezone file.
--
-- If the values in the Olson timezone file exceed the standard size
-- limits (see 'defaultLimits'), this function throws an
-- exception. For other behavior, use 'getOlson' and
-- 'Data.Binary.Get.runGet' directly.
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

-- | A binary parser for binary Olson timezone files
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
    -- There is one part for Version 1 format data, and two parts and a POSIX
    -- TZ string for Version 2 or 3 format data
    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

-- Parse the part of an Olson file that contains timezone data

-- We are lenient about invalid values of @isstdcnt@ and @isutcnt@.
-- Before RFC 8536, we ignored transitions that did not have a
-- corresponding value for both @isstd@ and @isut@.  Staring with RFC
-- 8536, when zero became a valid value for @isstdcont@ and @isutcnt@,
-- we extend @isstds@ and @isuts@ with default values if they are too
-- short. Thanks to Github user @mniip@ for suggesting this change.
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 -- padding nulls
    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

-- Parse a POSIX-style TZ string.
-- We don't try to understand the TZ string, we just pass it along whole.
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
    -- We don't check for the trailing newline, in order to keep it lazy
    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

-- Parse a ttinfo struct. Each ttinfo struct corresponds to a single
-- Data.Time.TimeZone object.
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

-- Parse leap second info. (usually not used)
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

-- Our 8-bit ints are unsigned, so we can convert them directly
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
                  -- via Int32 to get the sign right
                  -- in case we are on a 64-bit platform

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
                  -- via Int32 to get the sign right

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
                  -- via Int64 to get the sign right

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